Merge pull request #11 from RyosukeDTomita/feature/data_structure

feature/data structure

Author: RyosukeDTomita

data_structure/README.md

@@ -3,7 +3,13 @@
 ## スタック(Stack)
 
 - Last In First Out でデータを取り出す構造
-- データが入るリストとスタックポインタとなる変数を用意してデータを入れた時にスタックポインタを増やして，データを取り出した時にスタックポインタを減らす。
+- 逆ポーランド記法(Reverse Polish Notation)の計算に利用される。
+
+### 実装例
+
+- [x] Python
+- [x] C
+- [x] Haskell: これだけ逆ポーランド記法の例。(Haskellのリストは単方向連結リストとして実装されているためスタックといって差し支えないため、応用例を変わりに実装)
 
 ---
 

data_structure/stack_/rpn.hs

@@ -0,0 +1,14 @@
+rpn :: [String] -> [Int]
+rpn input = foldl step [] input
+  where
+    step :: [Int] -> String -> [Int]
+    step stack operand =
+      case operand of
+        "+" -> let (a : b : rest) = stack in (b + a) : rest
+        "-" -> let (a : b : rest) = stack in (b - a) : rest
+        "*" -> let (a : b : rest) = stack in (b * a) : rest
+        n -> (read :: String -> Int) n : stack
+
+main :: IO ()
+main = do
+  print $ rpn $ words "4 8 + 1 3 + *" -- (4 + 8) * (1 + 3)

data_structure/tree/fingerTree.hs

@@ -0,0 +1,141 @@
+-- 以下のdata型の定義はhttps://www.staff.city.ac.uk/~ross/papers/FingerTree.htmlに記載のあるものを流用している。
+data FingerTree a
+  = Empty -- 要素なし
+  | Single a -- 要素1つ
+  | Deep (Digit a) (FingerTree (Node a)) (Digit a)
+  deriving (Show)
+
+-- Finger Tree左右端のバッファ
+data Digit a
+  = One a
+  | Two a a
+  | Three a a a
+  | Four a a a a
+  deriving (Show)
+
+-- Finger Treeの中間圧縮ノード
+data Node a
+  = Node2 a a
+  | Node3 a a a
+  deriving (Show)
+
+-- 以降はそれっぽく作っているだけ。
+
+-- 先頭(左端)追加
+(<|) :: a -> FingerTree a -> FingerTree a
+x <| Empty = Single x
+x <| Single a = Deep (One x) Empty (One a)
+-- pr: prefix(Digit)
+-- m: middle(Node)
+-- sf: suffix(Digit)
+x <| Deep pr m sf =
+  case pr of -- 左端のDigitのサイズで分岐
+    One a -> Deep (Two x a) m sf
+    Two a b -> Deep (Three x a b) m sf
+    Three a b c -> Deep (Four x a b c) m sf
+    Four a b c d -> Deep (Two x a) (Node3 b c d <| m) sf -- TODO
+
+-- 末尾(右端)追加
+(|>) :: FingerTree a -> a -> FingerTree a
+Empty |> x = Single x
+Single a |> x = Deep (One a) Empty (One x)
+-- pr: prefix(Digit)
+-- m: middle(Node)
+-- sf: suffix(Digit)
+Deep pr m sf |> x =
+  case sf of
+    One a -> Deep pr m (Two a x)
+    Two a b -> Deep pr m (Three a b x)
+    Three a b c -> Deep pr m (Four a b c x)
+    Four a b c d -> Deep pr (m |> Node3 a b c) (Two d x)
+
+data ViewR a
+  = EmptyR
+  | FingerTree a :> a
+  deriving (Show)
+
+-- 末尾(右端)とりだし
+viewR :: FingerTree a -> ViewR a
+viewR Empty = EmptyR
+viewR (Single x) = Empty :> x
+viewR (Deep pr m sf) =
+  case sf of
+    One a ->
+      case viewR m of
+        EmptyR -> digitToTreeR pr
+        m' :> Node2 b c -> Deep pr m' (Two b c) :> a
+        m' :> Node3 b c d -> Deep pr m' (Three b c d) :> a
+    Two a b -> Deep pr m (One a) :> b
+    Three a b c -> Deep pr m (Two a b) :> c
+    Four a b c d -> Deep pr m (Three a b c) :> d
+
+digitToTreeR :: Digit a -> ViewR a
+digitToTreeR (One a) = Empty :> a
+digitToTreeR (Two a b) = Single a :> b
+digitToTreeR (Three a b c) = Deep (One a) Empty (One b) :> c
+digitToTreeR (Four a b c d) = Deep (Two a b) Empty (One c) :> d
+
+data ViewL a
+  = EmptyL
+  | a :< FingerTree a
+  deriving (Show)
+
+-- 先頭(左端)取り出し
+viewL :: FingerTree a -> ViewL a
+viewL Empty = EmptyL
+viewL (Single x) = x :< Empty
+viewL (Deep pr m sf) =
+  case pr of
+    One a ->
+      case viewL m of
+        EmptyL -> case digitToTree sf of
+          b :< t -> a :< (b <| t)
+        Node2 b c :< m' -> a :< Deep (Two b c) m' sf
+        Node3 b c d :< m' -> a :< Deep (Three b c d) m' sf
+    Two a b ->
+      a :< Deep (One b) m sf
+    Three a b c ->
+      a :< Deep (Two b c) m sf
+    Four a b c d ->
+      a :< Deep (Three b c d) m sf
+
+-- digitをFingerTreeに変換する (ViewL用)
+digitToTree :: Digit a -> ViewL a
+digitToTree (One a) = a :< Empty
+digitToTree (Two a b) = a :< Single b
+digitToTree (Three a b c) = a :< Deep (One b) Empty (One c)
+digitToTree (Four a b c d) = a :< Deep (Two b c) Empty (One d)
+
+main :: IO ()
+main = do
+  -- 末尾追加
+  let addFingerTree = scanl (|>) Empty [1 .. 21]
+  putStrLn $ unlines $ map show addFingerTree
+  putStrLn "--------------------------------------"
+  -- 先頭追加
+  let addFingerTree' = scanl (flip (<|)) Empty $ reverse [1 .. 21]
+  putStrLn $ unlines $ map show addFingerTree'
+  putStrLn "--------------------------------------"
+
+  -- 末端から取り出される過程をみる
+  let testFingerTree = foldl (|>) Empty [1 .. 21]
+  let removeSteps = scanl (\ft _ -> restL ft) testFingerTree [1 .. 21]
+  putStrLn $ unlines $ map show removeSteps
+  putStrLn "--------------------------------------"
+
+  -- 先頭から取り出される過程をみる
+  let testFingerTree = foldl (|>) Empty [1 .. 21]
+  let removeSteps = scanl (\ft _ -> restL ft) testFingerTree [1 .. 21]
+  putStrLn $ unlines $ map show removeSteps
+
+-- viewRの結果から残りの木を取り出す
+restR :: FingerTree a -> FingerTree a
+restR ft = case viewR ft of
+  EmptyR -> Empty
+  rest :> _ -> rest
+
+-- viewLの結果から残りの木を取り出す
+restL :: FingerTree a -> FingerTree a
+restL ft = case viewL ft of
+  EmptyL -> Empty
+  _ :< rest -> rest

data_structure/tree/tree.hs

@@ -0,0 +1,56 @@
+-- https://www.sampou.org/haskell/article/whyfp.html より
+data Tree a = Node a [Tree a]
+
+-- 木のリストに対する畳み込み
+redtree ::
+  (a -> b -> b) -> -- f : node を潰す
+  (b -> b -> b) -> -- g : cons を潰す
+  b -> -- a : nil を潰す
+  Tree a ->
+  b
+redtree f g a (Node label subtrees) =
+  f label (redtree' f g a subtrees)
+
+-- ツリーのリストを処理する関数
+redtree' ::
+  (a -> b -> b) ->
+  (b -> b -> b) ->
+  b ->
+  [Tree a] ->
+  b
+redtree' f g a (subtree : rest) =
+  g
+    (redtree f g a subtree) -- リストのサイズが1に分解して潰す --> f label (redtree' f g a [先頭の木]) ...という流れでredtree' _ _ a [] = aにたどりつく
+    (redtree' f g a rest) -- 残りで再帰
+redtree' _ _ a [] =
+  a
+
+tree :: Tree Int
+tree =
+  Node
+    1
+    ( (:)
+        (Node 2 [])
+        ( (:)
+            ( Node
+                3
+                ((:) (Node 4 []) [])
+            )
+            []
+        )
+    )
+
+sumtree :: (Num a) => Tree a -> a
+sumtree tree = redtree (+) (+) 0 tree
+
+labels :: (Num a) => Tree a -> [a]
+labels tree = redtree (:) (++) [] tree
+
+maptree :: (a -> b) -> Tree a -> Tree b
+maptree f tree = redtree (\label subtrees -> Node (f label) subtrees) (:) [] tree
+
+main :: IO ()
+main = do
+  print $ sumtree tree -- 10
+  print $ labels tree -- [1, 2, 3, 4]
+  print $ maptree (* 2) tree

math/README.md

@@ -1,5 +1,35 @@
 # 数学ぽいやつ
 
+## フィボナッチ数列
+
+[fibonacci](./fibonacci/)
+
+---
+
+## ニュートン法による平方根の近似
+
+[newton](./newton/)
+
+---
+
 ## ユークリッドの互助法
 
+[euclidean](./euclidean/)
+
+### 実装例
+
+- [] C
+- [] Python
+- [x] Haskell
+
+---
+
 ## エラトステネスのふるい
+
+[eratosthenes](./eratosthenes/)
+
+- [] C
+- [] Python
+- [x] Haskell
+
+---

math/eratosthenes.hs math/eratosthenes/eratosthenes.hsmath/eratosthenes.hs renamed to math/eratosthenes/eratosthenes.hs

@@ -0,0 +1,33 @@
+-- https://www.sampou.org/haskell/article/whyfp.html
+-- 近似を1つ進める関数
+next :: Double -> Double -> Double
+next n x = (x + n / x) / 2
+
+-- 許容誤差と近似値よりも差の小さい2つの連続する近似値を探す
+within :: Double -> [Double] -> Double
+within eps (a : b : rest)
+  | abs (a - b) <= eps = b -- 絶対誤差
+  | otherwise = within eps (b : rest)
+
+-- ２つの近似値の比が1に近づくようにして許容誤差よりも小さい２つの連続する近似値を探す
+relative :: Double -> [Double] -> Double
+relative eps (a : b : rest)
+  | abs (a - b) <= eps * abs b = b -- abs (a - b) / abs b <= epsを変形したもの。いわゆる相対誤差
+  | otherwise = relative eps (b : rest)
+
+-- withinを使って平方根をもとめる例
+sqrt' :: Double -> Double -> Double -> Double
+sqrt' a0 eps n = within eps $ iterate (next n) a0
+
+relativesqrt :: Double -> Double -> Double -> Double
+relativesqrt a0 eps n = relative eps $ iterate (next n) a0
+
+main :: IO ()
+main = do
+  let n = fromIntegral 2 -- 平方根を求めたい値
+  let a0 = fromInteger 1 -- 計算の初期値
+  let eps = 0.001
+  let epsRelative = 0.001
+  print $ take 10 $ iterate (next n) 1
+  print $ sqrt' a0 eps n
+  print $ relativesqrt a0 epsRelative n