gnome7 fucked around with this message at 22:06 on Mar 1, 2016

import Data.List

subsets []  = [[]]
subsets (x:xs) = subsets xs ++ map (x:) (subsets xs)

outcomes = [1..10]
ilsmall n = take n $ repeat outcomes

allRolls n = nub $ map sort $ sequence $ ilsmall n

nextCombinations [input] =
  let possibles = subsets input
      usefuls   =  filter (\y -> (sum y) > 9) possibles
  in map next usefuls
    where
      next ins = [input \\ ins, ins]
nextCombinations ([]:more) = [more]
nextCombinations (input:more) =
  let possibles = subsets input
      usefuls   =  nub $ map sort $ filter (\y -> (sum y) > 9) possibles
  in map next usefuls
    where
      next ins = [input \\ ins, ins] ++ more

isDone ([]:more) = True
isDone (xs:more) = if (sum xs) < 10
                   then True
                   else False

possibles input = p $ nextCombinations [input]
  where
    p inputs =
      let (answers, works) = partition isDone inputs
      in if works == []
            then answers
            else answers ++ p (concatMap nextCombinations works)

answer input =
  let outputs = sortBy lengthComp $ map (sortBy lengthComp) $ nub $ map sort $ map (map sort) $ map (filter ((/=)[])) $ possibles input
      counts  = map tenCounts outputs
      couts   = zip counts outputs
  in couts

printer [] = do putStrLn ""
                return ()
printer (x:xs) = do putStrLn $ show x
                    printer xs

lengthComp l1 l2 = if l1l > l2l then GT else if l1l == l2l then EQ else LT
  where
    l1l = length l1
    l2l = length l2

tenCounts [] = 0
tenCounts (x:xs) = (if (sum x > 9) then 1 else 0) + tenCounts xs

QuantumNinja fucked around with this message at 05:48 on Mar 2, 2016

    Dim memo As New Dictionary(Of Integer, Integer)

    Private Function GetScore(d As List(Of Integer))
        Dim a As Integer = (2 ^ d.Count) - 1
        Return GetScore(d, a)
    End Function

    Private Function GetScore(d As List(Of Integer), m As Integer)
        If memo.ContainsKey(m) Then Return memo(m)
        Dim sum As Integer
        For dn = 0 To d.Count - 1
            If (m And (2 ^ dn)) > 0 Then sum += d(dn)
        Next
        Dim b As Integer = IIf(sum >= 10, 1, 0)
        For uu = 1 To m - 1
            If (m And uu) = uu Then b = Math.Max(b, GetScore(d, uu) + GetScore(d, m - uu))
        Next
        memo.Add(m, b)
        Return b
    End Function

jmzero fucked around with this message at 06:32 on Mar 2, 2016

QuantumNinja fucked around with this message at 06:11 on Mar 2, 2016

Leperflesh fucked around with this message at 06:13 on Mar 2, 2016

Comrade Gorbash fucked around with this message at 17:33 on Mar 2, 2016

Liquid Communism fucked around with this message at 19:43 on Mar 2, 2016