hashabler-1.0: viz/Main.hs

module Main where

import Control.Applicative
import Data.Word
import Data.Bits
import Data.Array
import Codec.Picture
import qualified Data.Vector as V
import System.Random.MWC

import qualified Data.Text as T
import qualified Data.Text.IO as T

import qualified Data.Hashable as Their
import qualified Data.Hashabler as Our

-- A quick tool to visualize distributions. 
--
-- All pretty inefficient; we could build the Image vector directly, and work
-- with random mutable vectors as input.


main :: IO ()
main = do
    let out nm = "viz/out/"++nm++".bmp"
        viz nm s = do saveBmpImage (out nm) $ bitmap s
                      putStrLn $ "Wrote "++(out nm)

    -- Visualize true uniform randomness 
    vs <- withSystemRandom . asGenST $ \gen -> uniformVector gen (1024*1024)
    let samples = V.toList vs
    viz "random" samples

    -- should look like a red square 1/256 of side length:
    --viz "span16" $ map fromIntegral [(0::Word16).. maxBound]
    -- Should look flat light gray:
    --viz "span_all_px" $ [0,(64*64).. maxBound]

{-  NOT SO INTERESTING --------

    -- Int
    viz "hashable_Word32" $ map ((fromIntegral :: Int -> Word32) . Their.hash) samples
    viz "hashabler_Word32" $ map (Our.hashWord32 . Our.hashFNV32) samples

    -- Word8
    samples <- V.toList <$> (withSystemRandom . asGenST $ \gen -> uniformVector gen (1024*1024))
    viz "hashable_Word8" $ map (fromIntegral . Their.hash) (samples :: [Word8])
    viz "hashabler_Word8" $ map (Our.hashWord32 . Our.hashFNV32) samples
 
 -}    

    -- (Word8 , Word8)
    samples <- V.toList <$> (withSystemRandom . asGenST $ \gen -> uniformVector gen (1024*1024))
    viz "Word8,Word8_hashable" $ map (fromIntegral . Their.hash) (samples :: [(Word8,Word8)])
    viz "Word8,Word8_hashabler" $ map (Our.hashWord32 . Our.hashFNV32) samples
    
    -- (Word8, Word8 , Word8)
    samples <- V.toList <$> (withSystemRandom . asGenST $ \gen -> uniformVector gen (1024*1024))
    viz "Word8,Word8,Word8_hashable" $ map (fromIntegral . Their.hash) (samples :: [(Word8,Word8,Word8)])
    viz "Word8,Word8,Word8_hashabler" $ map (Our.hashWord32 . Our.hashFNV32) samples

    -- [Ordering]  -- exhaustive, of length 10 (~59K)
    let samples 0 = [[]]
        samples n = let ss = samples (n-1)
                     in map (LT:) ss ++ map (GT:) ss ++ map (EQ:) ss
    viz "List_10_Ordering_hashable" $ map (fromIntegral . Their.hash) $ samples 10
    viz "List_10_Ordering_hashabler" $ map (Our.hashWord32 . Our.hashFNV32) $ samples 10

    -- [Either Int Bool] -- of random length 0 .. 100

    -- String  -- 100K english words
    samples <- lines <$> readFile "/usr/share/dict/words"
    viz "String_words_hashable" $ map (fromIntegral . Their.hash) samples
    viz "String_words_hashabler" $ map (Our.hashWord32 . Our.hashFNV32) samples

    -- Text    -- 100K english words
    samples <- T.lines <$> T.readFile "/usr/share/dict/words"
    viz "Text_words_hashable" $ map (fromIntegral . Their.hash) samples
    viz "Text_words_hashabler" $ map (Our.hashWord32 . Our.hashFNV32) samples

    {-
    -- Text    -- 4K english words, mostly starting with A
    samples <- take 4000 . T.lines <$> T.readFile "/usr/share/dict/words"
    viz "Text_similar_words_hashable" $ map (fromIntegral . Their.hash) samples
    viz "Text_similar_words_hashabler" $ map (Our.hashWord32 . Our.hashFNV32) samples
    -}




bitmap :: [ Word32 ] -> DynamicImage
bitmap samples = ImageRGB8 $ generateImage (\x y-> a!(x,y)) 1024 1024
    where a = sampleArr samples

-- Our bitmap in array form ( would be nice if we could do this in juicypixels
-- directly)
sampleArr :: [ Word32 ] -> Array (Int,Int) PixelRGB8
sampleArr = accumArray darkenOrClipping white ((0,0) , (1023,1023)) . mapH where
    darkenOrClipping (PixelRGB8 r g b) _
        -- Red to indicate clipping; this is stable
        | (minBound+darkenIncr) > g = PixelRGB8 maxBound 0 0 
        | otherwise     = PixelRGB8 (r-darkenIncr) (g-darkenIncr) (b-darkenIncr)
    white = PixelRGB8 maxBound maxBound maxBound
    darkenIncr = 64
    mapH = map (\d-> (coord d, ()))


-- Map a Word32 to a point on 1024*1024 hilbert curve filled plane.
coord :: Word32 -> (Int,Int)
coord n = 
    -- First we quantize n to a 64x64 square. Later we'll use pixel color to
    -- indicate number of members.
    let n64 = fromIntegral $ n `div` (64*64)
     in hilbert 1024 n64


-- Copied from http://en.wikipedia.org/wiki/Hilbert_curve#Applications_and_mapping_algorithms
hilbert :: Int -> Int -> (Int,Int)
hilbert n = go 0 0 1 where
    go x y s t
        | s >= n = (x,y)
        | otherwise = 
            let rx = 1 .&. (t `div` 2)
                ry = 1 .&. (t `xor` rx)
                (x', y') = rot s x y rx ry
             
             in go (x' + s*rx) (y' + s*ry) (s*2) (t `div` 4)

    rot :: Int -> Int -> Int -> Int -> Int -> (Int,Int)
    rot s x y rx ry
        | ry == 0 = 
              if rx == 1  
                 then (s-1 - y, s-1 - x )
                 else (y, x) 
        | otherwise = (x, y)