lzw.fsx

type Char = uint8
type Code = uint32

let compress  (init_map : Map<Char list, Code>) (text:string) : Code list option=
    let rec compress acc (text:Char list) maybeCode (map:Map<_,_>) : Code list option=
        match text with
        | c::cs ->
            let currCode = c::acc
            match map.TryFind currCode with
            | Some code_for_current_key -> compress currCode cs (Some code_for_current_key) map
            | None ->
                maybeCode
                |> Option.bind(fun code ->
                    let map = map |> Map.add currCode (uint32 map.Count)
                    compress [] cs None map
                    |> Option.map (fun tail -> code::map.[[c]]::tail))
        | [] -> 
            match maybeCode with
            | Some x -> Some (List.singleton x)
            | None ->
                match acc with
                | [] -> Some []
                | _ -> None


    compress [] (text |> Seq.map uint8 |> List.ofSeq) None init_map


let decompression (init_map : Map<Char list, Code>) (code:Code list) : string =
    let rec decompression (map:Map<Code, Char list>) acc (knownChars:Set<Char list>) = function
    | [] -> []
    | c::cs -> 
        let chars = 
            match Map.tryFind c map with
            | Some c -> c
            | None -> failwithf "Unknown code %A in %A" c map
        let acc = chars @ acc
        let map, acc, knownChars =
            match knownChars.Contains acc with
            | true -> map, acc, knownChars
            | false -> Map.add (uint32 map.Count) (List.rev acc) map, [], knownChars.Add acc
        chars @ decompression map acc knownChars cs
    
    let map = init_map |> Seq.map (fun (KeyValue(k,v)) -> v,k) |> Map.ofSeq
    let knownChars = init_map |> Seq.map (fun (KeyValue(k,_)) -> k) |> Set.ofSeq
    decompression map [] knownChars code |> List.map (char) |> List.toArray |> System.String


let test (s:string) = 
    if isNull s then true
    else
        let map =
            s
            |> Seq.distinct
            |> Seq.mapi (fun pos key -> [uint8 key], uint32 pos)
            |> Map.ofSeq

        s = (compress map s |> Option.map (decompression map) |> Option.defaultValue "")


#r @"../packages/FsCheck/lib/netstandard1.6/FsCheck.dll"
FsCheck.Check.Quick test