tools/hashTest.hs
author nemo
Tue, 30 Apr 2019 09:36:13 -0400
changeset 14880 8d65728c4ed0
parent 9464 901e363d5837
permissions -rw-r--r--
Backed out changeset 13589d529899 So, we only disabled this on the release branch in r29d614a5c9eb due to having discovered it JUST before release. We should fix it properly in default...
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9462
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     1
module Test where
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     2
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     3
import Control.Monad
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     4
import Data.Word
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     5
import qualified Data.IntSet as IS
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     6
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     7
data OP = Sum
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     8
        | Mul
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
     9
        | Sub
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    10
    deriving Show
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    11
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    12
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    13
genOps :: Int -> [[OP]]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    14
genOps 1 = [[Sum], [Mul], [Sub]]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    15
genOps n = [a : as | a <- [Sum, Mul, Sub], as <- genOps (n - 1)]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    16
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    17
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    18
genPos :: Int -> Int -> [[Int]]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    19
genPos m 1 = map (:[]) [-m..m - 1]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    20
genPos m n = [a : as | a <- [-m..m - 1], as <- genPos m (n - 1)]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    21
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    22
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    23
hash :: [Int] -> [OP] -> [Int] -> Int
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    24
hash poss op s = foldl applyOp s' (zip ss op)
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    25
    where
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    26
        applyOp v (n, Sum) = (v + n) `mod` 256
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    27
        applyOp v (n, Mul) = (v * n) `mod` 256
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    28
        applyOp v (n, Sub) = (v - n) `mod` 256
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    29
        (s' : ss) = map (\p -> if p >= 0 then s !! p else s !! (l + p)) poss
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    30
        l = length s
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    31
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    32
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    33
test = do
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    34
    a <- liftM lines getContents
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    35
    let w = minimum $ map length a
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    36
    let opsNum = 4
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    37
    let opsList = genOps (opsNum - 1)
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    38
    let posList = genPos w opsNum
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    39
    let target = length a
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    40
    let wordsList = map (map fromEnum) a
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    41
    let hashedSize = IS.size . IS.fromList
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    42
    print $ length a
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    43
    putStrLn . unlines . map show $ filter (\l -> fst l == length a) $ [(hs, (p, o)) | p <- posList, o <- opsList, let hs = hashedSize . map (hash p o) $ wordsList]
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    44
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    45
didIunderstand' = do
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    46
    a <- liftM lines getContents
9464
901e363d5837 Finish rework of default binds system. Default binds now work even before first turn.
unc0rr
parents: 9462
diff changeset
    47
    print $ length a
9462
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    48
    print . IS.size . IS.fromList . map (testHash . map fromEnum) $ a
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    49
    where
9464
901e363d5837 Finish rework of default binds system. Default binds now work even before first turn.
unc0rr
parents: 9462
diff changeset
    50
        testHash s = let l = length s in (
9462
4cbc9a8fd559 Hash finding and checking tool
unc0rr
parents:
diff changeset
    51
                         (s !! (l - 2) * s !! 1) + s !! (l - 1) - s !! 0
9464
901e363d5837 Finish rework of default binds system. Default binds now work even before first turn.
unc0rr
parents: 9462
diff changeset
    52
                         ) `mod` 256