Hatena::ブログ(Diary)

みずぴー日記

2010-01-18(月)

既約分数クイズ

| 既約分数クイズ - みずぴー日記 を含むブックマーク

30分プログラム、その722。既約分数クイズにチャレンジしました。

今回は力技で解きましたが、クイズと言うからにはきっとクールな解法があるんでしょう。

使い方

*Main> irreducibleFracs 4
[(0,1),(1,1),(1,2),(1,3),(2,3),(1,4),(3,4)]

ソースコード

type Frac a = (a,a)
canReduce :: Integral a => Frac a -> Bool
fracs :: Integral a => a -> [Frac a]
irreducibleFracs :: Integral a => a -> [Frac a]

canReduce (a,b)= gcd a b /= 1
fracs n = [(p,q) |  q <- [1..n], p <- [0..q]]
irreducibleFracs n = [f | f <- fracs n, not $ canReduce f]

参考

nobsunnobsun 2010/01/19 07:15 つhttp://www.sampou.org/cgi-bin/haskell.cgi?Programming%3a%b6%cc%bc%ea%c8%a2%3a%c0%b0%bf%f4%cf%c0#H-6202f3

nobsunnobsun 2010/01/19 07:19 つ http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3a%e6%95%b0%e9%81%8a%e3%81%b3%3a%e6%97%a2%e7%b4%84%e5%88%86%e6%95%b0

ツムジツムジ 2010/01/24 13:45 力技でよければ……

lowestTerm :: Int -> [(Int, Int)]
lowestTerm n = [(p, q) | q <- [1 .. n], p <- [0 .. q], gcd p q == 1]

2010-01-04(月)

Insersion Sort

| Insersion Sort - みずぴー日記 を含むブックマーク

30分プログラム、その715。2009-11-30 - Haskellで遊ぶよ - haskellインスパイアされました。

書いてから上記のページを見てみたんけど、no titleのinsertやinsertByがあったのか。こっちを使えばよかったなぁ。

あと、昔の記事をあさったたら、2年ほど前に書いたinsersion sortがでてきました(ソートをいろいろ - みずぴー日記)。こっちは、foldrじゃなくてfoldlを使ってますね。foldrのほうが遅延評価と相性がいいとか、なんとか。

使い方

*Main> isort [3,4,5,3,2,1,4]
[1,2,3,3,4,4,5]

ソースコード

insert :: Ord a => a -> [a] -> [a]
isort  :: Ord a => [a] -> [a]

insert x [] = [x]
insert x yss@(y:ys) = if x < y then
                          x:yss
                      else
                          y:insert x ys

isort = foldr insert []

参考

2009-12-19(土)

Data.Graphを試そう

| Data.Graphを試そう - みずぴー日記 を含むブックマーク

30分プログラム、その710。Haskellでグラフを扱いたかったので、Data.Graphを試してみました。

mkGraphの返すグラフの型が、具体的な型ではなく、grになっています。

&#42;Main> :t mkGraph
mkGraph :: (Graph gr) => [LNode a] -> [LEdge b] -> gr a b

これはこれで便利なんでしょうが、今回は面倒なのでGrに束縛しています。

&#42;main> :i Gr
data Gr a b
  = ....
...
instance [overlap ok] Graph Gr
  -- Defined in Data.Graph.Inductive.Tree
...

ソースコード

import Data.Graph.Inductive.Query.BFS
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Tree

-- ノードとエッジの準備
ns = zip [1..] ["A","B","C","D","E"]
es = [(1,2,"A->B"), (1,3,"A->C"), (3,4,"C->D"), (1,4,"A->D"),(4,5,"D->E")]

-- 型を与えてやらないとダメ
graph :: Gr String String
graph = mkGraph ns es

-- [(1,"A->D"),(4,"A->D"),(5,"D->E")]になる
shortPath = lesp 1 5 graph

参考

2009-12-14(月)

油売り算(1)

| 油売り算(1) - みずぴー日記 を含むブックマーク

30分プログラム、その708。昔の日記をあさっていたら、403 Forbiddenが解けてなかったので、再チェレンジ!

が、前回挫折しただけあって、なかなか難しい。とりあえず、後で必要になるだろう型を定義しました。続きはまた今度。

ソースコード

import Text.Printf
import Data.List
import Control.Monad.List

data Pot = Pot {
      name     :: String,
      capacity :: Int,
      volume   :: Int
} deriving Show

newtype Step = Step (String,String,Int)

instance Show Step where
    show (Step (from,to,n)) = printf "%s --> %s (%d)" from to n

参考

RoccoRocco 2009/12/14 23:52 出題者です。
ちょっと難しいと自分でも思ったのですが、サクサク解いている人もいました。
いわゆる探索の問題です。

[1..100]&gt;&gt;=pen[1..100]>>=pen 2009/12/15 08:56 最短手順をゴールから逆にたどると探索しないですみます。

2009-11-25(水)

n+kパターンを試そう

| n+kパターンを試そう - みずぴー日記 を含むブックマーク

30分プログラム、その701。プログラミングHaskellを読んでたら、Haskellにはn+kパターンってのがあるらしい。

これを使うと

even (n+1) = odd n

みたいにパターンの部分にn+kの形が使えるらしいです。

曰く、不人気で将来のバージョンでは消えるかもしれない、そうです。なので、いまのうちに試しておきましょう。

ソースコード

-- 無意味wwww
fact :: Int -> Int
fact 0 = 1
fact (n+1) = (n+1) * fact n

-- 相互再帰
even :: Int -> Bool
odd  :: Int -> Bool
even 0 = True
even (n+1) = Main.odd n
odd 0 = False
odd (n+1) = Main.even n

-- フィボナッチ
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib (n+2) = fib n  + fib (n+1)

参考

2009-11-08(日)

HOASによるラムダ式

| HOASによるラムダ式 - みずぴー日記 を含むブックマーク

30分プログラム、その691。HOASによるラムダ式。

id:keigoiさんに、HOAS(Higher order abstract syntax)なるものを教えてもらいました。

詳しいことは、http://homepages.inf.ed.ac.uk/ratkey/unembedding.pdfに書いてあるらしいです。

今のところの理解は、

  • Haskellのラムダ式で、ターゲット言語のラムダ式を表現する
  • アルファ変換とか変数補足とかを考えなくてすむ

といった感じです。

さっぱり分からないので、上記の論文にのっている例を実装してみました。

使い方

*Main> eval (lambda (\x->x) `apply` (int 42))
42

ソースコード

{-# OPTIONS_GHC -fglasgow-exts #-}

import Text.Printf
class Lambda exp where
    int :: Int -> exp
    lambda :: (exp -> exp) -> exp
    apply  :: exp -> exp -> exp

type Hoas = forall exp. Lambda exp => exp

example1 :: Hoas
example1 = int 42

example2 :: Hoas
example2 = lambda (\x->x) `apply` int 42

data Value = VFunc (Value->Value) | VInt Int

instance Show Value where
    show (VInt n) = show n
    show _ = error "can not show"

instance Lambda Value where
    int n = VInt n
    lambda f = VFunc f
    apply (VFunc f) y = f y

eval :: Hoas -> Value
eval term = term

参考

2009-10-28(水)

仲間はずれの判定、ふたたび

| 仲間はずれの判定、ふたたび - みずぴー日記 を含むブックマーク

30分プログラム、その684。昔にやった仲間はずれの判定を、もう一度やってみました。

問題はNothing found for 404 - エロと風俗情報満載 どう抜く?を参考に、前回の回答は仲間外れの判別 - みずぴー日記を見てください。

使い方

&#42;Main> classify [1,1,1,1,1]
Same 1
*Main> classify [1,2,1,1,1]
OnlyOne 1 2
*Main> classify [1,2,1,1,1,3]
Other

ソースコード

import Data.List

data Result a = Same a | OnlyOne a a | Other deriving Show

classify :: (Eq a, Ord a) => [a] -> Result a

classify xs =
    case group $ sort xs of
      [] ->
          error "empty"
      [xs] ->
          Same (head xs)
      [xs,[y]] ->
          OnlyOne (head xs) y
      [[x],ys] ->
          OnlyOne (head ys) x
      _ ->
          Other

参考

2009-10-12(月)

来年まであと何日?

| 来年まであと何日? - みずぴー日記 を含むブックマーク

30分プログラム、その677。来年まであと何日かを出力するプログラム

恐しいことに、今年も終わりが見えてきました。

そのことについて考えるといろいろと後悔の念がでてきますが、とりあえず来年まで何日あるかを出力するプログラムを書いてみましょう。

使い方

&#42;Main> main
81

ソースコード

import Data.Time
import Data.Time.Calendar
import Data.Time.LocalTime

nextYear :: Day -> Day
today    :: IO Day

nextYear day = fromGregorian (year+1) 1 1
    where (year,_,_) = toGregorian day

today = do tz <- getCurrentTimeZone
           t  <- getCurrentTime
           return $ localDay $ utcToLocalTime tz t

main = do t <- today
          let next = nextYear t
          print $ diffDays next t

参考

2009-10-01(木)

Writerモナドを試してみた

| Writerモナドを試してみた - みずぴー日記 を含むブックマーク

30分プログラム、その670。Writerモナドを試してみました。

前回がReaderモナドだったので、今回はWriterモナドを試してみました。

The Writer monadには、Writerモナドは裏でログをとったりするのに便利だと書いてあったので、関数の呼び出しを記録してみました。

使い方

&#42;Main> runWriter $ fib 10
(55,["fib(10)",
     "fib(9)",
     "fib(8)",
     "fib(7)",
     "fib(6)",
     "fib(5)",
     "fib(4)",
     "fib(3)",
     "fib(2)",
     "fib(2)",
     "fib(3)",
     "fib(2)",
     ....])

とやって、普通のフィボナッチ数の定義が、いかに非効率かに驚く。

そのあと、

&#42;Main> runWriter $ fibi (1,0) 10
(55,["fibi(10)","fibi(9)","fibi(8)",...])

とやって、フィボナッチ数の反復的な定義が、いかに効率的かに驚く。

ソースコード

import Control.Monad.Writer
import Text.Printf

fib :: Int -> Writer [String] Int
fib 0 = return 0
fib 1 = return 1
fib n = do tell [printf "fib(%d)" n]
           a <- fib (n-1)
           b <- fib (n-2)
           return $ a + b

fibi :: (Int,Int) -> Int -> Writer [String] Int
fibi (current,_) 1 = return current
fibi (current,prev) n = do tell [printf "fibi(%d)" n ]
                           fibi (current+prev,current) (n-1)

参考

2009-09-23(水)

Readerモナドを試してみる

| Readerモナドを試してみる - みずぴー日記 を含むブックマーク

30分プログラム、その663。Readerモナドを試してみました。

The Reader monadを読んでたら、環境がどうのこうの書いてあったので、簡単なプログラミング言語を作ってみました。環境が使いたかっただけなので、変数束縛と変数参照のほかには、整数リテラルと加算演算子ぐらいしかありません。

前に読んだHaskellの入門書には「複数の関数で引数を共有したいときはReaderモナドを使うといいよー」と書いてあったけど、微妙に違う気がする。共有できるのは引数一個だけだし、共有してる変数を書き換えることもできるし。

使い方

&#42;Main> runEval $ Int 40 `Add` Int 2
42

*Main> runEval $ Let ("x",Int 1) $ Int 4 `Add` Var "x"
5

ソースコード

import Control.Monad.Reader

data Expr = Let (String,Expr) Expr
          | Var String
          | Int Int
          | Expr `Add` Expr deriving Show

type Env  = [(String,Int)]

eval :: Expr -> Reader Env Int
eval (Int n)       =
    return n
eval (Add lhs rhs) =
    do x <- eval lhs
       y <- eval rhs
       return $ x + y
eval (Var name) =
    do val <- asks $ lookup name
       return $ case val of
                  Just x  -> x
                  Nothing -> 0
eval (Let (name,value) body) =
    do value' <- eval value
       local ((name,value'):) $ eval body

runEval e = runReader (eval e) []

参考