icfp13/Circuit.hs
2010-06-23 12:50:41 +02:00

90 lines
3.3 KiB
Haskell

module Circuit (
Fuel, Tank, cartanks, createTank, createFuel, evalChamber, checkChamber, evalFuel, checkFuel, build1, build, key_circuit, test_key_circ, key_input, key, big_input,
Circuit(..), Chamber(..), Car(..), server_input, circ_from_perm,
execCircuit, execCircuit2, checkCircuit, checkCircuits,
permutations
) where
import Encoding
import CircuitBase
import CircuitParser
import CircuitSimulator
-- import CircuitC
import Data.List
import Data.Maybe
import Data.Packed
type Fuel = [Tank]
type Tank = Matrix Double
-- IMPORANT functions:
-- * build
-- create a circuit for a desired fuel output
-- example:
-- build ""
cartanks :: Car -> Int
cartanks = (1+) . maximum . concat . map (\(Chamber upper _ lower) -> upper ++ lower) . chambers
createTank :: [[Integer]] -> Tank
createTank = fromLists . map (map fromIntegral)
createFuel = map createTank
evalChamber :: Fuel -> Chamber -> Matrix Double
evalChamber tanks (Chamber upper _ lower) = product (map (tanks !! ) upper) - product (map (tanks !! ) lower)
checkChamber :: Fuel -> Chamber -> Bool
checkChamber tanks c@(Chamber upper main lower) = (all (>= 0) $ concat $ toLists diff) && (not main || (diff @@> (0,0)) > 0) where
diff = evalChamber tanks c
evalFuel :: Fuel -> Car -> [Matrix Double]
evalFuel f = map (evalChamber f) . chambers
checkFuel :: Fuel -> Car -> Bool
checkFuel fuel car = checkfuel && all (checkChamber fuel) (chambers car) where
checkfuel = if (all (>= 0) $ concat $ concat $ map toLists fuel) && all (\t -> (t @@> (0,0)) > 0) fuel then True else error "Fuel broken"
-- zero everything:
-- Circuit {outPin = 8, inPins = [2,9,4,5,-1,3,1,0,6,7]}
-- basic blocks
-- 0: 1R:2L1L0#X2L,2RX0#0R2R,0R1R0#0L1L:0L
-- 1: 2L:2R1R0#2R1R,2L0R0#X0R,X0L0#1L0L:1L
-- 2: 2R:2R1R0#2L1L,0R2L0#X0R,0LX0#1R0L:1L
-- build circuit for needed output
build1 s = let (p, pins) = step 4 [0,-1,1,6,2,3,5,7] (dropWhile (0 == ) $ reverse (key ++ (streamread 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
build s = let (p, pins) = step (-1) [] (reverse (key ++ (streamread 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
key_circuit = parseCircuit key_circuit_str
key_circuit_str = "19L:12R13R0#1R12R,14R0L0#4R9L,9R10R0#3L8L,2L17R0#5L9R,15R1L0#10R13R,3L18R0#6L15L,5L11R0#13L12L,19R16R0#11R8R,2R7R0#11L10L,1R3R0#18L2L,8R4L0#16L2R,8L7L0#15R6R,6R0R0#14L0L,6L4R0#14R0R,12L13L0#17L1L,5R11L0#16R4L,10L15L0#17R7R,14L16L0#18R3R,9L17L0#19R5R,X18L0#X7L:19L"
-- goal: Find a circuit with test_key_circ circ == True
test_key_circ :: Circuit -> Bool
test_key_circ circ = checkCircuit circ server_input key
key_input :: [Trit]
key_input = streamread "02222220210110011"
key :: [Trit]
key = execCircuit2 key_circuit key_input
-- key: "11021210112101221"
big_input = streamread "0120101201201020210210020210101010101110202022202020202001010210200102010201010201201020201201020120101202102021010120120210201201020120102102"