From f3f90b7106a858e8ab929da1d31833d140f7e33a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Stefan=20B=C3=BChler?= <stbuehler@web.de>
Date: Sat, 19 Jun 2010 19:35:04 +0200
Subject: [PATCH] encoding/decoding done, cleanup

---
 Car.hs       | 134 ---------------------------------------------------
 Circuit.hs   |  89 +++++++++++++++++++++-------------
 circuits.txt |  56 ---------------------
 3 files changed, 56 insertions(+), 223 deletions(-)
 delete mode 100644 Car.hs
 delete mode 100644 circuits.txt

diff --git a/Car.hs b/Car.hs
deleted file mode 100644
index 06a669d..0000000
--- a/Car.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-
-import Data.Packed
-import Data.Maybe
-
-data Car = Car { airparts :: Int, chambers :: [Chamber] }
-data Chamber = MainChamber { upperPipe, lowerPipe :: Pipe } | AuxChamber { upperPipe, lowerPipe :: Pipe }
-data Pipe = Pipe { sections :: [Section] }
-data Section = Section { tank :: Int }
-
-data Fuel = Matrix Int
-
--- Cars
--- 2211 220 0 0 1 0 2210 0 1 0 0 2200 1 1 0 2210 0 1 0 1 1 2210 0 1 0 1 1 1 0 2211 0 1 0 1 0 1 1 2210 1 0 1 0 0 1 0 220 0 1 0
--- 22 111001101111010 22 010010111 22 011010 22 1001011
--- 2211 1 0 0 220 1 0 1 1 220 0 1 0 1 0 220 1 0 0 220 0 1 1 1 0 220 1 1 0 220 1 21110 220 1 20
--- 2210 220 0 0 0 220 1 0 1 1 220 1 0 1 0 0 220 0 1 1 220 1 1 1 1 0 220 0 1 0
-
--- 220 220 0 0 0 1 1 0 220 1 0 1 0 0 1 0
--- [ ([0,0],0,[1]), ([1,1],0,[0]) ]
-
--- 1 220 0 0 0 1 0 : 1 chamber, 1 tank
--- [([0,0],0,[0])]
-
--- 1 220 0 0 0 1 1 0: In the car, tank 1 is not properly connected to tank 0
--- [([0,0],0,[1])]
-
--- 1 220 0 0 0 1 1 1: In the car, tank 2 is not properly connected to tank 0
--- 1 220 0 0 0 1 1 2: In the car, tank 3 is not properly connected to tank 0
--- 1 220 0 0 0 1 22000: In the car, tank 4 is not properly connected to tank 0
-
--- correct fuels:
---  1 1 1 220: for 1 tanks, using 1 ingredients of air, checking reaction chamber 0
---  220 1 1 1 1 1 1 1: for 2 tanks, using 1 ingredients of air, checking reaction chamber 0, checking reaction chamber 1, surplus of ingredient 1 in lower pipe when air consists of ingredient 1 only
---    [[2],[1]]
--- 1111: for 1 tanks, using 1 ingredients of air, checking reaction chamber 0, first fuel component must increase
-
--- 1110: for 1 tanks, using 1 ingredients of air, check fuel for tank 0, c_{1,1} must be >= 1
--- 220111011: for 2 tanks, using 1 ingredients of air, check fuel for tank 1, c_{1,1} must be >= 1
--- 220111111: for 2 tanks, using 1 ingredients of air, check fuel for tank 1, c_{1,1} must be >= 1
--- 2201 1111: for 2 tanks, using 1 ingredients of air, dimension mismatch
--- 10: for 1 tanks, using 0 ingredients of air, dimension mismatch
--- 11: for 1 tanks, using 1 ingredients of air, dimension mismatch
--- 11011000000: for 1 tanks, using 1 ingredients of air, dimension mismatch
--- 111220000: for 1 tanks, using 1 ingredients of air, fuel coefficients missing for tank 1
--- 1111220000: for 1 tanks, using 1 ingredients of air, fuel coefficients missing for tank 1
--- 1220: for 1 tanks, using 2 ingredients of air, dimension mismatch
--- 12210: for 1 tanks, using 3 ingredients of air, dimension mismatch
--- 12211: for 1 tanks, using 4 ingredients of air, dimension mismatch
--- 12222000: for 1 tanks, using 6 ingredients of air, dimension mismatch
--- 12222001: for 1 tanks, using 7 ingredients of air, dimension mismatch
--- 1222201: for 1 tanks, using 9 ingredients of air, dimension mismatch
--- 122221: for 1 tanks, using 15 ingredients of air, dimension mismatch
--- 2200: for 2 tanks, using 0 ingredients of air, dimension mismatch
--- 2201: for 2 tanks, using 1 ingredients of air, dimension mismatch
--- 220220: for 2 tanks, using 2 ingredients of air, dimension mismatch
--- 2202222022: for 2 tanks, using 14 ingredients of air, dimension mismatch
--- 22100: for 3 tanks, using 0 ingredients of air, dimension mismatch
--- 22101: for 3 tanks, using 1 ingredients of air, dimension mismatch
--- 2210220: for 3 tanks, using 2 ingredients of air, dimension mismatch
--- 22102210: for 3 tanks, using 3 ingredients of air, dimension mismatch
--- 22110: for 4 tanks, using 0 ingredients of air, dimension mismatch
--- 22111: for 4 tanks, using 1 ingredients of air, dimension mismatch
--- 22120: for 5 tanks, using 0 ingredients of air, dimension mismatch
--- 22121: for 5 tanks, using 1 ingredients of air, dimension mismatch
--- 22220001: for 6 tanks, using 1 ingredients of air, dimension mismatch
--- 22220011: for 7 tanks, using 1 ingredients of air, dimension mismatch
--- 22220101: for 9 tanks, using 1 ingredients of air, dimension mismatch
--- 22220111: for 10 tanks, using 1 ingredients of air, dimension mismatch
--- 222210001: for 16 tanks, using 0 ingredients of air, dimension mismatch
--- 2222100011: for 16 tanks, using 1 ingredients of air, dimension mismatch
--- 222210010: for 18 tanks, using 0 ingredients of air, dimension mismatch
--- 2222100101: for 18 tanks, using 1 ingredients of air, dimension mismatch
--- 222210011: for 19 tanks, using 0 ingredients of air, dimension mismatch
--- 2222100111: for 19 tanks, using 1 ingredients of air, dimension mismatch
-
-
--- Numbers
---  0: 0
---  1: 10
---  2: 11
---  3: 12
---  4: 22000
---  5: 22001
---  6: 22002
---  7: 22010
---  8: 22011
---  9: 22012
--- 10: 22020
--- 11: 22021
--- 12: 22022
-
--- List Lengths:
---  0: 0
---  1: 1
---  2: 220
---  3: 2210
---  4: 2211
---  5: 2212
---  6: 2222000
---  7: 2222001
---  8: 2222002
---  9: 2222010
--- 10: 2222011
--- 11: 2222012
--- 12: 2222020
--- 13: 2222021
--- 14: 2222022
--- 15: 222210000
--- 16: 222210001
--- 17: 222210002
--- 18: 222210010
--- 19: 222210011
--- 20: 222210012
--- 21: 222210020
--- 22: 222210021
--- 23: 222210022
--- 24: 222210100
--- 25: 222210101
--- 26: 222210102
--- 27: 222210110
--- 28: 222210111
--- 29: 222210112
--- 30: 222210120
--- 31: 222210121
--- 32: 222210122
--- 33: 222210200
--- 34: 222210201
--- 35: 222210202
--- 36: 222210210
--- 37: 222210211
--- 38: 222210212
--- 39: 222210220
--- 40: 222210221
--- 41: 222210222
diff --git a/Circuit.hs b/Circuit.hs
index a863181..e751cbc 100644
--- a/Circuit.hs
+++ b/Circuit.hs
@@ -2,6 +2,10 @@
 import Data.Maybe
 import Text.ParserCombinators.ReadP
 import Data.List
+import Data.Packed
+
+type Fuel = [Tank]
+type Tank = Matrix Double
 
 type Nat = Int
 
@@ -14,38 +18,24 @@ type Nat = Int
 type Dec a = ([Nat] -> (a, [Nat]))
 type Enc a = a -> String
 
-decodeNumber :: Dec Integer
-decodeNumber (0:xs) = (0,xs)
-decodeNumber (1:0:xs) = (1,xs)
-decodeNumber (1:1:xs) = (2,xs)
-decodeNumber (1:2:xs) = (3,xs)
-decodeNumber (2:2:0:0:0:xs) = (4,xs)
-decodeNumber (2:2:0:0:1:xs) = (5,xs)
-decodeNumber (2:2:0:0:2:xs) = (6,xs)
-decodeNumber (2:2:0:1:0:xs) = (7,xs)
-decodeNumber (2:2:0:1:1:xs) = (8,xs)
-decodeNumber (2:2:0:1:2:xs) = (9,xs)
-decodeNumber (2:2:0:2:0:xs) = (10,xs)
-decodeNumber (2:2:0:2:1:xs) = (11,xs)
-decodeNumber (2:2:0:2:2:xs) = (12,xs)
+type Chamber = ([Nat], Nat, [Nat])
+type Car = [Chamber]
 
+decodeTern :: Num n => Int -> Dec n
+decodeTern k xs = dec k 0 xs where
+	dec 0 s xs = (s, xs)
+	dec k s (i:xs) = dec (k-1) (3*s + (fromIntegral i)) xs
+
+encodeTern 0 0 = ""
+encodeTern k x = (encodeTern (k-1) (x `div` 3)) ++ show (x `mod` 3)
+
+decodeNumber :: Dec Int
+decodeNumber xs = let (len, x0) = decodeListLen xs in let (r, x1) = decodeTern len x0 in (((3^len - 1) `div` 2) + r, x1)
 
 decodeListLen :: Dec Int
 decodeListLen (0:xs) = (0,xs)
 decodeListLen (1:xs) = (1,xs)
-decodeListLen (2:2:0:xs) = (2,xs)
-decodeListLen (2:2:1:0:xs) = (3,xs)
-decodeListLen (2:2:1:1:xs) = (4,xs)
-decodeListLen (2:2:1:2:xs) = (5,xs)
-decodeListLen (2:2:2:2:0:0:0:xs) = (6,xs)
-decodeListLen (2:2:2:2:0:0:1:xs) = (7,xs)
-decodeListLen (2:2:2:2:0:0:2:xs) = (8,xs)
-decodeListLen (2:2:2:2:0:1:0:xs) = (9,xs)
-decodeListLen (2:2:2:2:0:1:1:xs) = (10,xs)
-decodeListLen (2:2:2:2:0:1:2:xs) = (11,xs)
-decodeListLen (2:2:2:2:0:2:0:xs) = (12,xs)
-decodeListLen (2:2:2:2:0:2:1:xs) = (13,xs)
-decodeListLen (2:2:2:2:0:2:2:xs) = (14,xs)
+decodeListLen (2:2:xs) = let (r,x0) = decodeNumber xs in (fromIntegral $ 2+r,x0)
 
 decodeTuple2 :: (Dec a, Dec b) -> Dec (a, b)
 decodeTuple2 (f, g) x = let (a, x1) = f x in let (b, x2) = g x1 in ((a,b), x2)
@@ -59,17 +49,50 @@ decodeList f x = let (len,x1) = decodeListLen x in get [] len x1 where
 
 decodeNumberList = decodeList decodeNumber
 
-decodeCar = fst . decodeList (decodeTuple3 (decodeNumberList, decodeNumber, decodeNumberList))
+
+decodeCar = fst . decodeList (decodeTuple3 (decodeNumberList, decodeNumber, decodeNumberList)) . readstream
+
+cartanks :: Car -> Nat
+cartanks = (1+) . maximum . concat . map (\(upper, _, lower) -> upper ++ lower)
 
 encodeNumber :: Enc Integer
-encodeNumber n = [ "0", "10", "11", "12", "22000", "22001", "22002", "22010", "22011", "22020", "22021", "22022" ] !! (fromIntegral n)
+encodeNumber n
+	| n < 0 = error "Can't encode negative numbers"
+	| n == 0 = "0"
+	| n > 0 = let len = log3 n in encodeListLen len ++ encodeTern len (n - base len) where
+		base len = (3^len - 1) `div` 2
+		log3 n = (head $ filter (\len -> n < base len) [0..]) - 1
+
 encodeListLen :: Enc Int
-encodeListLen n = [ "0", "1", "220", "2210", "2211", "2212", "2222000", "2222001", "2222002", "2222010", "2222011", "2222012", "2222020", "2222021", "2222022" ] !! n
+encodeListLen n
+	| n < 0 = error "Can't encode negative numbers"
+	| n == 0 = "0"
+	| n == 1 = "1"
+	| n >= 2 = "22" ++ encodeNumber (fromIntegral $ n-2)
 
 encodeList :: Enc a -> Enc [a]
 encodeList e xs = (encodeListLen (length xs)) ++ (concat $ map e xs)
 
-encodeFuel = encodeList $ encodeList $ encodeList encodeNumber
+encodeFuel :: [[[Integer]]] -> String
+encodeFuel = (encodeList $ encodeList $ encodeList encodeNumber)
+
+createTank :: [[Nat]] -> Tank
+createTank = fromLists . map (map fromIntegral)
+createFuel = map createTank
+
+evalChamber :: Fuel -> Chamber -> Matrix Double
+evalChamber tanks (upper, _, lower) = product (map (tanks !! ) upper) - product (map (tanks !! ) lower)
+
+checkChamber :: Fuel -> Chamber -> Bool
+checkChamber tanks c@(upper, mode, lower) = (all (>= 0) $ concat $ toLists diff) && (mode /= 0 || (diff @@> (0,0)) > 0) where
+	diff = evalChamber tanks c
+
+evalFuel :: Fuel -> Car -> [Matrix Double]
+evalFuel = map . evalChamber
+
+checkFuel :: Fuel -> Car -> Bool
+checkFuel fuel car = checkfuel && all (checkChamber fuel) car where
+	checkfuel = if (all (>= 0) $ concat $ concat $ map toLists fuel) && all (\t -> (t @@> (0,0)) > 0) fuel then True else error "Fuel broken"
 
 -- Circuit Syntax:
 -- <inPin>:[<gates>]:<outPin>
@@ -117,14 +140,14 @@ block2 = 2:(init input)
 -- 1: 2L:2R1R0#2R1R,2L0R0#X0R,X0L0#1L0L:1L
 -- 2: 2R:2R1R0#2L1L,0R2L0#X0R,0LX0#1R0L:1L
 -- build circuit for needed output
-build s = let (p, pins) = step 4 [0,-1,1,6,2,3,5,7] (dropWhile (0 == ) $ reverse (key ++ (readstream s))) in Circuit p pins where
+build1 s = let (p, pins) = step 4 [0,-1,1,6,2,3,5,7] (dropWhile (0 == ) $ reverse (key ++ (readstream s))) in Circuit p pins where
 	step p gates [] = (p, gates)
 	step p gates (x:xs) = let k = length gates in case x of
 		0 -> step k (gates ++ [k+4,k+2,k+5,p,k+1,k+3]) xs
 		1 -> step (k+2) (gates ++ [k+5,k+3,k+4,k+1,p,k]) xs
 		2 -> step (k+2) (gates ++ [k+5,k+3,k+1,k+4,k,p]) xs
 
-build1 s = let (p, pins) = step (-1) [] (reverse (key ++ (readstream s))) in Circuit p pins where
+build s = let (p, pins) = step (-1) [] (reverse (key ++ (readstream s))) in Circuit p pins where
 	step p gates [] = (p, gates)
 	step p gates (x:xs) = let k = length gates in case x of
 		0 -> step k (gates ++ [k+4,k+2,k+5,p,k+1,k+3]) xs
diff --git a/circuits.txt b/circuits.txt
deleted file mode 100644
index cf2a456..0000000
--- a/circuits.txt
+++ /dev/null
@@ -1,56 +0,0 @@
-
-0L:X0R0#X0R:0L
-  02120112100002120
-
-0L:X0L0#0RX:0R
-  22120221022022120
-
-0R:0LX0#0LX:0R
-  22022022022022022
-
-0R:0RX0#X0L:0L
-  01210221200001210
-
-2R:0L1L0#0L1L,0R2L0#0R2L,1RX0#1RX:2R
-  22220121012022221
-
-0L:X1L0#X1L,0R1R0#0R1R:0L
-  02012210002211022
-
-0R:0LX0#0LX:0R
-  22022022022022022
-
-X::X
-  01202101210201202
-
-
-0L:X0R0#0RX:0L
-checking node ( 0 , X0R0#0RX )
-inconsistent input connection
-    ( 0R , X , 0R )
-
-1R:X0R0#0RX:1R
-checking node ( 0 , X0R0#0RX )
-inconsistent input connection
-    ( X , 1R , 0L )
-
-0L:X0R0#X1R:1L
-checking node ( 0 , X0R0#X1R )
-inconsistent input connection
-    ( 0R , 1R , 0R )
-
-1L:X0R0#X1R:1L
-checking node ( 0 , X0R0#X1R )
-inconsistent input connection
-    ( X , 1L , 0L )
-
-0L:X0R0#X1R:1L
-checking node ( 0 , X0R0#X1R )
-inconsistent input connection
-    ( 0R , 1R , 0R )
-
-2L:X2R0#X2R:2L
-checking node ( 0 , X2R0#X2R )
-inconsistent input connection
-    ( X , 2L , 0L )
-