On 12/20/06, David Tran <email55555 / gmail.com> wrote:
> > Morton Goldberg wrote:
> >
> > Very nice, compact solution. But what programing language is that in
> > the block comment? I don't recognize it.
>
> Thank you. My solution is Ruby and Haskell at the same time.

I went for a Haskell solution as well -- off topic though since I
didn't port it to ruby as well.  Not quite as clever, it uses the dice
rolling method mentioned on the wikipedia page.  Most of the stuff was
just me playing around with the GHC's version of GetOpt.


module Main (main) where
import Control.Monad
import Data.Array
import IO
import List
import System
import System.Console.GetOpt
import System.Random

{-
 - A Simple solution to Rubyquiz 106.  It uses Bodlaender's method,
 - except it generates all possible combinations using the list monad.
 -}

data Piece =
 Bishop | Queen | Knight |
 Rook   | King  | Empty
 deriving(Ord,Eq,Enum)

instance Show Piece where
 show Bishop = "B"
 show Queen  = "Q"
 show Knight = "N"
 show Rook   = "R"
 show King   = "K"
 show Empty  = "."

type Position = Array Int Piece

showPosition :: Position -> String
showPosition      = join . stringify
  where join      = foldl (++) []
        stringify = map show . elems

isEmpty :: Piece -> Bool
isEmpty Empty = True
isEmpty _     = False

build :: [Position]
build = finish perms
 where perms = nub . foldr ($) startPosition $
         reverse [placeB 0, placeB 1, placeX Queen, placeX Knight,
placeX Knight]
       finish ps = map (\p -> fill p $ empties p) ps

startPosition :: [Position]
startPosition = [array (0,7) [(i,Empty) | i <- [0..7]]]

-- Place Bishops either on the odd or even spaces
placeB :: Int -> [Position] -> [Position]
placeB i ss = [ s // [(idx,Bishop)] | s <- ss, idx <- [0..7], idx `mod` 2 == i]

-- Place a piece into any open position
placeX :: Piece -> [Position] -> [Position]
placeX p ss = [ s // [(idx,p)] | s <- ss, idx <- [0..7], isEmpty (s ! idx) ]

-- Search for the indexes of the remaining empty spaces
empties :: Position -> [Int]
empties p = map fst $ filter (isEmpty.snd) $ assocs p

-- The places for the rooks and king are fixed based on the remaining spaces
fill :: Position -> [Int] -> Position
fill p indicies = p // (zip indicies pieces)
  where pieces = [Rook,King,Rook]

data Flag = Random | Nth String | Help | Version deriving (Show, Eq)

flags =
  [ Option ['r']     []       (NoArg Random)    "Select a random starting set"
  , Option ['n']     []       (ReqArg Nth "N")  "Select the Nth permutation"
  , Option ['h','?'] ["help"] (NoArg Help)      "Print this help message"
  , Option ['v']     []       (NoArg Version)   "Print version number"
  ]

usage :: String -> String
usage name = "usage: " ++ name ++ " [-n nth | -r ]"

version :: String
version = "0.1.0"

main :: IO ()
main = do
  argv <- getArgs
  name <- getProgName
  case getOpt Permute flags argv of
    (args,_,[]) -> if Help `elem` args
		      then do hPutStrLn stderr $ usageInfo (usage name) flags
                              exitWith ExitSuccess
                      else showSolutions args
    (_,_,errs)  -> do hPutStrLn stderr $ concat errs ++ usageInfo
(usage name) flags
                      exitWith (ExitFailure 1)

showSolutions :: [Flag] -> IO ()
showSolutions []   = printAll
showSolutions args = case arg of
   Version -> do n <- getProgName
                 putStrLn $ n ++ " Version " ++ version
   Nth n   -> putStrLn . showPosition $ build !! (read n)
   Random  -> do g <- getStdGen
                 let (n,_) = randomR (0,959 :: Int ) g
                 putStrLn . showPosition $ build !! n
   otherwise -> printAll
   where arg = head args

printAll :: IO ()
printAll = putStr . unlines . map showPosition $ build