Fork me on GitHub

Huffman Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#!/usr/bin/env fsharpi

(* This construct is for ML compatibility. The syntax '(typ,...,typ) ident'
   is not used in F# code. Consider using 'ident<typ,...,typ>' instead. *)
#nowarn "62"

[<RequireQualifiedAccess>]
module Huffman =

  type tree =
    | Leaf of frecuency * char
    | Node of frecuency * tree * tree
  and frecuency = int
  
  let frecuency : tree -> frecuency * tree = function
    | Leaf (f,_)   as t -> f,t
    | Node (f,_,_) as t -> f,t
  
  let encoding : string -> tree =
    fun text ->
      let rec aux : tree Set -> tree =
        fun acc0 ->
          if Set.isEmpty acc0 then
            failwith "Set is empty"
          else if Set.count acc0 = 1 then
            Set.minElement acc0
          else
            let (f1,x) = acc0 |> Set.minElement |> frecuency
            let (acc1) = acc0 |> Set.remove x
            let (f2,y) = acc1 |> Set.minElement |> frecuency
            let (acc2) = acc1 |> Set.remove y
            
            acc2 |> Set.add (Node (f1+f2,x,y))  |> aux
      text
      |> Seq.groupBy id
      |> Seq.map (fun (x,xs) -> xs |> Seq.length,x)
      |> Set.ofSeq
      |> Set.map Leaf
      |> aux
  
  let tree2charmap : tree -> (char, int list) Map =
    fun t ->
      let rec aux acc : tree -> (char, int list) Map = function
        | Leaf (_,c)   -> Map.empty |> Map.add c (List.rev acc)
        | Node (_,l,r) ->
          let ml = aux (0::acc) l
          let mr = aux (1::acc) r
          ml |> Map.fold(fun a k v -> a |> Map.add k v) mr
      aux [] t
  
  let table : (char, int list) Map -> string =
    fun map ->
      map
      |> Map.toList
      |> List.map (fun (k,v) -> sprintf "'%c': %A\n" k v)
      |> List.fold (fun a x -> a + x) ""
  
  let tree2codemap : tree -> (int list, char) Map =
    fun t ->
      let rec aux acc : tree -> (int list, char) Map = function
        | Leaf (_,c)   -> Map.empty |> Map.add (List.rev acc) c
        | Node (_,l,r) ->
          let ml = aux (0::acc) l
          let mr = aux (1::acc) r
          ml |> Map.fold(fun a k v -> a |> Map.add k v) mr
      aux [] t
  
  let compress : (char, int list) Map -> string -> string =
    fun map text ->
      text
      |> Seq.map (fun c -> map |> Map.find c)
      |> Seq.collect id
      |> Seq.fold (fun a x -> a + (string x)) ""
  
  let decompress : (int list, char) Map -> string -> string =
    fun map code ->
      let rec aux acc code = function
        | [     ] -> acc |> List.rev
        | x :: xs ->
          let code'       = code @ [x]
          let copt        = map |> Map.tryFind code'
          let acc',code'' =
            match copt with
              | Some c -> c::acc, [   ]
              | None   ->    acc, code'
          aux acc' code'' xs
      let xs = code |> Seq.map (string >> int) |> Seq.toList
      aux [] [] xs |> List.fold (fun a x -> a + (string x)) ""

Huffman Code output:

module Huffman = begin
  type tree =
    | Leaf of frecuency * char
    | Node of frecuency * tree * tree
  and frecuency = int
  val frecuency : _arg1:tree -> frecuency * tree
  val encoding : text:string -> tree
  val tree2charmap : t:tree -> Map<char,int list>
  val table : map:Map<char,int list> -> string
  val tree2codemap : t:tree -> Map<int list,char>
  val compress : map:Map<char,int list> -> text:string -> string
  val decompress : map:Map<int list,char> -> code:string -> string
end

Execution Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
let text = """this is an example of a huffman tree"""

let encoding =
  text
  |> Huffman.encoding

let tree2charmap =
  encoding
  |> Huffman.tree2charmap

let tree2codemap =
  encoding
  |> Huffman.tree2codemap

let table =
  tree2charmap
  |> Huffman.table

let compressed =
  text
  |> Huffman.compress tree2charmap

let decompressed =
  compressed
  |> Huffman.decompress tree2codemap

printfn "* Text:\n«%s»\n"         text
printfn "* Table:\n%s"            table
printfn "* Compressed:\n%s\n"     compressed
printfn "* Decompressed:\n«%s»\n" decompressed
mon@razerRamon:~/tmp$ ./HuffmanCoding.fsx

Execution Code output:

* Text:
«this is an example of a huffman tree»

* Table:
' ': [1; 1; 1]
'a': [0; 0; 1]
'e': [1; 1; 0]
'f': [0; 0; 0]
'h': [1; 0; 1; 1; 0]
'i': [1; 0; 1; 1; 1]
'l': [1; 0; 0; 0; 0]
'm': [0; 1; 0; 0]
'n': [0; 1; 0; 1]
'o': [1; 0; 0; 0; 1]
'p': [1; 0; 0; 1; 0]
'r': [1; 0; 0; 1; 1]
's': [0; 1; 1; 0]
't': [0; 1; 1; 1]
'u': [1; 0; 1; 0; 0]
'x': [1; 0; 1; 0; 1]

* Compressed:
0111101101011101101111011101101110010101111110101010010100100101000011011110001000111001111101101010000000001000010101111011110011110110

* Decompressed:
«this is an example of a huffman tree»

References:

Real World Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
module RealWorld : sig                              
                                                    
  type   world = private World                      
  type α pure  = private Pure of α                  
  type α io    = world  (α pure * world)           
                                                    
  val bind : α io  β io  β io                     
  val lift : α io  (α pure  β io)  β io          
                                                    
  val ( >> )  : α io            β io   β io       
  val ( >>= ) : α io  (α pure  β io)  β io       
                                                    
  val unit : unit pure                              
                                                    
  val effect : (α  β)  α pure  β io              
  val eval   : unit io  (unit pure * world)        
                                                    
end                                                 
                                                    
  = struct                                          
                                                    
  type   world = World                              
  type α pure  = Pure of α                          
  type α io    = world  (α pure * world)           
                                                    
  let bind : α io  β io  β io =                   
    λ action1 action2 world0                       
      let (a,world1) = action1 world0 in            
      let (b,world2) = action2 world1 in            
      (b,world2)                                    
                                                    
  let lift : α io  (α pure  β io)  β io =        
    λ action1 action2 world0                       
      let (a,world1) = action1   world0 in          
      let (b,world2) = action2 a world1 in          
      (b,world2)                                    
                                                    
  let ( >> )  : α io            β io   β io = bind
  let ( >>= ) : α io  (α pure  β io)  β io = lift
                                                    
  let unit : unit pure = Pure ()                    
                                                    
  let effect : (α  β)  α pure  β io =            
    λ f (Pure a)                                   
      λ world  Pure (f a), world                   
                                                    
  let eval : unit io  (unit pure * world) =        
    λ main  main World                             
                                                    
end 

Real World Code output:

module RealWorld :
  sig
    type world = private World
    type 'a pure = private Pure of 'a
    type 'a io = world -> 'a pure * world
    val bind    : 'a io -> 'b io -> 'b io
    val lift    : 'a io -> ('a pure -> 'b io) -> 'b io
    val ( >> )  : 'a io -> 'b io -> 'b io
    val ( >>= ) : 'a io -> ('a pure -> 'b io) -> 'b io
    val unit    : unit pure
    val effect  : ('a -> 'b) -> 'a pure -> 'b io
    val eval    : unit io -> unit pure * world
  end

Utils Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
module Util = struct                                
                                                    
  open RealWorld                                    
                                                    
  let (!) : α  α io =                              
    λ a  effect (λ _  a) unit                     
                                                    
  let readLn : string io =                          
    effect read_line unit                           
                                                    
  let putStr : string pure  unit io =              
    effect print_string                             
                                                    
  let putStrLn : string pure  unit io =            
    effect print_endline              	              
                                                    
  let sample : unit io =                            
    ! "What is your name?"                          
    >>= putStrLn                                    
    >>  readLn                                      
    >>= λ a                                        
      ! "How old are you?"                          
      >>= putStrLn                                  
      >>  readLn                                    
      >>= λ b                                      
        putStr a                                    
        >>  ! ": "                                  
        >>= putStr                                  
        >>  putStrLn b                              
                                                    
end                                                 

Utils Code output:

module Util :
  sig
    val ( ! )    : 'a -> 'a RealWorld.io
    val readLn   : string RealWorld.io
    val putStr   : string RealWorld.pure -> unit RealWorld.io
    val putStrLn : string RealWorld.pure -> unit RealWorld.io
    val sample   : unit RealWorld.io
  end

Execution Code Snippet

let _ = Util.sample |> RealWorld.eval 
mon@razerRamon:~/tmp/ocaml$ ocaml real_world.ml

Execution Code output:

What is your name?
John Doe
How old are you?
42
John Doe: 42

References:

Real World Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
module RealWorld =
  
  type    World = private | World
  and  'a Pure  = private | Pure  of  'a
  and  'a IO    =           World -> ('a Pure * World)
  
  let bind  : 'a IO -> 'b IO -> 'b IO =
    fun a1 a2 world0 ->
      let (a,world1) = a1 world0 in
      let (b,world2) = a2 world1 in
      (b,world2)
  
  let lift : 'a IO -> ('a Pure -> 'b IO) -> 'b IO =
    fun a1 a2 world0 ->
      let (a,world1) = a1   world0 in
      let (b,world2) = a2 a world1 in
      (b,world2)
  
  let ( >> )  : 'a IO ->             'b IO  -> 'b IO = bind
  let ( >>= ) : 'a IO -> ('a Pure -> 'b IO) -> 'b IO = lift
  
  let unit : unit Pure = Pure ()
  
  let effect : ('a -> 'b) -> 'a Pure -> 'b IO =
    fun f (Pure a) ->
      fun world -> Pure (f a), world
  
  let eval : unit IO -> unit Pure * World =
    fun main -> main World
  
  [<AutoOpen>]
  module Don =
    
    [<Sealed>]
    type DonBuilder () =
      member __.Yield (()) : unit IO = fun world -> unit,world
      [<CustomOperation("bind")>]
      member __.Bind' (a1, a2) = bind a1 a2
      [<CustomOperation("lift")>]
      member __.LiftM (a1, a2) = lift a1 a2
    
    let don = new DonBuilder ()

Real World Code output:

module RealWorld = begin
  type World = private | World
  and 'a Pure = private | Pure of 'a
  and 'a IO = World -> 'a Pure * World
  val bind : a1:'a IO -> a2:'b IO -> world0:World -> 'b Pure * World
  val lift :
    a1:'a IO -> a2:('a Pure -> 'b IO) -> world0:World -> 'b Pure * World
  val ( >> ) : ('a IO -> 'b IO -> 'b IO)
  val ( >>= ) : ('a IO -> ('a Pure -> 'b IO) -> 'b IO)
  val unit : unit Pure = Pure ()
  val effect : f:('a -> 'b) -> 'a Pure -> 'b IO
  val eval : main:unit IO -> unit Pure * World
  module Don = begin
    type DonBuilder =
      class
        new : unit -> DonBuilder
        member Bind' : a1:'c IO * a2:'d IO -> 'd IO
        member LiftM : a1:'a IO * a2:('a Pure -> 'b IO) -> 'b IO
        member Yield : unit -> unit IO
      end
    val don : DonBuilder
  end
end

Utils Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
module Util =
  
  open RealWorld
  
  module Random =
    let private r  = new System.Random ()
    let next   ( ) =          r.Next   ()
  
  module Read =
    let readInt  () = System.Console.Read     ()
    let readKey  () = System.Console.ReadKey  ()
    let readLine () = System.Console.ReadLine ()
  
  let (!) : 'a -> 'a IO =
    fun a -> effect (fun _ -> a) unit
  
  let getRand : int IO =
    effect Random.next unit
  
  let putInt : int Pure -> unit IO =
    effect <| printf "%i"
  
  let readLn : string IO =
    effect Read.readLine unit
  
  let putStr : string Pure -> unit IO =
    effect <| printf "%s"
  
  let putStrLn : string Pure -> unit IO =
    effect <| printfn "%s"
  
  let sample1 : unit IO =
    ! "What is your name?"
    >>= putStrLn
    >>  readLn
    >>= fun a ->
      ! "How old are you?"
      >>= putStrLn
      >>  readLn
      >>= fun b ->
        putStr a
        >>  ! ","
        >>= putStr
        >>  putStrLn b
  
  let sample2 : unit IO = don {
    bind ! "What is your name?"
    lift putStrLn
    bind readLn
    
    lift (fun a -> don {
    bind ! "How old are you?"
    lift putStrLn
    bind readLn
    
    lift (fun b -> don {
    bind (putStr a)
    bind ! ","
    lift putStr
    bind (putStrLn b)
    
    })
    })
  }

Utils Code output:

module Util = begin
  module Random = begin
    val private r : System.Random
    val next : unit -> int
  end
  module Read = begin
    val readInt : unit -> int
    val readKey : unit -> System.ConsoleKeyInfo
    val readLine : unit -> string
  end
  val ( ! ) : a:'a -> 'a RealWorld.IO
  val getRand : int RealWorld.IO
  val putInt : (int RealWorld.Pure -> unit RealWorld.IO)
  val readLn : string RealWorld.IO
  val putStr : (string RealWorld.Pure -> unit RealWorld.IO)
  val putStrLn : (string RealWorld.Pure -> unit RealWorld.IO)
  val sample1 : unit RealWorld.IO
  val sample2 : unit RealWorld.IO
end

Execution Code Snippet

let _ = Util.sample1 |> RealWorld.eval, Util.sample2 |> RealWorld.eval
mon@razerRamon:~/tmp/realWorld$ ./RealWorld.fsx

Execution Code output:

What is your name?
John Doe
How old are you?
42
John Doe,42
What is your name?
John Doe
How old are you?
42
John Doe,42

References:

Picture by Fernando Frazão/Agência Brasil, (CC BY 3.0 BR)

Status

Submission accepted on Kattis Problem Archive

Files

mon@razerRamon:~/tmp/ncpc17$ ll
total 109M
drwxrwxr-x  3 mon mon 4.0K Oct 14 16:42 assets/
drwxrwxr-x 13 mon mon 4.0K Oct 14 12:34 ncpc2017-testdata/
-rwxrwxr-x  1 mon mon  257 Oct 14 16:19 BestRelayTeam.bash*
-rwxrwxr-x  1 mon mon 4.0K Oct 14 16:23 BestRelayTeam.hs*
-rw-rw-r--  1 mon mon  699 Oct 14 16:24 BestRelayTeam.sample.output
-rw-rw-r--  1 mon mon 138K Oct 14 16:24 BestRelayTeam.secret.output
-rw-rw-r--  1 mon mon  59K Oct  7 12:19 Language Haskell - Kattis, The 2017 Nordic Collegiate Programming Contest.pdf
-rw-rw-r--  1 mon mon 4.7M Oct  7 12:29 ncpc2017problems.pdf
-rw-rw-r--  1 mon mon 104M Oct 11 09:00 ncpc2017-testdata.tar.bz2
-rwxrwxr-x  1 mon mon 1.2K Oct 14 14:00 ScriptTemplate.hs*
-rw-rw-r--  1 mon mon    8 Oct  7 12:42 ScriptTemplate.input
mon@razerRamon:~/tmp/ncpc17$

Haskell Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
#!/usr/bin/env stack
{- stack
   --resolver ghc-7.10.3
   --install-ghc
   runghc
   --
   -rtsopts -ferror-spans
   +RTS -M1024m -K8m -RTS
-}

{-
  * GHC used by NCPC:
      The Glorious Glasgow Haskell Compilation System version 7.10.3

  * Flags required by NCPC:
      -O2 -threaded -rtsopts -ferror-spans
      +RTS -M{memlim}m -K8m -RTS

  ... but, due to warnings (ignored), some are removed: 
      when making flags consistent: Warning:
          -O conflicts with --interactive; -O ignored.
      Warning: -debug, -threaded and -ticky are ignored by GHCi

  * Flags in order to make optimal code (exhaustive):
      -Wall -Werror

  ... but if used, it would require way more code (time is mana)
-}

module Main (main) where

data Runner = Runner
  { surname :: String
  , fstleg  :: Double
  , sndleg  :: Double
  }

data Runners = Runners
  { number   ::  Int
  , athletes :: [Runner]
  }

data RelayTeam = RelayTeam
  { time   :: Double
  , first  :: Runner
  , second :: Runner
  , third  :: Runner
  , fourth :: Runner
  }

instance Eq Runner where
  Runner name1 fstleg1 sndleg1 == Runner name2 fstleg2 sndleg2 =
    name1 == name2 && fstleg1 == fstleg2 && sndleg1 == sndleg2
  Runner name1 fstleg1 sndleg1 /= Runner name2 fstleg2 sndleg2 =
    name1 /= name2 || fstleg1 /= fstleg2 || sndleg1 /= sndleg2

instance Read Runner where
  readsPrec _ input =
    let
      aux [        ] = []
      aux (name:fstleg:sndleg:[]) =
        [(Runner name (read fstleg) (read sndleg), "")]
      aux [   _    ] = []
    in
      aux $ words input

instance Read Runners where
  readsPrec _ input =
    let
      aux [    ] = []
      aux (x:xs) =
        let
          nr = read x
        in
          [(Runners nr (aux' nr xs), "")]
      aux' 0 [    ] = [                        ]
      aux' n (x:xs) = (read x) : aux' (n-1) xs
    in
      aux $ lines input

instance Show Runner where
  show (Runner surname _ _) = surname

instance Show RelayTeam where
  show (RelayTeam time first second third fourth) =
    show time   ++ "\n" ++
    show first  ++ "\n" ++
    show second ++ "\n" ++
    show third  ++ "\n" ++
    show fourth ++ "\n"

nrdec :: Double -> Int -> Double
nrdec x n =
  fromIntegral (round $ x * z) / z
  where z = 10 ^ n
  
solve :: Runners -> RelayTeam
solve (Runners _ xs) =
  let
    dummy = Runner "DUMMY" 9999.99 9999.99
    init  = (dummy,dummy,dummy,dummy)
    
    ftime (Runner _ t _) = t
    stime (Runner _ _ t) = t
    bstime (a,b,c,d) (w,x,y,z) =
      stime a + stime b + stime c + stime d <
      stime w + stime x + stime y + stime z
    bctime (a,b,c,d) (w,x,y,z) =
      ftime a + stime b + stime c + stime d <
      ftime w + stime x + stime y + stime z

    aux (a,b,c,d) _ [    ] =
      RelayTeam (nrdec (ftime a + stime b + stime c + stime d) 2) a b c d
    aux acc (a,b,c,d) (y:ys) =
      {- Linear time with only 8 extra memory usage -}
      let
        abcd =
          if a == y then
            (y,b,c,d)
          else
            if b == y then
              (y,a,c,d)
            else
              if c == y then
                (y,a,b,d)
              else
                (y,a,b,c)
      in
        if bctime abcd acc then 
          aux abcd (a,b,c,d) ys
        else
          aux acc  (a,b,c,d) ys
      
    aux' (a,b,c,d) [    ] = (a,b,c,d)
    aux' (a,b,c,d) (y:ys) =
      {- Linear time with only 4 extra memory usage -}
      if bstime (y,b,c,d) (a,b,c,d) then
        aux' (y,b,c,d) (a:ys)
        else
        if bstime (a,y,c,d) (a,b,c,d) then
          aux' (a,y,c,d) (b:ys)
        else
          if bstime (a,b,y,d) (a,b,c,d) then
            aux' (a,b,y,d) (c:ys)
          else
            if bstime (a,b,c,y) (a,b,c,d) then
              aux' (a,b,c,y) (d:ys)
            else
              aux' (a,b,c,d) ys
  in
    aux init (aux' init xs) xs

readInput :: String -> Runners
readInput =
  read

writeOutput :: RelayTeam -> String
writeOutput =
  show

main :: IO ()
main =
  interact $ writeOutput . solve . readInput

Haskell Code output:

BestRelayTeam.bash

#!/bin/bash

for f in $1*.in; do
    echo " "
    echo "- "$f
    cat $f
    echo "- "${f%.*}.ans
    cat ${f%.*}.ans
    echo "- result:"
    cat $f | ./BestRelayTeam.hs
    echo "- diff:"
    cat $f | ./BestRelayTeam.hs | diff - ${f%.*}.ans
done

BestRelayTeam (sample)

./BestRelayTeam.bash ncpc2017-testdata/bestrelayteam/sample/

BestRelayTeam (sample output)

 
- ncpc2017-testdata/bestrelayteam/sample/1.in
6
ASHMEADE 9.90 8.85
BLAKE 9.69 8.72
BOLT 9.58 8.43
CARTER 9.78 8.93
FRATER 9.88 8.92
POWELL 9.72 8.61
- ncpc2017-testdata/bestrelayteam/sample/1.ans
35.54
CARTER
BOLT
POWELL
BLAKE
- result:
35.54
CARTER
BOLT
POWELL
BLAKE
- diff:
 
- ncpc2017-testdata/bestrelayteam/sample/2.in
9
AUSTRIN 15.60 14.92
DRANGE 15.14 14.19
DREGI 15.00 14.99
LAAKSONEN 16.39 14.97
LUNDSTROM 15.83 15.35
MARDELL 13.36 13.20
POLACEK 13.05 12.55
SANNEMO 15.23 14.74
SODERMAN 13.99 12.57
- ncpc2017-testdata/bestrelayteam/sample/2.ans
52.670000
MARDELL
POLACEK
SODERMAN
DRANGE
- result:
52.67
MARDELL
POLACEK
SODERMAN
DRANGE
- diff:
1c1
< 52.67
---
> 52.670000

BestRelayTeam (secret)

./BestRelayTeam.bash ncpc2017-testdata/bestrelayteam/secret/

BestRelayTeam (secret output, only diff)

- ncpc2017-testdata/bestrelayteam/secret/01-crazy.in
10
QXBINSJS 10.91 8.16
WKN 18.65 15.09
CPP 16.38 9.38
KDNLKJMYIWFSGYWY 12.53 11.18
KXS 19.64 13.63
OYCJANFTSGQTZMIJD 16.16 8.32
ZKGNNS 17.32 16.16
LDOYLWRXVXAJEVDOWXNF 13.02 12.58
IVONUZJE 11.52 10.37
KMEVNRHQSQPUYEYBP 18.71 9.63
- ncpc2017-testdata/bestrelayteam/secret/01-crazy.ans
37.38
IVONUZJE
QXBINSJS
OYCJANFTSGQTZMIJD
CPP
- result:
37.38
IVONUZJE
QXBINSJS
OYCJANFTSGQTZMIJD
CPP
- diff:
 
- ncpc2017-testdata/bestrelayteam/secret/02-crazy.in
50

...

- ncpc2017-testdata/bestrelayteam/secret/15-sequential.ans
60.06
GGURGO
NXZUEOA
BOHPBXMYSTFJUPUA
IOYBAEDMKSKO
- result:
60.06
IOYBAEDMKSKO
GGURGO
NXZUEOA
BOHPBXMYSTFJUPUA
- diff:
2d1
< IOYBAEDMKSKO
5a5
> IOYBAEDMKSKO

...

- ncpc2017-testdata/bestrelayteam/secret/30-sequential-secondbest-firstpart.ans
51.99
SECONDBEST
BEST
JMBCIRVTIHVRKRZZTXSD
RJZMGLUWHOJBLQGIUWZD
- result:
51.99
SECONDBEST
BEST
JMBCIRVTIHVRKRZZTXSD
QQYBKUPSWYKJCUODUSMA
- diff:
5c5
< QQYBKUPSWYKJCUODUSMA
---
> RJZMGLUWHOJBLQGIUWZD

References:

Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
(* This construct is for ML compatibility. The syntax '(typ,...,typ) ident'
   is not used in F# code. Consider using 'ident<typ,...,typ>' instead. *)
#nowarn "62"

module Error =
  
  type fromException =
    { message    : string
    ; hresult    : int
    ; stacktrace : string
    }
  
  let exn2error : System.Exception -> fromException =
    fun ex ->
      { message    = ex.Message
      ; hresult    = ex.HResult
      ; stacktrace = ex.StackTrace
      }

module Monad =
  
  (* Inspired by: Eirik Tsarpalis http://fssnip.net/7TF *)
  
  type ('a,'b) flow = ('a,'b) Choice
  
  let success : 'a -> ('a,'b) flow = fun x -> Choice1Of2 x
  let failure : 'b -> ('a,'b) flow = fun x -> Choice2Of2 x
  
  let (|Success|Failure|) : ('a,'b) flow -> ('a,'b) flow = id
  
  let catch : (exn -> 'b) -> 'a Async -> ('a,'b) flow Async =
    fun f m ->
      async {
        let! x = Async.Catch m
    
        return
          match x with
            | Success y -> y      |> success
            | Failure e -> e |> f |> failure
      }
  
  let bind : ('a -> ('c,'b) flow) -> ('a,'b) flow -> ('c,'b) flow =
    fun f ->
      function
        | Success x -> x |> f
        | Failure x -> x |> failure
  
  let (>>=) m f = bind f m

module Web =
  
  open Monad
  
  (* Don Syme Blog: "Introducing F# Asynchronous Workflows"
     
     https://blogs.msdn.microsoft.com/dsyme/
     2007/10/10/introducing-f-asynchronous-workflows/ *)
  
  open System.IO
  open System.Net
  
  type request = GET | POST
  
  let syncHttp : string -> string =
    fun url ->
      // Create the web request object
      let req = WebRequest.Create url
      
      // Get the response, synchronously
      let rsp = req.GetResponse ()
      
      // Grab the response stream and a reader. Clean up when we're done
      use stream = rsp.GetResponseStream ()
      use reader = new StreamReader(stream)
      
      // Synchronous read-to-end, returning the flow
      reader.ReadToEnd() 
  
  let asyncHttp : string -> string Async =
    fun url ->
      async {
        // Create the web request object
        let req = WebRequest.Create url
        
        // Get the response, asynchronously
        // let! rsp = req.GetResponseAsync () (* API changes since blog post *)
        let! rsp = req.AsyncGetResponse ()
        
        // Grab the response stream and a reader. Clean up when we're done
        use stream = rsp.GetResponseStream ()
        use reader = new StreamReader(stream)
        
        // synchronous read-to-end
        return reader.ReadToEnd ()
      }
  
  let asyncHttp' : (exn -> 'a) -> (string * string) list -> request -> string
    -> (string,'a) flow Async =
    fun error headers request url ->
      async {
        // Create the web request object
        let req = WebRequest.Create url
        
        req.Method           <- sprintf "%A" request
        req.ContentLength    <- 0L
        req.Timeout          <- System.Threading.Timeout.Infinite
        
        headers
        |> List.iter(fun (k,v) -> req.Headers.Add(k,v))
        
        // Get the response, asynchronously
        // let! rsp = req.GetResponseAsync () (* API changes since blog post *)
        let! rsp = req.AsyncGetResponse ()
        
        // Grab the response stream and a reader. Clean up when we're done
        use stream = rsp.GetResponseStream ()
        use reader = new StreamReader(stream)
        
        // synchronous read-to-end
        return reader.ReadToEnd ()
      } |> Monad.catch error

module Translate =
  
  (* https://msdn.microsoft.com/en-us/library/ff512421.aspx *)
  
  open System.Net
  
  open Monad
  open Web
  
  type fail = Unexpected of Error.fromException
  
  let inline (=>) x y = x,y
  
  let urlenc : string -> string = WebUtility.UrlEncode
  
  let urlToken = "https://api.cognitive.microsoft.com/sts/v1.0/issueToken"
  let urlTrans = "https://api.microsofttranslator.com/v2/Http.svc/Translate"
  
  let token : string -> (string,fail) flow Async =
    fun key ->
      let headers =
        [ "Ocp-Apim-Subscription-Key" => key
        ]
      urlToken |> asyncHttp' (Error.exn2error >> Unexpected) headers POST
  
  let text : string -> string -> string -> string -> (string,fail) flow Async =
    fun input fromTag toTag token ->
      let query =
        sprintf "%s?text=%s&from=%s&to=%s&contentType=text/plain"
          urlTrans (urlenc input) fromTag toTag
      let headers =
        [ "Authorization" => sprintf "Bearer %s" token
        ]
      query |> asyncHttp' (Error.exn2error >> Unexpected) headers GET

open Monad

let apikey = "omitted api key for obvious reasons"

let english = "Use pixels to express measurements for padding and margins."

(* Language Tag: https://msdn.microsoft.com/en-us/library/cc233982.aspx *)
let en = "en"
let da = "da"

Translate.token apikey
|> Async.RunSynchronously
|> function
  | Success token ->
    Translate.text english en da token
    |> Async.RunSynchronously
    |> printfn "%A"
  | Failure error ->
    error
    |> printfn "%A"

Code output:

> module Error = begin
  type fromException =
    {message: string;
     hresult: int;
     stacktrace: string;}
  val exn2error : ex:System.Exception -> fromException
end
module Monad = begin
  type ('a,'b) flow = Choice<'a,'b>
  val success : x:'a -> ('a,'b) flow
  val failure : x:'b -> ('a,'b) flow
  val ( |Success|Failure| ) : (('a,'b) flow -> ('a,'b) flow)
  val catch : f:(exn -> 'b) -> m:Async<'a> -> Async<('a,'b) flow>
  val bind : f:('a -> ('c,'b) flow) -> _arg1:('a,'b) flow -> ('c,'b) flow
  val ( >>= ) : m:('a,'b) flow -> f:('a -> ('c,'b) flow) -> ('c,'b) flow
end
module Web = begin
  type request =
    | GET
    | POST
  val syncHttp : url:string -> string
  val asyncHttp : url:string -> Async<string>
  val asyncHttp' :
    error:(exn -> 'a) ->
      headers:(string * string) list ->
        request:request -> url:string -> Async<(string,'a) Monad.flow>
end
module Translate = begin
  type fail = | Unexpected of Error.fromException
  val inline ( => ) : x:'a -> y:'b -> 'a * 'b
  val urlenc : arg00:string -> string
  val urlToken : string =
    "https://api.cognitive.microsoft.com/sts/v1.0/issueToken"
  val urlTrans : string =
    "https://api.microsofttranslator.com/v2/Http.svc/Translate"
  val token : key:string -> Async<(string,fail) Monad.flow>
  val text :
    input:string ->
      fromTag:string ->
        toTag:string -> token:string -> Async<(string,fail) Monad.flow>
end
val apikey : string = "omitted api key for obvious reasons"
val english : string =
  "Use pixels to express measurements for padding and margins."
val en : string = "en"
val da : string = "da"

> Choice1Of2
  "<string xmlns="http://schemas.microsoft.com/2003/10/Serialization/">
    Brug pixel til at udtrykke målinger for polstring og margener.
  </string>"
val it : unit = ()

References: