haskellのK-meansのソース読んでたら

dist a b = sqrt . sum $ zipWith (\x y-> (x-y) ^ 2) a b

ってのがあって、pythonでzipWithってあったかなーと思って検索したら、自分のwikiが引っかかった。★付けたいところ。

これをつかうと

from math import *
zipWith = lambda f, xs, ys : [f(x, y) for x,y in zip(xs, ys)]
def dist(xs, ys): return sqrt(sum(zipWith(lambda x, y: (x-y)**2, xs, ys)))

となって、任意の次元にも対応出来る

>>> dist([1,2,3,4],[2,2,2,2])
2.4494897427831779

mixiの課題丸投げから「10000以下の完全数を求める」

[n|n <- [1..10000],sum [x | x <- [1..(n `div` 2)], n `mod` x == 0] == n]

mixiの課題丸投げから

$ runhaskell mixi100116.hs mixi100116.hs
1: import System
2: 
3: main = do
4:   file:_ <- getArgs
5:   content <- readFile file
6:   mapM_ putStrLn $ withNum 1 $ lines content
7:   where 
8:     withNum n [] = []
9:     withNum n (x:xs)  = ((show n) ++ ": " ++ x) : (withNum (n+1) xs)

追記

zipWithがあるじゃないか。忘れてた。

1: import System
2: 
3: main = do
4:   file:_ <- getArgs
5:   content <- readFile file
6:   mapM_ putStrLn $ zipWith (\n x -> show n ++ ": " ++  x) [1..]  (lines content)

数字の連番くっつけたいときはそういうリストを用意してまぜ合わせる。

昨日の続き。ここを参考にした。

import Monad
maze = ["**************************",
        "*S* *                    *",
        "* * *  *  *************  *",
        "* *   *    ************  *",
        "*    *                   *",
        "************** ***********",
        "*                        *",
        "** ***********************",
        "*      *              G  *",
        "*  *      *********** *  *",
        "*    *        ******* *  *",
        "*       *                *",
        "**************************"]

type Pos = (Int,Int)
type Path = [Pos]

findPos :: [String] -> Char -> Pos
findPos mz c =
    let y = findY mz c 0
        x = findX (mz!!y) c 0
    in (x,y)
    where
      findY :: [String] -> Char -> Int -> Int
      findY [] _ _     = error (c : " not found\n")
      findY (x:xs) c n | c `elem` x = n
                       | otherwise  = findY xs c (n+1)
      findX :: String -> Char -> Int -> Int
      findX (x:xs) c n | x == c     = n
                       | otherwise  = findX xs c (n+1)

canMove :: [String] -> Pos -> Bool
canMove mz (x,y) | mz !! y !! x == '*' = False
                   | otherwise             = True

nextSteps :: [String] -> Pos -> [Pos]
nextSteps mz (x,y) = filter (canMove mz) [(x-1,y),(x+1,y),(x,y-1),(x,y+1)]

getAllPaths :: [String] -> Pos ->  Pos -> [Path]
getAllPaths mz st gl = getPath mz gl [ x : [st] | x <- nextSteps maze st]

getPath :: [String] -> Pos -> [Path] -> [Path]
getPath _ _ [] = fail "no Path"
getPath mz p1 ap@(path:queue)
    | p0 == p1 =  (return (reverse path)) `mplus` (getPath mz p1 queue)
    | otherwise = getPath mz p1 ( queue ++ [ x : path | x <- nextSteps mz p0, not (or (map (x `elem`) ap))])
    where p0 = head path


start = findPos maze 'S'
goal  = findPos maze 'G'
allpath = getAllPaths maze start goal

path全体で一度通った位置を再度通らないようにしないと終わらなかった。

どう書くは知ってる言語で解くのは楽しいけど、習い始めの言語はつらい。というわけで、mixiの課題丸投げあたりをチョイスすることが多い。

覆面算を解くというのがあったのでやってみた。XYZ + WXYZ + WXYZ + VWXYZ + VWXYZ = UVWXYZを満たす文字をそれぞれ求める。

題意からU=1は自明なんだけどあえて力技で。

-- XYZ + WXYZ + WXYZ + VWXYZ + VWXYZ = UVWXYZ
-- 4*Z + 4*10*Y + 4*100*X + 3*1000*W + 10000*V = 100000*U

check :: [Int] -> Bool
check (u:v:w:x:y:z:_) = 10000*v + 3000*w + 400*x + 40*y + 4*z == 100000*u

notDup :: [Int] -> Bool
notDup (x:xs)= notDup' x xs
    where notDup' _ [] = True
          notDup' x yy@(y:ys) | x `elem` yy = False
                              | otherwise   = notDup' y ys

sol :: [[Int]]
sol = filter check $ filter notDup
      [[u,v,w,x,y,z]|u <- [0..9], v <- [0..9], w <- [0..9], x <- [0..9], y <- [0..9], z <- [0..9]]

全通りの組み合わせを作ってから数字がダブっている組み合わせを除いた。

結局、組み合わせを最初から使えばいいので、0から9の数字の中から6つを選んで、それらの入れ替えをしながらチェックをするのもやってみた。

import List


check :: [Int] -> Bool
check (u:v:w:x:y:z:_) = 10000*v + 3000*w + 400*x + 40*y + 4*z == 100000*u

comb :: [Int] -> Int -> [[Int]]
comb _ 0     = [[]]
comb [] _     = []
comb (x:xs) n = map (x:) (comb xs (n-1)) ++ comb xs n

permutation [] = [[]]
permutation xs = concat [map (x:) $ permutation (delete x xs) | x <- xs]

sol = filter check $ concatMap permutation (comb [0..9] 6)

combとpermutationはProgramming:玉手箱:組合せを参考にした

実際にやってみると位置を記録すんのに手間取ったり(pythonはenumarateがあるので楽)とか、リストモナドの使い方をちゃんと理解してなかったりとかで、終わらん。

import List

maze = ["**************************",
        "*S* *                    *",
        "* * *  *  *************  *",
        "* *   *    ************  *",
        "*    *                   *",
        "************** ***********",
        "*                        *",
        "** ***********************",
        "*      *              G  *",
        "*  *      *********** *  *",
        "*    *        ******* *  *",
        "*       *                *",
        "**************************"]

type Pos = (Int,Int)
type Path = [Pos]

findPos :: [String] -> Char -> Pos
findPos maze c = 
    let y = findY maze c 0 
        x = findX (maze!!y) c 0
    in (x,y)
    where
      findY :: [String] -> Char -> Int -> Int
      findY [] _ _     = error (c : " not found\n")
      findY (x:xs) c n | c `elem` x = n
                       | otherwise  = findY xs c (n+1)
      findX :: String -> Char -> Int -> Int
      findX (x:xs) c n | x == c     = n
                       | otherwise  = findX xs c (n+1)

start = findPos maze 'S'
goal  = findPos maze 'G'

canMove :: [String] -> Pos -> Bool
canMove maze (x,y) | maze !! y !! x == '*' = False
                   | otherwise             = True

enableSteps :: [String] -> [Pos] -> [Pos]
enableSteps maze path@((x,y):_) = filter (canMove maze) [(x-1,y),(x+1,y),(x,y-1),(x,y+1)]

getAllPaths :: [String] -> Pos -> [Path]
getAllPaths maze start = [[start]] >>= toward
                         where 
                           toward :: Path -> [Path]
                           toward path
                                  | not.null $ moves = map (:path) moves >>= toward
                                  | otherwise = [path]
                                  where 
                                    moves = enableSteps maze path

結局、リストモナドをどうつなげていったらいいのかというところでつまづいている。あと[String]っていう型じゃなくてMazeとかいう型にしといた方がよかったかも。

21章は短い

• HDBC
• HDBC driver for Sqlite v3

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

HDBC-2.1.0だと下のようなエラーがずらずらでるのでgitで入れる。

Database/HDBC/SqlValue.hs:585:9:
    Duplicate instance declarations:
      instance Typeable Day
        -- Defined at Database/HDBC/SqlValue.hs:585:9-20
      instance Typeable Day
        -- Defined in time-1.1.4:Data.Time.Calendar.Days

使ってみる

Prelude> :m Database.HDBC Database.HDBC.Sqlite3
Prelude Database.HDBC Database.HDBC.Sqlite3> conn <- connectSqlite3 "drkcore.db"
Prelude Database.HDBC Database.HDBC.Sqlite3> getTables conn
["entries","entry_tags","roles","tags","user_roles","users"]
Prelude Database.HDBC Database.HDBC.Sqlite3> \
quickQuery' conn "select title from entries where pubdate > '2010-01-01'" []
[[SqlByteString "\229\155\155\229\173\163\230\161\156\227\129\174\232\138\ ...

これをutf8で出力したいのでWIKIも読んどく。

20.5はパイプ

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

理解はあやしいがとりあえず写経して動くとこまで。

*RunProcessSimple> runIO $ "ls /Users/kzfm/haskell" -|- "grep '.hs~'" -|- "tr a-z A-Z"
BARCODE.HS~
LOGGER.HS~
PNM.HS~
PARSE.HS~
RANDOM.HS~
RUNPROCESSSIMPLE.HS~

• Control.Concurrent.MVar
  • 第12回　Haskellで学ぶ並列プログラミング
• nub
  • Data.Listにあって重複を除く

関数プログラミングのアプローチを9から15まで読んだが多分消化不良。

bindとかみていると継続との違いがわからなくなってしまった。

ふつうのhaskellとか、ITproとか読んでみたけど、わからん。

これを「ほうなるほど」といえるようになるくらいまで理解力を高める。

今年の目標に「モナドを理解する」も追加しておく。

今週末に「プログラミングHaskell」の読書会があります。

• 日時： 2010年1月16日（土） 13:00～17:30
• 場所： 静岡市産学交流センター 演習室 1 (http://www.hanjyou.jp/)
• 地図： http://www.hanjyou.jp/map.html

プログラミングHaskell
Graham Hutton
オーム社 / ￥ 2,940 ()
在庫あり。