init

10 files changed, 146 insertions, 0 deletions

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]  ++  x:(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
+Subproject daf608afa60e73de020e346792b1aac94a2a6aa
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"
+