structure Draws : DRAWS =
struct
open Generic
infix 5 =*
infix 5 =~
datatype tile = C of char | Blank
val tilebag =
[(8,C #"a"),
(2,C #"b"),
(1,C #"c"),
(5,C #"d"),
(7,C #"e"),
(2,C #"f"),
(3,C #"g"),
(2,C #"h"),
(5,C #"i"),
(1,C #"j"),
(3,C #"k"),
(5,C #"l"),
(3,C #"m"),
(6,C #"n"),
(5,C #"o"),
(2,C #"p"),
(8,C #"r"),
(8,C #"s"),
(8,C #"t"),
(3,C #"u"),
(2,C #"v"),
(1,C #"x"),
(1,C #"y"),
(1,C #"z"),
(2,C #"å"),
(2,C #"ä"),
(2,C #"ö"),
(2,Blank)]
fun tiles l =
List.foldr (fn ((n,_),m) => n+m) 0 l
fun draw_nth n [] b = raise Domain
| draw_nth n ((m,t)::r) b =
if n <= m then
if m = 1 then
(t,b@r)
else
(t,(m-1,t)::r@b)
else
draw_nth (n-m) r ((m,t)::b)
fun draw_random g _ 0 = (g,[])
| draw_random g b n =
let
val (t,b) = draw_nth (Rand.range (1,tiles b) g) b []
val (g',r) = draw_random (Rand.random g) b (n-1)
in
(g',t::r)
end
fun has c b =
List.exists (fn (n,b) => c = b andalso n>0) b
fun numberOf c b =
case List.find (fn (_,b) => c = b) b of
NONE => 0
| SOME(n,_) => n
fun insertBlanks ban (f::r) =
let
fun insertBlanks' ban (f::r) =
if f =* ban then
map (fn l => C f::l) (insertBlanks' (f::ban) r)
else
map (fn l => C f::l) (insertBlanks' (f::ban) r)
@
[Blank::map C r]
| insertBlanks' _ [] = [[]]
in
if f =* ban then
map (fn l => C f::l) (insertBlanks (f::ban) r)
else
map (fn l => C f::l) (insertBlanks (f::ban) r)
@
map (fn l => Blank::l) (insertBlanks' ban r)
end
| insertBlanks _ [] = [[]]
fun tileCompare (C a, C b) = Char.compare(a,b)
| tileCompare (Blank, C _) = LESS
| tileCompare (C _, Blank) = GREATER
| tileCompare _ = EQUAL
val uniques = ListMergeSort.uniqueSort tileCompare
fun copies_of l e =
length(List.filter (fn e' => e' = e) l)
fun factorial 0 = 1
| factorial n = n * factorial(n-1)
fun draws' t w =
let
fun picks e =
let
val a = numberOf e t
val b = copies_of w e
in
if b > a then
0
else
let
val n = factorial a
val m = factorial b
val m' = factorial(a - b)
in
n div (m*m')
end
end
val u = uniques w
val l = map picks u
in
List.foldr (op * ) 1 l
end
fun draws w =
let
val b = insertBlanks [] (explode w)
val c = map (fn b => draws' tilebag b) b
in
List.foldr (op +) 0 c
end
fun drawable' t w =
let
fun picks e =
let
val a = numberOf e t
val b = copies_of w e
in
if b > a then
0
else
1
end
val u = uniques w
val l = map picks u
in
List.foldr (op * ) 1 l
end
fun drawable w =
case
let
val b = insertBlanks [] (explode w)
val c = map (fn b => drawable' tilebag b) b
in
List.foldr (op +) 0 c
end
of
0 => false
| _ => true
fun drawable_from cl w =
let
fun tile_of #"?" = Blank
| tile_of c = C c
val cl' = map tile_of cl
val cl'' = uniques cl'
val bag = map (fn t => (copies_of cl' t,t)) cl''
in
case
let
val b = insertBlanks [] (explode w)
val c = map (fn b => drawable' bag b) b
in
List.foldr (op +) 0 c
end
of
0 => false
| _ => true
end
end