doublesquares.hs

numSquares' n x y acc
    | x > y          = acc
    | x*x + y*y > n  = numSquares' n x (y-1) acc
    | x*x + y*y == n = numSquares' n (x+1) (y-1) (acc+1)
    | otherwise      = numSquares' n (x+1) y acc

numSquares n = numSquares' n 0 (floor . sqrt . fromIntegral $ n) 0

main = interact $ unlines . map (show . numSquares . read) . tail . lines
    

peggame.hs

import Data.List
import Data.List.Split
import Data.Array
import Text.Printf

type PegRow = [Bool]
type PegBoard = [PegRow]

buildBoard :: Int -> Int -> [(Int, Int)] -> PegBoard
buildBoard rows cols rms =
    -- Convert 2D array to a nested list of bools
    splitEvery width . elems
    -- remove missing pegs
    . (// map (\(r, c) -> ((r, if even r then 2*c-1 else 2*c), False)) rms)
    -- generate fully pegged board
    $ listArray ((0,0), (rows - 1, width - 1)) (cycle [False, True])
    where width = 2 * cols - 3

chunk3 :: [a] -> [(a,a,a)]
chunk3 xs = zip3 xs (drop 1 xs) (drop 2 xs)

solveRow :: [Double] -> PegRow -> [Double]
solveRow probs row =
    zipWith (\(peg1, peg2, peg3) (pr1, pr2, pr3) -> 
                  (if peg1 then 0.5 * pr1 else 0)
                + (if peg2 then 0 else pr2)
                + (if peg3 then 0.5 * pr3 else 0))
        (chunk3 (False:row++[False])) (chunk3 (0:probs''++[0]))
    -- terrible hack with awful performance
    where probs'  = if head row then 2 * (head probs) : tail probs else probs
          probs'' = if last row
                    then take (length probs' - 1) probs' ++ [2 * last probs']
                    else probs'

unintersperse :: [a] -> [a]
unintersperse xs = [x | (i, x) <- zip [0..] xs, even i]

solveBoard :: PegBoard -> [Double] -> [Double]
solveBoard board input =
    unintersperse $ foldl solveRow (intersperse 0 input) board

allSolves :: Int -> PegBoard -> [[Double]]
allSolves cols board =
    take (cols-1) $ map (solveBoard board) (iterate (0:) (1:repeat 0))

bestSolve :: Int -> [[Double]] -> (Int, Double)
bestSolve target solves =
    maximumBy (\x y -> snd x `compare` snd y)
    . zip [0..] $ map (!! target) solves

readTuples :: [Int] -> [(Int, Int)]
readTuples (x1:x2:xs) = (x1,x2):readTuples xs
readTuples _ = []

solveTestCase :: String -> String
solveTestCase line =
    let nums = map read (words line)
        solution = bestSolve (nums !! 2) . allSolves (nums !! 1)
            $ buildBoard (nums !! 0) (nums !! 1) (readTuples (drop 4 nums))
    in show (fst solution) ++ printf " %.6f" (snd solution)

main = interact $ unlines . map solveTestCase . filter (""/=) . tail . lines

studiosstudent.hs

import Data.List

lowlex = concat . (sortBy (\x y -> (x++y) `compare` (y++x))) . tail . words

main = interact $ unlines . map lowlex . tail . lines