1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
{-
Copyright (C) 2017 Yuchen Pei.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Affero General Public
License along with this program. If not, see
<https://www.gnu.org/licenses/>.
-}
module Puzzle10 (knotHash) where
import Data.List.Split (splitOn)
import Data.Bits (xor)
import Numeric (showHex)
import Data.Char (ord)
split3Ways :: [Int] -> Int -> Int -> ([Int], [Int], [Int])
split3Ways xs from to
| to >= from = (take from xs, take (to - from) (drop from xs), drop to xs)
| otherwise = split3Ways xs to from
permute :: [Int] -> Int -> Int -> [Int]
permute xs from to
| to >= from = xs1 ++ reverse xs2 ++ xs3
| otherwise = xs1' ++ xs2 ++ xs3'
where (xs1, xs2, xs3) = split3Ways xs from to
xs4 = reverse (xs3 ++ xs1)
(xs3', xs1') = splitAt (length xs3) xs4
step :: ([Int], Int, Int) -> Int -> ([Int], Int, Int)
step (xs, skip, from) n = let m = length xs in
(permute xs from ((from + n) `mod` m), skip + 1, (from + n + skip) `mod` m)
solve1' :: [Int] -> Int
solve1' xs = let (ys, _, _) = foldl step ([0 .. 255], 0, 0) xs in
--solve1' xs = let (ys, _, _) = foldl step ([0 .. 4], 0, 0) xs in
(head ys) * (head $ tail ys)
parseInput :: [Char] -> [Int]
parseInput = (fmap read) . (splitOn ",")
solve1 :: [Char] -> Int
solve1 = solve1' . parseInput
sparseHash :: [Int] -> [Int]
sparseHash xs = let (ys, _, _) = foldl step ([0 .. 255], 0, 0) $ take (64 * (length xs)) (cycle xs) in ys
stepHash :: (Int, [Int]) -> (Int, [Int])
stepHash (xs, ys) = (foldl1 xor (take 16 ys), drop 16 ys)
int2Hex :: Int -> [Char]
int2Hex xs
| length ys == 2 = ys
| otherwise = '0':ys
where ys = showHex xs ""
denseHash :: [Int] -> [Char]
denseHash xs = mconcat $ fmap (int2Hex . fst) $ take 16 $ drop 1 $ iterate stepHash (0, xs)
solve2 :: [Char]
solve2 = knotHash input
knotHash :: [Char] -> [Char]
knotHash xs = denseHash $ sparseHash $ (ord <$> xs) ++ [17, 31, 73, 47, 23]
input = "120,93,0,90,5,80,129,74,1,165,204,255,254,2,50,113"
|
