PermutationHasher.elm

import String
import Result exposing (andThen)
import Text
import Color
import Html exposing (..)
import Html.Attributes as Attr exposing (..)
import Html.Events exposing (..)


-- View

view : Model -> Html
view result = 
  let
    permutation = 
      input 
        [ placeholder "Permutation (e.g. \"1 3 0 2\")"
        , on "input" targetValue (Signal.message query.address)
        ]
        []
  in
    div [] 
      [ permutation
      , br [] []
      , mapResult 
          ((++) "Hashed: " << toString << hash) 
          result
      , br [] []
      , mapResult 
          ((++) "Unhashed: " << toString << unhash << \m -> (hash m, List.length m)) 
          result
      ]


mapResult : (Permutation -> String) -> Model -> Html
mapResult f result =
  case result of
    Ok val -> text <| f val
    Err e -> div 
      [ style 
        [ ("color", "red")
        , ("display", "inline")
        ]
      ] [ text e ]


-- Update

update : String -> Model
update model =
  model
    |> String.words
    |> fromList
    |> validate
  

fromList : List String -> Model
fromList list =
  let
    prependInt string acc =
      case String.toInt string of
        Ok int -> Ok (int::acc)
        Err _ -> Err "Not an int list separated by spaces"

    toInt s acc =
      acc `andThen` (prependInt s)
  in
    List.foldr toInt (Ok []) list
    

validate : Model -> Model
validate result =
  result `andThen` (\list ->
    let
      len = List.length list
      correct = [0..(len-1)]
      experiment = List.sort list
    in
      if experiment == correct then
        Ok list
      else
        Err <| "Not a valid permutation of [0.." ++ toString (len-1) ++ "]"
  )

-- Model

type alias Permutation = List Int

type alias Model = Result String Permutation

query =
  Signal.mailbox ""


-- Main

main =
  Signal.map (view << update) query.signal


{-| Below is the hashing algorithm. It is a perfect hash in that it has 
no collisions. The constraints are that it only works for comparing
permutations of the same length and the values must include exactly the
integers `0` to `n-1` for length `n`.

However, it is not a true hash. It is in fact a reversible process. This
comes at the cost of taking O(n^2) to compute in either direction. It will
not work well as a general purpose hash for large permutations.

That said, it could be very useful for storing binary information about a
permutation. For a bitstring of `n!` (factorial) bits, the hash of a
permutation corresponds to its one bit of storage. So, for example, if a
permutation of length 14 represents your solution space on a graph, then
with ~11GB of memory you can track which solutions you have visited and
the hash/unhash will be reasonably quick to compute.
-}

-- Perfect hash for permutations of a fixed length

hash : Permutation -> Int
hash permutation =
  hash' permutation (List.length permutation) 0

hash' permutation length acc =
  let
    weight = factorial (length - 1)
  in case permutation of
    [] -> acc
    x::xs -> hash' (decAbove x xs) (length - 1) (acc + x * weight)

decAbove x xs =
  List.map (\y -> if y > x then y - 1 else y) xs


-- Reverse the hashing process

unhash : (Int, Int) -> Permutation
unhash (val, length) =
  unhash' val length [] []
  
unhash' val length acc used =
  let
    pos = List.length acc
    n = length - pos - 1
    f = factorial n
    x = incAbove used (val // f)
    val' = val `rem` f
    acc' = x::acc
    used' = x::used
  in case n of
    0 -> List.reverse acc'
    otherwise -> unhash' val' length acc' used'

incAbove xs x =
  List.foldl (\v acc -> if acc >= v then acc + 1 else acc) x (List.sort xs)


-- Helper math functions

factorial : Int -> Int
factorial n =
  factorial' n 1
  

factorial' n acc =
  if n <= 1 then
    acc
  else
    factorial' (n-1) (acc * n)