Haskell Largest String
import Data.Array (Array, bounds, elems, listArray, (!), (//))
largestString :: String -> String
largestString s0 = elems (go (len - 1) arr0 "")
where
len = length s0
arr0 = listArray (0, len - 1) s0 :: Array Int Char
safeAt arr idx
| idx >= 0 && idx <= snd (bounds arr) = Just (arr ! idx)
| otherwise = Nothing
go i arr cur
| i < 0 = arr
| otherwise =
let cur1 = (arr ! i) : cur
in if length cur1 == 3
then
let (arr1, i1) = handleTriplet i arr cur1
i2 = adjustEnd i1 arr1
in go (i2 - 1) arr1 ""
else go (i - 1) arr cur1
handleTriplet i arr cur
| cur == "abb" =
let arr' = arr // [(i, 'b'), (i + 1, 'a'), (i + 2, 'a')]
in (arr', skipIndex i arr')
| otherwise = (arr, i)
skipIndex i arr
| safeAt arr (i + 4) == Just 'b' = i + 4 + 1
| safeAt arr (i + 3) == Just 'b' = i + 3 + 1
| arr ! (i + 2) == 'b' = i + 2 + 1
| otherwise = i
adjustEnd i arr
| safeAt arr (i + 1) == Just 'b' = i + 1 + 1
| otherwise = i + 1
This builds the biggest valid string it can under the challenge rules by always choosing the best next character it is allowed to use.
Haskell Max Counters
import Control.Monad (forM_, when)
import Control.Monad.ST (ST, runST)
import Data.Array.ST (STArray, getElems, newArray, readArray, writeArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef)
maxCounters :: Int -> [Int] -> [Int]
maxCounters n a = runST $ do
counters <- newArray (0, n - 1) 0 :: ST s (STArray s Int Int)
maxRef <- newSTRef 0
lastRef <- newSTRef 0
forM_ a $ \v ->
if v <= n
then do
let idx = v - 1
lastUpdate <- readSTRef lastRef
cur <- readArray counters idx
let cur' = max cur lastUpdate + 1
writeArray counters idx cur'
maxC <- readSTRef maxRef
when (cur' > maxC) (writeSTRef maxRef cur')
else
when (v == n + 1) (readSTRef maxRef >>= writeSTRef lastRef)
lastUpdate <- readSTRef lastRef
finalCounters <- getElems counters
return (map (max lastUpdate) finalCounters)
This delays the expensive “set all counters to max” work until it is really needed, which keeps the solution fast.
Haskell Max Double Slice Sum
import Data.Array (Array, array, listArray, (!))
maxDoubleSliceSum :: [Int] -> Int
maxDoubleSliceSum a
| n < 3 = 0
| otherwise = maximum [p1 ! i + p2 ! i | i <- [1 .. n - 2]]
where
n = length a
arr = listArray (0, n - 1) a :: Array Int Int
-- p1 ! i = best sum of a slice ending just before index i, growing left to right
p1list = scanl (\acc i -> max 0 (acc + arr ! (i - 1))) 0 [2 .. n - 2]
p1 = listArray (1, n - 2) p1list :: Array Int Int
-- p2 ! i = best sum of a slice starting just after index i, growing right to left
p2list = scanl (\acc k -> max 0 (acc + arr ! (k + 1))) 0 [n - 3, n - 4 .. 1]
p2 = array (1, n - 2) (zip [n - 2, n - 3 .. 1] p2list) :: Array Int Int
This keeps the best sum ending on the left and starting on the right, then combines them around each middle position.
Haskell Max Product Of Three
import Data.List (sort)
maxProductOfThree :: [Int] -> Int
maxProductOfThree a =
max (s !! (n - 1) * s !! (n - 2) * s !! (n - 3)) (s !! 0 * s !! 1 * s !! (n - 1))
where
s = sort a
n = length s
This checks the useful extremes, because the best product can come from either the three largest numbers or two negatives plus one large positive.
Haskell Max Profit
maxProfit :: [Int] -> Int
maxProfit a = snd (foldl step (head a, 0) a)
where
step (price, profit) v =
let price' = min price v
in (price', max profit (v - price'))
This tracks the lowest buy price seen so far and updates the best profit as it scans the prices once.
Haskell Max Slice Sum
maxSliceSum :: [Int] -> Int
maxSliceSum a = snd (foldl step (minBound, minBound) a)
where
step (tmp, best) v =
let tmp' = max (tmp + v) v
in (tmp', max best tmp')
This is a Kadane-style scan: keep the best running sum and the best overall sum while moving once through the array.
Haskell Min Avg Two Slice
import Data.Array (Array, listArray, (!))
minAvgTwoSlice :: [Int] -> Int
minAvgTwoSlice a = fst (foldl step (0, avg2 0) [0 .. n - 2])
where
n = length a
arr = listArray (0, n - 1) a :: Array Int Int
avg2 i = fromIntegral (arr ! i + arr ! (i + 1)) / 2 :: Double
avg3 i = fromIntegral (arr ! i + arr ! (i + 1) + arr ! (i + 2)) / 3 :: Double
candidate i
| i + 2 <= n - 1 = min (avg2 i) (avg3 i)
| otherwise = avg2 i
step (bestIdx, bestVal) i =
let cur = candidate i
in if cur < bestVal then (i, cur) else (bestIdx, bestVal)
This leans on the key trick for this problem: the minimum average slice is always length 2 or 3.
Haskell Min Perimeter Rectangle
minPerimeterRectangle :: Int -> Int
minPerimeterRectangle n = go 1 maxBound
where
go i best
| i * i >= n = best
| otherwise = go (i + 1) newBest
where
newBest = if n `mod` i == 0 then min best (2 * (i + n `div` i)) else best
This searches factor pairs up to the square root and picks the pair with the smallest perimeter.
Haskell Missing Integer
import qualified Data.Set as Set
missingInteger :: [Int] -> Int
missingInteger a = go 1 (Set.toAscList (Set.fromList (filter (> 0) a)))
where
go m [] = m
go m (v : vs)
| m /= v = m
| otherwise = go (m + 1) vs
This records the positive numbers that exist, then returns the smallest positive value that is still missing.
Haskell Nesting
nesting :: String -> Int
nesting s
| null s = 1
| otherwise = go s []
where
go [] stack = if null stack then 1 else 0
go (c : cs) stack
| c == ')' = pop cs stack
| otherwise = go cs (c : stack)
pop cs (top : rest)
| top == '(' = go cs rest
pop _ _ = 0
This treats the string like a balance counter: open parentheses add one, closing ones remove one.