From fffef3e49db9f65cae3f0f99703ba01ae0d008bf Mon Sep 17 00:00:00 2001 From: Joe Zhao Date: Thu, 28 Jan 2016 09:56:24 -0700 Subject: init --- .gitignore | 6 +++++ AATree/AATree.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ AATree/testTree.hs | 10 +++++++++ Gro/Test.hs | 5 +++++ SudokuOriginal.hs | 35 +++++++++++++++++++++++++++++ change.hs | 11 +++++++++ fib.hs | 2 ++ sudoku | 1 + try.hs | 3 +++ wri.hs | 8 +++++++ 10 files changed, 147 insertions(+) create mode 100644 .gitignore create mode 100644 AATree/AATree.hs create mode 100644 AATree/testTree.hs create mode 100644 Gro/Test.hs create mode 100644 SudokuOriginal.hs create mode 100644 change.hs create mode 100644 fib.hs create mode 160000 sudoku create mode 100644 try.hs create mode 100644 wri.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..51cfbe4 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +# vim swapfile +*.swp + +# haskell compile +*.hi +*.o diff --git a/AATree/AATree.hs b/AATree/AATree.hs new file mode 100644 index 0000000..72698f7 --- /dev/null +++ b/AATree/AATree.hs @@ -0,0 +1,66 @@ +module AATree where + +data AATree a = Node { + level :: Int, + val :: a, + left :: AATree a, + right :: AATree a + } | Nil deriving (Show, Eq) + +instance Foldable AATree where + foldMap f Nil = mempty + foldMap f (Node n v l r) = foldMap f l `mappend` f v `mappend` foldMap f r + +skew (Node n v (Node ln lv ll lr) r) + | ln == n = Node ln lv ll (Node n v lr r) +skew t = t + +split (Node n v l (Node rn rv rl rr@(Node rrn _ _ _))) + | rrn == n = Node (n+1) rv (Node n v l rl) rr +split t = t + +insert Nil nv = Node 1 nv Nil Nil +insert t@(Node n v l r) nv + | nv == v = t + | nv < v = split.skew $ Node n v (insert l nv) r + | otherwise = split.skew $ Node n v l (insert r nv) + +lvl Nil = 0 +lvl (Node n _ _ _) = n + +tpred (Node _ v _ Nil) = v +tpred (Node _ v _ r) = tpred r + +tsucc (Node _ v Nil _) = v +tsucc (Node _ v l _) = tsucc l + +declvl (Node n v l Nil) + | s < n = Node s v l Nil + where s = 1 + lvl l +declvl (Node n v l (Node rn rv rl rr)) + | s < n && s < rn = Node s v l (Node (min rn s) rv rl rr) + where s = 1 + min (lvl l) rn +declvl t = t + +remove (Node n v l r) ov + | ov > v = Node n v l (delete r ov) + | ov < v = Node n v (delete l ov) r +remove (Node n v Nil Nil) ov | ov == v = Nil +remove (Node n v Nil r) ov | ov == v = Node n s Nil (delete r s) + where s = tsucc r +remove (Node n v l r) ov | ov == v = Node n p (delete l p) r + where p = tpred l +remove t ov = t + +delete Nil ov = Nil +delete t ov + | a == Nil = Nil + | right a == Nil = let Node n v l r = split a in Node n v l (split r) + | otherwise = + let Node n v l r = a + Node rn rv rl rr = skew r + Node b c d e = split $ Node n v l (Node rn rv rl (skew rr)) + in Node b c d (split e) + where a = skew (declvl (remove t ov)) + +aasort xs = foldr (:) [] $ foldl insert Nil xs diff --git a/AATree/testTree.hs b/AATree/testTree.hs new file mode 100644 index 0000000..a9fea3f --- /dev/null +++ b/AATree/testTree.hs @@ -0,0 +1,10 @@ +import AATree + +setup = foldl insert Nil [1..20] + +main = do + let t = setup + putStrLn (show $ foldr (:) [] t) + +sort [] = [] +sort (x:xs) = sort [ i | i<-xs, i=x]) diff --git a/Gro/Test.hs b/Gro/Test.hs new file mode 100644 index 0000000..a46c849 --- /dev/null +++ b/Gro/Test.hs @@ -0,0 +1,5 @@ +module Gro.Test ( + have +) where + +have a b = filter (==a) b diff --git a/SudokuOriginal.hs b/SudokuOriginal.hs new file mode 100644 index 0000000..2f03d5a --- /dev/null +++ b/SudokuOriginal.hs @@ -0,0 +1,35 @@ +module SudokuOriginal where + +import Data.List +import Control.Applicative +import SudokuHelper + +numlist = [1..9] + +pertake eve l cur [] = [] +pertake eve l cur (x:xs) + | eve == cur = x:(pertake eve l 1 xs) + | otherwise = if cur < l then x:rest else rest + where rest = (pertake eve l (cur+1) xs) + +block pos all = take 9 $ pertake 9 3 0 $ drop (x*9+y) all + where x = i - mod i 3 + y = j - mod j 3 + i = div pos 9 + j = mod pos 9 + +line pos all = take 9 $ drop (pos - (mod pos 9)) all + +col pos all = pertake 9 1 0 $ drop (mod pos 9) all + +get pos all = (map head).group.sort.concat $ + ([block, line, col] <*> [pos]) <*> [all] + +solve :: Int -> [Int] -> [[Int]] +solve 81 all = [all] +solve pos all = if head (drop pos all) == 0 then concatMap (solve (pos+1)) + [ take pos all ++ (i:(drop (pos+1) all)) | i<-avail ] + else solve (pos+1) all + where avail = [i |i<-numlist, not $ elem i $ get pos all] + +solveStr = head . (solve 0) diff --git a/change.hs b/change.hs new file mode 100644 index 0000000..ffbbdde --- /dev/null +++ b/change.hs @@ -0,0 +1,11 @@ +change [] n = if n == 0 then 1 else 0 +change (x:xs) n = foldl (+) 0 $ map ((change xs).(n-)) avail + where avail = takeWhile (<=n) $ map (x*) [0..] + +change' xs n = (foldl (flip $ (+).fst) 0).head.(drop n) $ [(1,0)]:changeIter [[(1,0)]] + where changeIter hist = h:(changeIter (h:hist)) + where h = [ (foldl (+) 0 $ [m |(m,low)<-getH x,low<=x],x) |x<-xs] + getH x = let left=drop (x-1) hist in + if left/=[] then head left else [] + +main = putStrLn (show $ change' [25,10,5,1] 100000000) diff --git a/fib.hs b/fib.hs new file mode 100644 index 0000000..d8ca794 --- /dev/null +++ b/fib.hs @@ -0,0 +1,2 @@ +fib :: [Int] +fib = 1:1:(zipWith (+) fib (tail fib)) diff --git a/sudoku b/sudoku new file mode 160000 index 0000000..daf608a --- /dev/null +++ b/sudoku @@ -0,0 +1 @@ +Subproject commit daf608afa60e73de020e346792b1aac94a2a6aa4 diff --git a/try.hs b/try.hs new file mode 100644 index 0000000..3ba6613 --- /dev/null +++ b/try.hs @@ -0,0 +1,3 @@ +import Gro.Test + +cli a = have 1 a diff --git a/wri.hs b/wri.hs new file mode 100644 index 0000000..93a0527 --- /dev/null +++ b/wri.hs @@ -0,0 +1,8 @@ +import Control.Monad.Writer + +example :: Writer [Int] String +example = do + tell [1..5] + tell [6..10] + return "foo" + -- cgit v1.2.3-70-g09d2