Showing posts with label combinatorics. Show all posts
Showing posts with label combinatorics. Show all posts

Tuesday, July 31, 2012

dart outs

For those who like to play X01 Games.
Update: with an unexpected application to Project Euler #109!
import Control.Applicative (liftA2)
import Data.List (sort, nub, sortBy, maximum)
import Data.Ord (comparing)
import System.Environment (getArgs)
  
data Dart n = Single n | Double n | Triple n | Bull | None deriving Show
  
main = mapM_ print . out . read . head =<< getArgs
  
out n = check . sort' . map (map dart) $ sortBy (comparing maximum) sums
 where
  check ns = if null ns then [None] else head ns
  sort'    = sortBy (comparing $ sum . map ease)
  sums     = nub $ filter ((== n) . sum) combos
  
---------------------------------------------------------------------------
  
combos = concat $ zipWith combosOf [1..3] $ repeat segments
  
segments = concat $ replicate 3 $ sort $ 50 : liftA2 (*) [1..3] [1..20]
   
dart n
  | n == 50    = Bull
  | n `elem` s = Single n
  | n `elem` d = Double (n `div` 2)
  | n `elem` t = Triple (n `div` 3)
 where
  [s,d,t] = liftA2 (map . (*)) [1..3] [[1..20]]
                  
ease (Single _) = 1
ease (Bull)     = 2
ease (Double _) = 3
ease (Triple _) = 4
                   
combosOf 0 _      = [[]]
combosOf _ []     = []
combosOf k (x:xs) = map (x:) (combosOf (k-1) xs) ++ combosOf k xs