C/C++の課題丸投げ

sieve (x:xs) = x : sieve [y|y<-xs,y `mod` x /= 0]
prime = sieve [2..]

fglを使えばよい。

import Data.Graph.Inductive
import Data.Graph.Inductive.Example
import Data.Graph.Inductive.Graphviz

m486 :: NodeMap String
m486 = fromGraph clr486

t1 :: Gr String ()
t1 = insMapEdge m486 ("shirt", "watch", ()) clr486

t2 :: Gr String ()
t2 = insMapEdge m486 ("watch", "pants", ()) t1

main = do putStrLn $ graphviz t2 "test" (0,0) (0,0) Portrait

これはDOT言語で出力される。

digraph test {
    margin = "0"
    page = "0.0,0.0"
    size = "0.0,0.0"
    rotate = "0"
    ratio = "fill"
    1 [label = "shorts"]
    2 [label = "socks"]
    3 [label = "watch"]
    4 [label = "pants"]
    5 [label = "shoes"]
    6 [label = "shirt"]
    7 [label = "belt"]
    8 [label = "tie"]
    9 [label = "jacket"]
    1 -> 4
    1 -> 5
    2 -> 5
    3 -> 4
    4 -> 7
    4 -> 5
    6 -> 3
    6 -> 8
    6 -> 7
    7 -> 9
    8 -> 9
}

pngで出力したいときにはdotに渡す。

$ ./gvtest | dot -Tpng > gvtest.png

参考

• Stern-Brocot 木 を Haskell + Graphviz で

プログラム・プロムナードのRubicキューブと置換の乗算を読んで2X2のソルバーを書いていたんだけど、巡回とねじりを覚えれば基本的に解けるのでリアルのほうを揃える方に夢中になってしまった。

*Main> prodPerm [e,t,t,e,s',b,b,s,e',t,t,e,s',b,b,s,e',e']
[[TSW,WTS,SWT],[TES,EST,STE]]
*Main> prodPerm [e,e,s,s,e',n',e,s,s,e',n,e']
[[STE,WTS,ETN],[EST,SWT,NET],[TES,TSW,TNE]]

ルービックの2×2 キューブ(CUBE)

メガハウス / ￥ 1,260 (2002-03-20)
在庫あり。

プログラム・プロムナードのRubicキューブと置換の乗算を読んでいたら、文字のローテションをしたいときにcycleを使っているのを見つけた。

import List

shift n c xs = case elemIndex c xs of
                 Nothing -> c
                 Just i  -> cycle xs !! (i + n) 

こんな感じ。

*Main> shift 1 'y' ['a'.. 'z']
'z'
*Main> shift 1 'z' ['a'.. 'z']
'a'
*Main> shift 1 ' ' ['a'.. 'z']
' '

これを使えばプログラミングHaskellのシーザー暗号は次のように書ける

import List

chrs = ['a'..'z']

shift n c xs = case elemIndex c xs of
                 Nothing -> c
                 Just i  -> cycle xs !! (i + n)   

encode n xs = [shift n x chrs | x <- xs]

実行

*Main> encode 3 "haskell is fun"
"kdvnhoo lv ixq"

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

UDPとTCPでsyslogサーバとクライアント作って通信させる。

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

28章はSTMだけどこれはJava並行処理プログラミング読んでからにしよう。

Java並行処理プログラミング ―その「基盤」と「最新API」を究める―
Brian Goetz,Joshua Bloch,Doug Lea
ソフトバンククリエイティブ / ￥ 3,990 ()

これで一通り読んだので、そのうちもう一度読む。二周目は練習問題解きながら。

HaXmlとHDBCを使ってXMLの構文解析とSQLiteのデータベース操作を組み合わせてpodcastのダウンローダーをつくるというなかなか楽しい章だが、このまえSQLAlchemyの本読んでたから、SQL文を直接埋め込むのはなんか面倒くさかった。

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

順調に消化するはずだったがHaXmlを使ったパーサーが文句を言う

PodParser.hs:40:11:
    `CFilter' is not applied to enough type arguments
    Expected kind `?', but `CFilter' has kind `* -> *'
    In the type signature for `channel':
      channel :: CFilter

んー？型が悪いの？

Prelude Text.XML.HaXml> :i CFilter
type CFilter i = Content i -> [Content i] -- Defined in Text.XML.HaXml.Combinators

あれ？type CFilter = Content -> [Content]じゃない。

多分これだな。

効率のよいエラーの仕組みを導入。

type ThrowsError = Either LispError

みたいなのが慣れない。Either a bがaとbの両方をとるみたいに感じちゃうからか。実際に下のようにしてみると納得出来るんだけど。

ここにあった例を

int_sqrt :: Int -> (Either Int Double)
int_sqrt x | fsdx * fsdx == x  = Left fsdx  
           | otherwise = Right sdx
 where sdx = sqrt $ fromIntegral x
       fsdx = floor sdx

このように変えてみた

type Leftint = Either Int

int_sqrt :: Int -> (Leftint Double)
int_sqrt x | fsdx * fsdx == x  = Left fsdx  
           | otherwise = Right sdx
 where sdx = sqrt $ fromIntegral x
       fsdx = floor sdx

まぁそうだよなと思う。

Write Yourself a Scheme in 48 Hoursを3章まで読んだ。RWHのParsecの章を読んでたのと、やさしい Lisp の作り方をMooseでトレースしたことがあるので割とすんなりと進んだ。

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

Beginning the Evaluatorの章に

apply func args = maybe (Bool False) ($ args) $ lookup func primitives

ってのがあって、僕はちょっと前まで$を()の構文糖衣だと勘違いしてたのでなんか違和感が。

($ [1,2,3]) (map (1+)) :: map (1+) [1,2,3]

は見慣れれば楽なのかもしれないが。

Prelude> (($[1,2,3]).map) (2-)
[1,0,-1]

とかやるとmapがメソッドっぽく見える

mixiの課題丸投げ

import Data.List (sortBy,sort)
import Data.Ord (comparing)

meansort xs = sortBy (comparing (abs . ((average xs)-))) (sort xs)
    where
      average xs = sum xs `div` (length xs)

前回の行番号付きでファイルの出力に、さらに5行出力するごとにファイル名行番号を反転表示した後、一時停止して、リターンを押したら出力を再開するプログラムをかけという問題が丸投げされていたのでやってみた。

import System
import System.Console.Readline (readline)

showNext xs file = showNext' 1 xs file

showNext' n xs f | next == [] = do mapM_ putStrLn $ zipWith (\n x -> show n ++ ": " ++  x) [n..]  this
                 | otherwise  = do mapM_ putStrLn $ zipWith (\n x -> show n ++ ": " ++  x) [n..]  this
                                   maybeLine <- readline $ "\ESC[7m" ++ f ++ "(" ++ show (n+4) ++"):\ESC[m"
                                   case maybeLine of
                                     Nothing   -> return ()
                                     Just ""   -> showNext' (n+5) next f
                 where
                   (this,next) = splitAt 5 xs

main = do
  file:_ <- getArgs
  content <- readFile file
  showNext (lines content) file

反転表示を戸惑ったのだけど、教えてもらって解決。

showNext'が冗長なので、もう少し綺麗に書きたい。Stateモナドとか使うといいのかなぁ。