Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement