tools/hashTest.hs
author Wuzzy <Wuzzy2@mail.ru>
Thu, 15 Mar 2018 21:15:16 +0100
changeset 13221 02bf6902eeb0
parent 9464 901e363d5837
permissions -rw-r--r--
Remove Qt SVG and Qt OpenGL as hard dependencies Qt SVG is not used in the frontend (no SVGs are rendered). Neither is Qt OpenGL used. Qt OpenGL is discouraged anyway.
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