Haskell で線形探索(番兵)

同じように配列に対する線形探索を書いた。Haskell のリストをわざわざメモリ上に保存しなおしているという無駄があるがサンプルなので気にしないことにする。

linearSearch :: (Eq a, Storable a) => a -> [a] -> IO (Bool, Int)
linearSearch target xs =
  let n = length xs
  in
   do
     p <- mallocArray (n + 1)
     mapM_ (\(x, i) -> pokeElemOff p i x) (zip xs [0..])
     pokeElemOff p n target -- 番兵
     i <- search p target 0
     if i == n then
       return (False, i)
       else
       return (True, i)
  where
    search p x i = do  
      y <- peekElemOff p i
      if x == y then
        return i
        else
        search p x (i + 1)

Haskell でStackを(3)

今度はスタックのサイズは固定、要素もIntのみで、状態モナドを止めてみた。スタック自身でポインタを管理する。これで複数のスタックを使える。ほぼCの構造体になったと思うがわたしはCを書けないので自信なし。

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable

stackSize :: Int
stackSize = 20

-- スタックのインデックスとスタック本体へのポインタ
data Stack = Stack Int (Ptr Int) deriving Show

instance Storable Stack where
  alignment _ = 16
  sizeOf _ = 16
  peek ptr = do
    n <- peek (castPtr ptr)
    p <- peek (castPtr ptr `plusPtr` 8)
    return $ Stack n p
  poke ptr (Stack n p) = do
    poke (castPtr ptr) n
    poke (castPtr ptr `plusPtr` 8) p

mkStack :: IO (Ptr Stack)
mkStack = do
  p <- malloc :: IO (Ptr Stack)
  s <- mallocArray stackSize
  poke p (Stack 0 s)
  return p

push :: Ptr Stack -> Int -> IO (Ptr Stack)
push st x = do
  Stack i p <- peek st
  if i >= stackSize then
    error "oops. Stack overflow"
    else
      do
        pokeElemOff p i x
        poke st (Stack (i + 1) p) 
        return st

pop :: Ptr Stack -> IO Int
pop st = do                       
  Stack i p <- peek st
  if i <= 0 then error "oops. Stack underflow"
    else
      do
        x <- peekElemOff p (i - 1)
        poke st (Stack (i - 1) p)
        return x

calc :: (Int -> Int -> Int) -> Ptr Stack -> IO (Ptr Stack)
calc f st = do
  x <- pop st
  y <- pop st
  push st (f x y)

add :: Ptr Stack -> IO (Ptr Stack)
add = calc (+)
sub :: Ptr Stack -> IO (Ptr Stack)
sub = calc (-)

使い方はこのように変わる。

test0 = do
  st <- mkStack
  push st 9
  pop st

Haskell でスタックを(2)

Haskell でスタックを書く、続き。スタックのサイズは固定のまま、スタックの要素を変更できるようにした。

  1. スタックは Foreign.Marshal.Array.mallocArray で確保する。
  2. 確保した領域へのポインタは(グローバル変数の替わりに)状態モナドで管理する。
-- Stack
import Control.Monad.State
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable

stackSize :: Int
stackSize = 20

initStack :: Storable a => IO (Ptr a, Int)
initStack = do
  p <- mallocArray stackSize
  return (p, 0)
-- https://www.haskell.org/haskellwiki/Scoped_type_variables より
sizeOfPtr :: (Storable a) => Ptr a -> Int
sizeOfPtr = sizeOf . (undefined :: Ptr a -> a)

push :: (Storable a, Num a) => a -> StateT (Ptr a, Int) IO ()
push x = do
  (stack, sp) <- get
  if sp >= stackSize then
    error "oops. Stack overflow"
    else
    do
      lift $ pokeElemOff stack sp x
      put (stack, sp + 1)
      return ()

pop :: (Storable a, Num a) => StateT (Ptr a, Int) IO a
pop = do
  (stack, sp) <- get
  if sp > 0 then
    do
      x <- lift $ peekElemOff stack (sp - 1)
      put (stack, sp - 1)
      return x
    else error "oops. Stack undeflow"

calc :: (Storable a, Num a) => (a -> a -> a) -> StateT (Ptr a, Int) IO ()
calc f = do
  x <- pop
  y <- pop
  push (f x y)

add :: (Storable a, Num a) => StateT (Ptr a, Int) IO ()
add = calc (+)
sub :: (Storable a, Num a) => StateT (Ptr a, Int) IO ()
sub = calc (-)

以下のように使う。

-- initStack >>= runStateT test0

test0 :: StateT (Ptr Int, Int) IO Int
test0 = do
  push 9
  pop
  
test1 :: StateT (Ptr Int, Int) IO ()
test1 = do
  push 3
  push 99
  x <- pop
  lift $ putStrLn $ "x: " ++ show x
  y <- pop
  lift $ putStrLn $ "y: " ++ show y

test2 :: StateT (Ptr Int, Int) IO Int
test2 = do
  push 8
  push 9
  pop
  pop  
  push 11
  push 13  
  pop
  pop

test4 :: StateT (Ptr Float, Int) IO Float
test4 = do
  push 5.0
  push 7.0
  push 8.0
  add
  sub
  pop

参考

Haskell でスタックを書く

Ptr, malloc の勉強のため Haskell でスタックを書いてみた。いろいろ間違っている可能性あり。

  1. スタックは mallocBytes で確保する。
  2. 確保した領域へのポインタは(グローバル変数の替わりに)状態モナドで管理する。
-- Stack
import Control.Monad.State
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable

stackSize :: Int
stackSize = 12
intSize :: Int
intSize = sizeOf (undefined :: Int)

push :: Int -> StateT (Ptr Int, Int) IO ()
push x = do
  (stack, sp) <- get
  if (sp >= stackSize) then
    error "Stack overflow"
  else
   do
     lift $ poke (stack `plusPtr` (sp * intSize) :: Ptr Int) x
     put (stack, sp + 1)
     return ()
      
pop :: StateT (Ptr Int, Int) IO Int
pop = do
  (stack, sp) <- get
  if (sp > 0) then
    do
      x <- lift $ peek (stack `plusPtr` ((sp - 1) * intSize) :: Ptr Int)
      put (stack, sp - 1)
      return x
    else error "Stack undeflow"

initStack :: IO (Ptr Int, Int)
initStack = do
  p <- mallocBytes (stackSize * intSize)
  return (p, 0)

-- 実行方法 
-- initStack >>= evalStateT test0

test0 = do
  push 9
  pop
  
test1 = do
  push 3
  push 99
  x <- pop
  lift $ putStrLn $ "x: " ++ show x
  y <- pop
  lift $ putStrLn $ "y: " ++ show y

test2 = do
  push 8
  push 9
  pop
  pop  
  push 11
  push 13  
  pop
  pop

参考

以下のリンクに必要な情報は全てある。

Emacs M-| (shell-command-on-region)

メモ

;; バッファを対象にした shell-command-on-region
(defun shell-command-on-buffer (command)
  (interactive (let (string)
		 (list (read-shell-command "Shell command on buffer: "))))
  (shell-command-on-region (point-min) (point-max) command
                           nil nil nil t))

Haskell graphviz 関連

Hackage で graphviz 関連を検索したもの(http://hackage.haskell.org/packages/search?terms=graphviz)。

Monad Ambiguous type variable

例は IFPH 10章より。

data Term = Con Int | Div Term Term 

evalId (Con x) = return x
evalId (Div t u) = do x <- evalId t
                      y <- evalId u
                      return (x `div` y)

上記は意図的に evalId の型を指定していない。型を調べると、

:t evalId
evalId :: Monad m => Term -> m Int

と推論されていて、具体的なモナド(例えば Identity モナド) を指定しないと動かないように思える。実際、別の変数に束縛しようとするとエラーになる。にもかかわらず、ghci で実行すると実行できてしまう。

:t evalId (Con 13)
=>
evalId (Con 13) :: Monad m => m Int

let x = evalId (Con 0)
=>
Ambiguous type variable m0 in the constraint:
  (Monad m0) arising from a use of evalId

evalId (Con 13)
=>
13

これはいったい何が起きているのだろう?