This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

Brickdragning

By: a guest on Nov 18th, 2010  |  syntax: OCaml  |  size: 3.41 KB  |  views: 46  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. structure Draws : DRAWS =
  2. struct
  3.  
  4. open Generic
  5. infix 5 =*
  6. infix 5 =~
  7.  
  8. datatype tile = C of char | Blank
  9.  
  10. val tilebag =
  11.     [(8,C #"a"),
  12.  
  13.      (2,C #"b"),
  14.      (1,C #"c"),
  15.      (5,C #"d"),
  16.      (7,C #"e"),
  17.      (2,C #"f"),
  18.      (3,C #"g"),
  19.      (2,C #"h"),
  20.      (5,C #"i"),
  21.      (1,C #"j"),
  22.      (3,C #"k"),
  23.      (5,C #"l"),
  24.      (3,C #"m"),
  25.      (6,C #"n"),
  26.      (5,C #"o"),
  27.      (2,C #"p"),
  28.      (8,C #"r"),
  29.      (8,C #"s"),
  30.      (8,C #"t"),
  31.      (3,C #"u"),
  32.      (2,C #"v"),
  33.      (1,C #"x"),
  34.      (1,C #"y"),
  35.      (1,C #"z"),
  36.      (2,C #"å"),
  37.      (2,C #"ä"),
  38.      (2,C #"ö"),
  39.      (2,Blank)]
  40.  
  41. fun tiles l =
  42.     List.foldr (fn ((n,_),m) => n+m) 0 l
  43.  
  44. fun draw_nth n [] b = raise Domain
  45.   | draw_nth n ((m,t)::r) b =
  46.     if n <= m then
  47.         if m = 1 then
  48.             (t,b@r)
  49.         else
  50.             (t,(m-1,t)::r@b)
  51.     else
  52.         draw_nth (n-m) r ((m,t)::b)
  53.  
  54. fun draw_random g _ 0 = (g,[])
  55.   | draw_random g b n =
  56.     let
  57.         val (t,b) = draw_nth (Rand.range (1,tiles b) g) b []
  58.         val (g',r) = draw_random (Rand.random g) b (n-1)
  59.     in
  60.         (g',t::r)
  61.     end
  62.  
  63. fun has c b =
  64.     List.exists (fn (n,b) => c = b andalso n>0) b
  65.  
  66. fun numberOf c b =
  67.     case List.find (fn (_,b) => c = b) b of
  68.         NONE => 0
  69.       | SOME(n,_) => n
  70.  
  71. fun insertBlanks ban (f::r) =
  72.     let
  73.         fun insertBlanks' ban (f::r) =
  74.             if f =* ban then
  75.                 map (fn l => C f::l) (insertBlanks' (f::ban) r)
  76.             else
  77.                 map (fn l => C f::l) (insertBlanks' (f::ban) r)
  78.                 @
  79.                 [Blank::map C r]
  80.           | insertBlanks' _ [] = [[]]
  81.     in
  82.         if f =* ban then
  83.             map (fn l => C f::l) (insertBlanks (f::ban) r)
  84.         else
  85.             map (fn l => C f::l) (insertBlanks (f::ban) r)
  86.             @
  87.             map (fn l => Blank::l) (insertBlanks' ban r)
  88.     end
  89.   | insertBlanks _ [] = [[]]
  90.  
  91. fun tileCompare (C a, C b) = Char.compare(a,b)
  92.   | tileCompare (Blank, C _) = LESS
  93.   | tileCompare (C _, Blank) = GREATER
  94.   | tileCompare _ = EQUAL
  95.  
  96. val uniques = ListMergeSort.uniqueSort tileCompare
  97.  
  98. fun copies_of l e =
  99.     length(List.filter (fn e' => e' = e) l)
  100.  
  101. fun factorial 0 = 1
  102.   | factorial n = n * factorial(n-1)
  103.  
  104. fun draws' t w =
  105.     let
  106.         fun picks e =
  107.             let
  108.                 val a = numberOf e t
  109.                 val b = copies_of w e
  110.             in
  111.                 if b > a then
  112.                     0
  113.                 else
  114.                     let
  115.                         val n = factorial a
  116.                         val m = factorial b
  117.                         val m' = factorial(a - b)
  118.                     in
  119.                         n div (m*m')
  120.                     end
  121.             end
  122.  
  123.         val u = uniques w
  124.         val l = map picks u
  125.     in
  126.         List.foldr (op * ) 1 l
  127.     end
  128.  
  129.  
  130. fun draws w =
  131.     let
  132.         val b = insertBlanks [] (explode w)
  133.         val c = map (fn b => draws' tilebag b) b
  134.     in
  135.         List.foldr (op +) 0 c
  136.     end
  137.  
  138. fun drawable' t w =
  139.     let
  140.         fun picks e =
  141.             let
  142.                 val a = numberOf e t
  143.                 val b = copies_of w e
  144.             in
  145.                 if b > a then
  146.                     0
  147.                 else
  148.                     1
  149.             end
  150.  
  151.         val u = uniques w
  152.         val l = map picks u
  153.     in
  154.         List.foldr (op * ) 1 l
  155.     end
  156.  
  157.  
  158. fun drawable w =
  159.     case
  160.         let
  161.             val b = insertBlanks [] (explode w)
  162.             val c = map (fn b => drawable' tilebag b) b
  163.         in
  164.             List.foldr (op +) 0 c
  165.         end
  166.      of
  167.         0 => false
  168.       | _ => true
  169.  
  170. fun drawable_from cl w =
  171.     let
  172.         fun tile_of #"?" = Blank
  173.           | tile_of c = C c
  174.         val cl' = map tile_of cl
  175.         val cl'' = uniques cl'
  176.         val bag = map (fn t => (copies_of cl' t,t)) cl''
  177.     in
  178.     case
  179.         let
  180.             val b = insertBlanks [] (explode w)
  181.             val c = map (fn b => drawable' bag b) b
  182.         in
  183.             List.foldr (op +) 0 c
  184.         end
  185.      of
  186.         0 => false
  187.       | _ => true      
  188.     end
  189.  
  190. end
clone this paste RAW Paste Data