Day 22

Haskell version is waaaaay too slow and uses huge amounts of memory.
Didn't even let it run to completion on part 2.
The C version is really quick. /shrug/

3 files changed, 212 insertions, 0 deletions

diff --git a/2017/22.c b/2017/22.c
new file mode 100644
index 0000000..ff73c8c
--- /dev/null
+++ b/2017/22.c
@@ -0,0 +1,82 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+static void printchart(int size,char *chart,int curx,int cury){
+	for(int i=0;i<size;i++){
+		for(int j=0;j<size;j++){
+			if(cury==i&&curx==j)putchar('[');
+			else if(cury==i&&curx==j-1)putchar(']');
+			else putchar(' ');
+			putchar(".W#F"[(int)chart[size*i+j]]);
+		}
+		if(cury==i&&curx==size-1)putchar(']');
+		putchar('\n');
+	}
+}
+
+static int embiggen(int *sizep,char **chartp){
+	int size=*sizep;
+	char *chart=*chartp;
+
+	int newsize=2*size-1,d=(size-1)/2;
+	char *newchart=calloc(newsize*newsize,1);
+	for(int i=0;i<size;i++){
+		memcpy(newchart+newsize*(i+d)+d,chart+size*i,size);
+	}
+	free(chart);
+	*sizep=newsize;
+	*chartp=newchart;
+	return d;
+}
+
+static int virus1[4][2]={{2,3}, {0,0}, {0,1}, {0,0}};
+static int virus2[4][2]={{1,3}, {2,0}, {3,1}, {0,2}};
+
+static int simulate(int size,const char *origchart,int virus[4][2],int nsteps){
+	char *chart=malloc(size*size);
+	memcpy(chart,origchart,size*size);
+	int curx=size/2,cury=size/2,dir=0;
+	int ninf=0;
+	for(int iter=0;iter<nsteps;iter++){
+		if(curx<0||cury<0||curx>=size||cury>=size){
+			int d=embiggen(&size,&chart);
+			curx+=d; cury+=d;
+		}
+
+		int v=chart[size*cury+curx];
+		dir=(dir+virus[v][1])%4;
+		v=virus[v][0];
+		chart[size*cury+curx]=v;
+		if(v==2)ninf++;
+
+		switch(dir){
+			case 0: cury--; break;
+			case 1: curx++; break;
+			case 2: cury++; break;
+			case 3: curx--; break;
+		}
+	}
+	return ninf;
+}
+
+int main(void){
+	freopen("22.in","r",stdin);
+	char *line=NULL;
+	size_t linecap=0;
+	int size=getline(&line,&linecap,stdin)-1;
+
+	char *chart=malloc(size*size);
+	for(int i=0;i<size;i++)chart[i]=line[i]=='#'?2:0;
+	for(int i=1;i<size;i++){
+		getline(&line,&linecap,stdin);
+		for(int j=0;j<size;j++)chart[size*i+j]=line[j]=='#'?2:0;
+	}
+
+	int curx=size/2,cury=size/2;
+	printchart(size,chart,curx,cury);
+
+	printf("%d\n",simulate(size,chart,virus1,10000));
+	printf("%d\n",simulate(size,chart,virus2,10000000));
+}
diff --git a/2017/22.in b/2017/22.in
new file mode 100644
index 0000000..487dc43
--- /dev/null
+++ b/2017/22.in
@@ -0,0 +1,25 @@
+#.#.#.##.#.##.###.#.###.#
+.#..#.....#..#######.##.#
+......###..##..###..#...#
+##....#.#.#....#..#..#..#
+#..#....#.##.#.#..#..#.#.
+..##..##.##..##...#...###
+..#.#....#..####.##.##...
+###...#.#...#.######...#.
+..#####...###..#####.#.##
+...#..#......####.##..#.#
+#...##..#.#####...#.##...
+..#.#.###.##.##....##.###
+##.##...###....#######.#.
+#.#...#.#..#.##..##..##.#
+.#...###...#..#..####....
+####...#...##.####..#.#..
+......#.....##.#.##....##
+###.......####..##.#.##..
+....###.....##.##..###.#.
+.##..##.#.###.###..#.###.
+..#..##.######.##........
+#..#.#..#.###....##.##..#
+.##.#.#...######...##.##.
+##..#..#..##.#.#..#..####
+#######.#.######.#.....##
diff --git a/2017/22x.hs b/2017/22x.hs
new file mode 100644
index 0000000..c2dd9db
--- /dev/null
+++ b/2017/22x.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE MultiWayIf, BangPatterns #-}
+import Prelude hiding (Right, Left)
+import Control.Monad
+import Data.Array.IO
+
+
+type Idx = (Int, Int)
+data Dir = Up | Right | Down | Left
+  deriving (Show, Eq, Enum)
+
+type Chart = IOUArray Idx Int
+data State = State !Chart !Idx !Dir
+
+concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
+concatMapM f l = liftM concat (mapM f l)
+
+printstate :: State -> IO ()
+printstate (State chart idx dir) = do
+    ((top, left), (bottom, right)) <- getBounds chart
+    rows <- mapM (row (left, right)) [top..bottom]
+    mapM_ putStrLn rows
+  where
+    pcell :: Idx -> Int -> String
+    pcell idx' c =
+        if | idx' == idx -> ['[', c']
+           | idx' == add idx Right -> [']', c']
+           | otherwise -> [' ', c']
+      where c' = ".W#F" !! c
+
+    row :: (Int, Int) -> Int -> IO String
+    row (left, right) y = concatMapM (\i -> liftM (pcell i) (readArray chart i)) (range ((y, left), (y, right)))
+
+add :: Idx -> Dir -> Idx
+add (y, x) dir = case dir of
+    Up -> (y - 1, x)
+    Right -> (y, x + 1)
+    Down -> (y + 1, x)
+    Left -> (y, x - 1)
+
+rotright :: Dir -> Dir
+rotright Up = Right
+rotright Right = Down
+rotright Down = Left
+rotright Left = Up
+
+rotleft :: Dir -> Dir
+rotleft Up = Left
+rotleft Left = Down
+rotleft Down = Right
+rotleft Right = Up
+
+rot180 :: Dir -> Dir
+rot180 = rotright . rotright
+
+type Virus = Int -> Dir -> (Int, Dir)
+
+simulate :: Virus -> Int -> State -> IO (State, Int)
+simulate virus numsteps initstate = do
+    let foldfunc (st, n) _ = go st >>= \(st', b) -> return (st', n + fromEnum b)
+    foldM foldfunc (initstate, 0) [1..numsteps]
+  where
+    go :: State -> IO (State, Bool)
+    go !(State chart idx dir) = do
+        bnds <- getBounds chart
+        if inRange bnds idx
+            then do
+                c <- readArray chart idx
+                let (c', dir') = virus c dir
+                writeArray chart idx c'
+                return (State chart (add idx dir') dir', c' == 2)
+            else do
+                let ((top, left), (bottom, right)) = bnds
+                    bnds' = ((2 * top, 2 * left), (2 * bottom, 2 * right))
+                chart' <- newArray bnds' 0
+                getAssocs chart >>= mapM (uncurry (writeArray chart'))
+                go (State chart' idx dir)
+
+virus1 :: Virus
+virus1 0 dir = (2, rotleft dir)
+virus1 2 dir = (0, rotright dir)
+
+virus2 :: Virus
+virus2 0 dir = (1, rotleft dir)
+virus2 1 dir = (2, dir)
+virus2 2 dir = (3, rotright dir)
+virus2 3 dir = (0, rot180 dir)
+
+main :: IO ()
+main = do
+    input <- (readFile "22.in")
+    let w = length (head (lines input))
+        h = length (lines input)
+        (halfw, halfh) = (w `quot` 2, h `quot` 2)
+
+    chart <- newListArray ((-halfh, -halfw), (halfh, halfw))
+                (map (\c -> fromEnum $ if c == '#' then 2 else 0) $ filter (/= '\n') input)
+
+    (state1, numinfs1) <- simulate virus1 10000 (State chart (0, 0) Up)
+    -- printstate state1
+    print numinfs1
+
+    (state2, numinfs2) <- simulate virus1 1000000 (State chart (0, 0) Up)
+    -- printstate state2
+    getBounds ((\(State ch _ _) -> ch) state2) >>= print
+    print numinfs2