tools/hashTest.hs
author Wuzzy <Wuzzy2@mail.ru>
Tue, 07 May 2019 20:23:51 +0200
changeset 14922 089f0c10ca95
parent 9464 901e363d5837
permissions -rw-r--r--
Frontend: Optimize control conflict handling a bit
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