2020年5月23日土曜日

Haskell　Process

Haskellの System.Processは便利ですが、問題もあります。

単一スレッドでの逐次処理を保証していない。（想像です。）

次のようなスクリプトを書いてみた。

--a.hs
main = print [1..10]

--t.hs
import System.Process
loop x = createProcess (proc "runghc" ["a.hs"]) >> return ()
main = mapM_ loop [1..100]

実行結果。

$ runghc t.hs
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,[1,2,3,4,5,6,7,8,9,1[1,2,3,4,5,6,7,8,9,10]
5,6,7,8,9,10]
0]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,[1,2,3,4,5,6,7,8,9,10]
,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10[1,2,3,4[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4[1,2,3,4,5,6,7,8,9,10]
i@i:~/haskell$ [1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,,[1,2,3,4,5,6,7,8,9,10]
5,6,7,8,9,10]
]
[1,2,3,4,5,6,7,8,9,10]
,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3[1,2,3,4,5,6,7,8,9,10,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
,[1,2,3,4,5,6,7,8,9,10]
5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
]
[1,2,3,4,5,6,[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[[1,2,3,4,5,6,7,8,9,10]
1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,1[1,2,3,4,5,6,7,8,9,10]
7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
0[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
]
[1,2,3,4,5,6,7,8,9,10]
[[1,2,3,4,5,6,7,8,9,10]
1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8[1,2,3,4[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,,,5,6,[7,8,19,1,02]
,3,4,5,6,7,8,9,10]
9,10]
[1,2,3,4,5,6,7,8,9,10]
5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]
[1,2,3,4,5,6,7,8,9,10]

[1..10]のリストを書き終える前に次のリストを書き始めている。
１００回のLoop の途中で t.hs スクリプトを終了している。

深い意味は僕には不明ですが、実用プログラムで使う場合には注意が必要なのでは・・・。
時刻: 0 件のコメント:
ラベル:

2019年2月13日水曜日

セル・オートマトン

ソースコードは下記アドレス

https://github.com/index333/cellA

１次元のセル・オートマトンにルール３０を適用して得た画像。
一部Ｒｅｐａを使ってみました。


import Rule
import Prelude as P
import System.Environment
import Data.Array.Repa.IO.BMP
import Data.Array.Repa as R
import Control.Parallel.Strategies
getN :: IO Int
getN = do
a:_ <- getArgs
return $ read a
cells = 1001
fs :: [Bool]
fs = cs P.++ [b] P.++ cs
where cs = replicate n w
n = cells `div` 2
is = P.map (\x -> (x, x+1, x+2)) [0..(cells - 1)]
nextC :: Int -> (Bool,Bool,Bool) -> Bool
nextC rl (a,b,c) = rule rl i
where i = bToI [a,b,c]
loop t a n = do
rl <- getN
if n == 0
then return a
else do
let tt = (last t:t) P.++ [head t] --セル列の両端はリング状につながっている。
let ta = R.fromListUnboxed (Z :. cells+2) tt:: R.Array R.U R.DIM1 Bool
let toA = P.map (\x -> nextCell rl x ta) is
`using` parListChunk 100 rdeepseq
loop toA (toA P.++ a ) (n-1)
where nextCell rl (a,b,c) tt = nextC rl (tt ! (Z :. a), tt ! (Z :. b), tt ! (Z :. c))
main = do
bs <- loop fs fs (cells `div` 2)
let bbs = R.fromListUnboxed (Z :. (cells*(cells `div` 2 + 1))) bs :: R.Array R.U R.DIM1 Bool
let a = R.map (\x -> if x then bk else wt) bbs
computeP ( reshape (Z :. (cells `div` 2 + 1) :. cells) a) >>= (writeImageToBMP "a.bmp")
view raw cellA.hs hosted with ❤ by GitHub

module Rule where
import Data.Bits
import GHC.Word
rule :: Int -> Int -> Bool
rule = testBit
bk,wt :: (GHC.Word.Word8, GHC.Word.Word8, GHC.Word.Word8)
bk = (0,0,0)
wt = (255,255,255)
b,w :: Bool
b = True
w = False
bToI :: [Bool] -> Int
bToI bs = foldl (\x (y,z) -> if z then setBit x y else clearBit x y) (0::Int)
$ zipWith (\a b -> (a,b)) [0 ..] $ reverse bs
~
view raw Rule.hs hosted with ❤ by GitHub


以下のインストール　が必要。
$ cabal update -v
$ cabal install repa -v
$ cabal -v install repa-io
$ cabal install parallel -v
コンパイルは

$ ghc -O2 -threaded -rtsopts --make -XFlexibleContexts -eventlog cellA.hs

作成された実行ファイルを実行します。

$ ./cellA 110 +RTS -N2 -l

ルールはコマンドライン引数で与えます。

eventlog が作成されます。

＄ threadscope ｃellA.eventlog

 一応２コアで動いています。


ルール110の実行例。

$ display a.bmp

ルール４５
ルール２２５

時刻: 0 件のコメント:
ラベル:

2018年12月3日月曜日

Github リポジトリにファイルを追加

Githubのリポジトリにファイルをグラフィカルに追加する方法。 記事が少なくなかなかわからなかった。

赤丸の位置にファイルブラウザーから追加したいファイル（複数可）をドラッグすればよい。
内容の更新も同様。

update files というボタンを押してもよい。
時刻: 0 件のコメント:
ラベル:

2018年11月2日金曜日

Module ‘System.Cmd’ is deprecated

--b.hs 
import System.Cmd 
main = rawSystem "ls" ["-lh"] 

$ runghc b.hs
b.hs:1:1: Warning:
     Module ‘System.Cmd’ is deprecated: Use "System.Process" instead

import  System.Process 
main = createProcess (proc"ls" ["-lh"])
時刻: 0 件のコメント:
ラベル:

2018年6月21日木曜日

複素数

Pythonは複素数を直接書くことができます。

Python 2.7.12 (default, Dec  4 2017, 14:50:18)
[GCC 5.4.0 20160609] on linux2
Type "help", "copyright", "credits" or "license" for more information.
>>> a=0+1j
>>> a
1j

実数部が０のとき省略できます。

>>> a=1j
>>> a
1j

虚数部が０のときこれも省略できます。

>>> b=1
>>> b
1

これはただの実数ですが複素数と組み合わせるとちゃんと複素数の計算をしてくれます。

>>> a-b
(-1+1j)

複素数は距離の計算をとても楽にしてくれます。

a,b　２点間の距離は差をとって絶対値を計算すればよい。

>>> d=abs(a-b)
>>> d
1.4142135623730951

これは√２です。
これをｂに代入します。

>>> b=d
>>> b
1.4142135623730951
>>> d=abs(a-b)
>>> d
1.7320508075688774

これは√３です。
このように計算結果を次々に代入していけば全ての整数の平方根がもとめられます。
(複素数の計算の内部で　sqrt を使っているのでは？　というツッコミはあると思いますが無視してください）

Haskellではこのような記法はできません。
Data.Complex　モジュールの

(:+)

というコンストラクターで複素数のインスタンスをつくります。
Haskellではコンストラクターは関数であり、（：＋）は演算子として定義されているので次のようにします。

GHCi, version 7.10.3: http://www.haskell.org/ghc/  :? for help
Prelude> import Data.Complex
Prelude Data.Complex> let a=0:+1
Prelude Data.Complex> a
0 :+ 1
Prelude Data.Complex> let b=1:+0
Prelude Data.Complex> b
1 :+ 0

ちょっと不格好ですが・・・

Haskell　は、複素数の絶対値を複素数で返します。

Prelude Data.Complex> abs(a-b)
1.4142135623730951 :+ 0.0

これは abs が
abs :: Num a => a -> a
と定義されているからです。
かわりにmagnitudeをつかいます。

Prelude Data.Complex> :t magnitude
magnitude :: RealFloat a => Complex a -> a

Prelude Data.Complex> magnitude(a-b)
1.4142135623730951

ちなみに　Data.Complex　では　abs を
abs z               =  magnitude z :+ 0
と再定義しているようです。(^_^;)
N−１　の平方根がわかれば　N　の平方根が計算できることから再帰的に定義できます。

--ｒ．ｈｓ
import Data.Complex
dist a b = magnitude (a-b)
a = 0 :+ 1
r 0 = 0
r n = dist a b
    where b = r (n-1) :+ 0


Prelude> :l ｒ.hs
[1 of 1] Compiling Main             ( r.hs, interpreted )
Ok, modules loaded: Main.
*Main> map r [0..9]
[0.0,1.0,1.4142135623730951,1.7320508075688774,2.0,2.23606797749979,2.4494897427831783,2.6457513110645907,2.8284271247461903,3.0000000000000004]

容易に想像できると思いますがNが大きくなると時間がかかるようになります。

*Main> :set +s
*Main> r 1000000
1000.0000000000299
(7.74 secs, 1,673,363,512 bytes)

このような再帰は fold　で置き換えることができます。

*Main> let r' n = foldl (\x _ -> dist a (x :+ 0)) 0 [1..n]
*Main> r' 1000000
1000.0000000000299
(5.28 secs, 1,474,441,216 bytes)

さらに　Data.List　モジュールの　foldl' 　を使うと

*Main> import Data.List
*Main Data.List> let r'' n = foldl' (\x _ -> dist a (x :+ 0)) 0 [1..n]
*Main Data.List> r'' 1000000
1000.0000000000299
(2.52 secs, 1,293,766,728 bytes)

magnitude　自体が重い処理なのでそこそこかかります。

fold　を使ったコードは最初に説明した手続き的処理をそのまま置き換えている点に注目です。

手続き的なscanlの説明
参照

余談ですが　（：＋）　の型は　

Prelude Data.Complex> :t (:+)
(:+) :: a -> a -> Complex a

です。引数の型は何でもいいようです。ですので

Prelude Data.Complex> "hello" :+ "world"
"hello" :+ "world"
Prelude Data.Complex> :t it
it :: Complex [Char]

もちろん演算とかはできません。
時刻: 0 件のコメント:
ラベル:

2017年12月9日土曜日

gist.github の罠

main = do
let n = 3
print ｎ
view raw a.hs hosted with ❤ by GitHub
上のコードをコピペして実行する。

$ runghc a.hs

a.hs:3:11: error: Variable not in scope: ｎ

たぶんこのようなエラーになるはずです。
最初はなぜエラーになるのか理解できませんでした。


Vim上ではまったく見た目は同じです。

カーソルをのせてみると違いがわかります。






show してみると
main = do
putStrLn $ show "n"
putStrLn $ show "ｎ"
view raw b.hs hosted with ❤ by GitHub

$ runghc b.hs
"n"
"\65358"

65358は、16進の"ff4e"
つまりUnicodeの小文字　ｎ　です。
対して２行目の　n はアスキー。

 これはコードを日本語入力がONのまま修正したことでおこりました。
見た目は同じでも異なる文字なのでエラーとなりました。
時刻: 0 件のコメント:
ラベル:

2017年11月6日月曜日

ギヤ比

ソースコード
https://github.com/index333/gear

ギヤ比は一般には単に前後の比率で表します。
例えばフロント３０T　ｘ　リヤ２０Tの場合
３０➗２０で１．５０

欧米では伝統的にダルマ型自転車の前輪径に換算します。
３０ｘ２０の場合
２７ｘ１．５＝４１インチギヤ
のように表現します。
欧米式の利点は小径車にも統一的に使えることです。
上の場合
２０ｘ１．５＝３０インチギヤとなります。
逆にロードレーサーの４１インチギヤと同じ速度を小径車で得るには
３０ｘ１５あるいは３９ｘ２０という前後の組み合わせが必要となります。

ケーデンスを固定した時の時速で表したほうが直感的と思います。

まずタイヤ周長を選択します。

import Graphics.UI.Gtk
main = do
c <- getContents
let texts = lines c
initGUI
w <- windowNew
w `set` [windowDefaultWidth := 1000, windowDefaultHeight := 800]
sw <- scrolledWindowNew Nothing Nothing
vb <- vBoxNew True 0
bs <- mapM (buttonNewWithLabel) texts
mapM_ (\b -> b `set` [buttonXalign := 0, buttonYalign := 0]) bs
mapM_ (\b -> (b `on` buttonActivated) (func b)) bs
mapM_ (containerAdd vb) bs
scrolledWindowAddWithViewport sw vb
containerAdd w sw
widgetShowAll w
(w `on`unrealize) mainQuit
mainGUI
func b = b `get` buttonLabel >>= putStrLn >> mainQuit
view raw selectItem.hs hosted with ❤ by GitHub
データはキャットアイのページからコピーしました。

$ cat tires
18-622 700x18C 2070 207
19-622 700x19C 2080 208
20-622 700x20C 2086 209
23-622 700x23C 2096 210
25-622 700x25C 2105 211
28-622 700x28C 2136 214
30-622 700x30C 2146 215
32-622 700x32C 2155 216
xx-xxx  Tubular 2130 213
35-622 700x35C 2168 217
38-622 700x38C 2180 218
40-622 700x40C 2200 220
42-622 700x42C 2224 222
44-622 700x44C 2235 224
45-622 700x45C 2242 224
47-622 700x47C 2268 227

＄　cat tires | runghc selectItem.hs > tmp
$ cat tmp
23-622 700x23C 2096 210
import Graphics.UI.Gtk
import MySpinBox
import Round
main = do
c <- getContents
let [_,_,a,_] = words c
let t = read a :: Double
let names = ["タイヤ周長(mm)",
"frontA(T)",
"frontB(T)",
"最大コグ(T)",
"cadens(/m)"]
let spmods = [(t,2000,2300,1,10),
(39,20,60,1,10),
(52,20,60,1,10),
(23,21,32,1,10),
(90,50,160,1,10)]
initGUI
window <- windowNew
hbox <- hBoxNew False 0
vbox <- vBoxNew False 0
boxPackStart vbox hbox PackNatural 0
adjs <- mkAdjustments spmods
update adjs
spins <- myAddSpinButtons hbox names adjs
mapM_ (`set` [spinButtonDigits := 0]) spins
mapM_ (flip onValueChanged (update adjs)) adjs
containerAdd window vbox
widgetShowAll window
window `on` unrealize $ mainQuit
mainGUI
update adjs = do
l:fa:fb:m:c:_ <- mapM (`get` adjustmentValue) adjs
putStr "タイヤ周長(mm) = "
print l
mapM_ (disp l fa fb c) [11..m]
disp l fa fb c x = do
disp' l fa x c
putStr " "
disp' l fb x c
putStrLn ""
disp' l f r c = do
putStr $ show $ round f
putStr "x"
putStr $ show $ round r
putStr "="
putStr $ show (kph l f r c)
putStr "km/h "
kph l f r c = round1 $ (l/1000^2) * (f / r) * (c * 60)
view raw gear.hs hosted with ❤ by GitHub

Round モジュール、MySpinBox　モジュールが必要です。
module Round where
roundN :: Int -> Double -> Double
roundN n d = fromIntegral (round (d * 10 ^ n)) / fromIntegral (10 ^ n)
round1,round2 :: Double -> Double
round1 = roundN 1
round2 = roundN 2
view raw Round.hs hosted with ❤ by GitHub
module MySpinBox where
import Graphics.UI.Gtk
import Control.Monad
mkAdjustment :: (Double, Double, Double, Double, Double) -> IO Adjustment
mkAdjustment (v,l,u,s,p) = adjustmentNew v l u s p 0
{-
:: Double value - the initial value.
-> Double lower - the minimum value.
-> Double upper - the maximum value.
-> Double stepIncrement - the step increment.
-> Double pageIncrement - the page increment.
-> Double pageSize - the page size.
-}
mkAdjustments :: [(Double, Double, Double, Double, Double)] ->
IO [Adjustment]
mkAdjustments = mapM mkAdjustment
myAddSpinButtons :: HBox -> [String] ->[Adjustment] -> IO [SpinButton]
myAddSpinButtons box names adjustments = do
zipWithM (\x y -> myAddSpinButton box x y) names adjustments
myAddSpinButton :: HBox -> String -> Adjustment -> IO SpinButton
myAddSpinButton box name adj = do
vbox <- vBoxNew False 0
boxPackStart box vbox PackRepel 0
label <- labelNew (Just name)
miscSetAlignment label 0.0 0.5
boxPackStart vbox label PackNatural 0
spinb <- spinButtonNew adj 10 1
boxPackStart vbox spinb PackGrow 0
return spinb
view raw MySpinBox.hs hosted with ❤ by GitHub
$ cat tmp | runghc gear.hs
時刻: 0 件のコメント:
ラベル:
登録: 投稿 (Atom)

Haskell　Process

Haskellの System.Processは便利ですが、問題もあります。 単一スレッドでの逐次処理を保証していない。（想像です。） 次のようなスクリプトを書いてみた。 --a.hs main = print [1..10] --t.hs import Sy...

  • セル・オートマトン
    ソースコードは下記アドレス https://github.com/index333/cellA １次元のセル・オートマトンにルール３０を適用して得た画像。 一部Ｒｅｐａを使ってみました。 以下のインストール　が必要。 $ cab...
  • スポーク長計算
    https://github.com/index333/spcal からソースがＤＬできます。 新バージョンは https://github.com/index333/spcal2 各寸法の測り方は https://www.sheldonbrown.com/...
  • 平方根、立方根
    2の平方根 $ runghc nroot.hs 2 2 | tee a 2の立方根 $ runghc nroot.hs 2 ３ | tee ｂ 猛列な勢いで計算しますので適当なファイルに保存もしています。（Ctrl-Cで停止） なお√２に...