はてな使ったら負けだと思っている deriving Haskell このページをアンテナに追加 RSSフィード

 | 

2010-06-23

Quasi Quoter をつくってライブラリ風にしてみた。

|  Quasi Quoter をつくってライブラリ風にしてみた。 - はてな使ったら負けだと思っている deriving Haskell を含むブックマーク はてなブックマーク -  Quasi Quoter をつくってライブラリ風にしてみた。 - はてな使ったら負けだと思っている deriving Haskell

githubレポジトリつくりました。ついでにCabalに対応。

準クォートを使える様にしました。こんな感じで使える

import Data.Graph.Inductive
import Data.Graph.EasyGrapher
import Data.Graph.Quote
import Data.Graph.PageRank

main = do
  print (pageRanks ([$gr| D1 -> D2, D1 -> D3, D1 -> D4, D2->D3, D2->D5, D3-> D4, D4->D1, D5 -> D3|] :: Gr String()) 0.4 0.05)
  print ([$gr| a -> b, b -> 1, 1 -> c |] :: Gr String ())

で、Cabalに対応したと思ったら、対応してなかったので、あとで直します。直しました。cabal configure && cabal build && cabal install で入ります。まだHackageには登録してません。

おやすみなさい。

簡易グラフ作成ライブラリを書いた

|  簡易グラフ作成ライブラリを書いた - はてな使ったら負けだと思っている deriving Haskell を含むブックマーク はてなブックマーク -  簡易グラフ作成ライブラリを書いた - はてな使ったら負けだと思っている deriving Haskell

g:haskell:1277298780:title=と云う訳で]、グラフを割合簡単に書けるライブラリを書いた。

こんな感じにつかう。

Prelude> :l EasyGrapher.hs
[1 of 1] Compiling EasyGrapher      ( EasyGrapher.hs, interpreted )
Ok, modules loaded: EasyGrapher.
*EasyGrapher> buildGraph ["D1":=>"D2", "D1":=>"D3", "D1":=>"D4", "D2":=>"D3", "D2":=>"D5", "D3":=> "D4", "D4":=>"D1", "D5":=>"D3"] :: Gr String ()
1:"D1"->[((),4),((),3),((),2)]
2:"D2"->[((),5),((),3)]
3:"D3"->[((),4)]
4:"D4"->[((),1)]
5:"D5"->[((),3)]
*EasyGrapher> 

お手軽!唯一つの頂点のみからなるグラフは作れませんが、まあ、そう云うのはData.Graph.Inductiveを直に呼べばいいじゃない。

ソースはこちら。または続きを読め。

{-# LANGUAGE NamedFieldPuns #-}
module EasyGrapher (EGGraph(..), EGEdge(..), buildGraph) where
import Data.Graph.Inductive hiding(empty)
import qualified Data.Graph.Inductive as G
import Control.Monad
import Data.Map hiding (map, empty)
import qualified Data.Map as M
import Control.Monad.State 
import Data.Maybe
import Prelude hiding (lookup)

data (Eq a, Ord a) => EGEdge a = a :=> a
type EGGraph a = [EGEdge a]

data Env gr a = Env{graph :: gr a (), dic :: Map a Node}
empty :: (Eq a, DynGraph gr) => Env gr a
empty = Env{graph = G.empty, dic = M.empty}

type GrMachine gr lab a = State (Env gr lab) a

buildGraph :: (DynGraph gr, Ord a) => EGGraph a -> gr a ()
buildGraph xs = evalState (build xs) empty

build :: (Ord lab, DynGraph gr) => [EGEdge lab] -> GrMachine gr lab (gr lab ())
build [] = gets graph 
build ((lab1 :=> lab2):xs) = do
    [n1, n2] <- mapM toNode [lab1, lab2]
    env@Env{graph} <- get
    put $ env{graph=insEdge (n1, n2, ()) graph}
    build xs
  where
    toNode :: (Ord lab, DynGraph gr) => lab -> GrMachine gr lab Node
    toNode lab = do
      cond <- gets $ notMember lab . dic
      when cond $ mkNode lab
      gets $ fromJust . lookup lab . dic
    mkNode :: (Ord lab, DynGraph gr) => lab -> GrMachine gr lab ()
    mkNode lab = do
      (nd:_) <- gets (newNodes 1 . graph)
      env@Env{graph, dic} <- get
      put $ env{graph=insNode (nd, lab) graph, dic=insert lab nd dic}

PageRank の計算

| PageRank の計算 - はてな使ったら負けだと思っている deriving Haskell を含むブックマーク はてなブックマーク - PageRank の計算 - はてな使ったら負けだと思っている deriving Haskell

大学の授業でPageRankの計算について習ったので、それを計算するプログラムを書いてみた。下の続きを読む以下にも同じソースがあります。

要・fgl。Haskell Platform なら入ってると思います。

最初授業中に書いたのは以下。

-- mypagerank.hs
epsilon = 0.4
count = 5
err = 0.05
initial = [0.2,0.2,0.2,0.2,0.2]
calc [d1, d2, d3, d4, d5] = [f$d4/1, f$d1/3, f$d1/3+d2/2+d5,f$d3+d1/3, f$d2/2]
  where f a = epsilon/count + (1-epsilon)*a
hoge= zipWith zip t (tail t) where t = iterate calc initial 
ans = map snd$head$dropWhile (any ((>err).abs.uncurry (-))) hoge
main=print ans

で、実行するとこうなる。

$ runhaskell mypagerank.hs
[0.26,0.1248,0.2304,0.2688,0.11599999999999999]

これだと講義でやったグラフのランクしか出せないし、ちょっと遅いので書き直したのが、上のgistに挙げたコードなのでした。

で、その実行例。

$ ghci
GHCi, version 6.12.1: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
Prelude> :load "../haskell/pagerank.hs"
[1 of 1] Compiling Main             ( ../haskell/pagerank.hs, interpreted )
Ok, modules loaded: Main.
*Main> let gr = mkGraph (zip [1..5][(),(),(),(),()]) [(1,2,()), (1,3,()),(1,4,()), (2,3,()),(2,5,()), (3,4,()),(4,1,()), (5,3,())] :: Gr () ()
*Main> print gr -- グラフの形
1:()->[((),4),((),3),((),2)]
2:()->[((),5),((),3)]
3:()->[((),4)]
4:()->[((),1)]
5:()->[((),3)]
*Main> pageRanks gr 0.4 0.05 -- ε=0.4, 誤差0.05 でグラフgrの誤差を計算
fromList [(1,0.26),(2,0.1248),(3,0.2304),(4,0.2688),(5,0.11599999999999999)]

巧く動いてる!やった!

import Control.Monad.RWS
import Data.Graph.Inductive
import Prelude hiding (map, lookup)
import Data.Map hiding (map)
import Data.Maybe (fromJust)
import Control.Monad

map :: (Functor f) => (a -> b) -> f a -> f b
map = fmap

data Env = Env {node :: [Node], from :: Map Node [Node], outdegrees :: Map Node Int}
type RankDic = Map Node Double 
type PRMachine = RWS Env () RankDic

lookupEnv :: (Ord a) => (Env -> Map a b) -> a -> PRMachine b
lookupEnv f a = do{ dic<-asks f; return $ fromJust $ lookup a dic}

outdegree :: Node -> PRMachine Int
outdegree = lookupEnv outdegrees

froms :: Node -> PRMachine [Node]
froms = lookupEnv from

currentRank :: Node -> PRMachine Double
currentRank nd = gets (fromJust.lookup nd)

pageRanks :: (Graph gr) => gr a b -> Double -> Double -> RankDic
pageRanks gr epsilon error = fst $ execRWS steps Env{node=nds, from=froms, outdegrees=outdegs} initRanks
    where nds = nodes gr
          count :: (Num a) => a
          count = fromIntegral $ noNodes gr
          froms = fromList $ zip nds $ map (pre gr) nds
          outdegs = fromList $ zip nds $ map (outdeg gr) nds
          initRanks = fromList $ zip nds $ replicate count (1/count)
          steps = do
            old <- get
            new <- calcPageRank epsilon
            let cond = foldWithKey (\k a b -> b && ((findWithDefault (1/0) k new)-a < error)) True old
            if cond then return new else steps
            
            

calcPageRank :: Double -> PRMachine RankDic
calcPageRank epsilon = do
  nds <- asks node
  dic <- forM nds $ \n -> do
                 frms <- froms n
                 ranks <- forM frms $ \m -> do
                            deg <- outdegree m
                            rank <- currentRank m
                            return (rank/fromIntegral deg)
                 count <- liftM (fromIntegral.length) $ asks node
                 return (n, epsilon/count + (1-epsilon)*(sum ranks))
  let rdic = fromList dic
  put rdic
  return rdic

グラフとはすける

| 22:13 |  グラフとはすける - はてな使ったら負けだと思っている deriving Haskell を含むブックマーク はてなブックマーク -  グラフとはすける - はてな使ったら負けだと思っている deriving Haskell

Data.Graph も、 Data.Graph.Inductiveもそれなりに使い辛いんですが、なんか良いライブラリありませんかね……

トラックバック - http://haskell.g.hatena.ne.jp/mr_konn/20100623
 |