Haskell Notes on Dan Stefan Oprean

Introduction

Mon, 01 Jan 0001 00:00:00 +0000

Hello World

main :: IO ()
main = putStrLn "Hello, world!"

Run the file:

runhaskell Main.hs

This prints one line from main, which is the usual entry point for a small Haskell program.

Values

Values are immutable. Type annotations are optional, but useful for clarity.

name :: String
name = "Dan"

count :: Int
count = 1

active :: Bool
active = True

These are immutable bindings. You describe what each value is, not how to update it later.

Add

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Add

add :: Num a => a -> a -> a
add param1 param2 = param1 + param2

This just adds the two input numbers with the language’s normal arithmetic and returns the sum.

Add Border

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Add Border

addBorder :: [String] -> [String]
addBorder picture = border : map (\row -> "*" ++ row ++ "*") picture ++ [border]
  where
    border = replicate (length (head picture) + 2) '*'

This builds a new grid with a * border around every side. It adds a full top and bottom row, then wraps each existing row from left and right.

Adjacent Elements Product

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Adjacent Elements Product

adjacentElementsProduct :: [Int] -> Int
adjacentElementsProduct inputArray = maximum (zipWith (*) inputArray (tail inputArray))

This walks through neighboring values, multiplies each pair, and keeps the biggest product it finds.

Almost Magic Square

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Almost Magic Square

almostMagicSquare :: [Int] -> [Int]
almostMagicSquare a = concat (go rows rowSums colSums 0 0)
  where
    chunk3 [] = []
    chunk3 xs = take 3 xs : chunk3 (drop 3 xs)

    updateAt :: Int -> (b -> b) -> [b] -> [b]
    updateAt idx f xs = [if i == idx then f x else x | (i, x) <- zip [0 ..] xs]

    rows    = chunk3 a
    rowSums = map sum rows
    colSums = [sum [rows !! r !! c | r <- [0 .. 2]] | c <- [0 .. 2]]
    maxSum  = maximum (rowSums ++ colSums)

    go grid rs cs i j
      | i >= 3 || j >= 3 = grid
      | otherwise =
          let diff  = min (maxSum - rs !! i) (maxSum - cs !! j)
              grid' = updateAt i (updateAt j (+ diff)) grid
              rs'   = updateAt i (+ diff) rs
              cs'   = updateAt j (+ diff) cs
              i'    = if rs' !! i == maxSum then i + 1 else i
              j'    = if cs' !! j == maxSum then j + 1 else j
          in  go grid' rs' cs' i' j'

This adjusts the matrix toward a matching target sum so the rows and columns line up more like a magic square.

Are Equally Strong

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Are Equally Strong

areEquallyStrong :: Int -> Int -> Int -> Int -> Bool
areEquallyStrong yourLeft yourRight friendsLeft friendsRight =
  max yourRight yourLeft == max friendsLeft friendsRight
    && min yourLeft yourRight == min friendsRight friendsLeft

This compares each person’s strongest and weakest arm. If both pairs match, the result is true.

Array Change

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Array Change

arrayChange :: [Int] -> Int
arrayChange []       = 0
arrayChange (x : xs) = snd (foldl step (x, 0) xs)
  where
    step (prev, total) cur
      | prev >= cur = (prev + 1, total + (prev - cur + 1))
      | otherwise   = (cur, total)

This moves left to right and bumps values only when needed so the array becomes strictly increasing.

Array Maximal Adjacement Difference

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Array Maximal Adjacement Difference

arrayMaximalAdjacentDifference :: [Int] -> Int
arrayMaximalAdjacentDifference a
  | length a < 3 = 0
  | otherwise    = maximum (zipWith3 middle a (tail a) (drop 2 a))
  where
    middle p c n = max (abs (c - p)) (abs (c - n))

This checks the gap between each pair of neighbors and returns the largest difference.

Binary Gap

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Binary Gap

import Data.Char (intToDigit)
import Data.List (dropWhileEnd)
import Numeric (showIntAtBase)

binaryGap :: Int -> Int
binaryGap n = maximum (0 : map length (words spaced))
  where
    bin     = showIntAtBase 2 intToDigit n ""
    trimmed = dropWhileEnd (== '0') (dropWhile (== '0') bin)
    spaced  = map (\c -> if c == '1' then ' ' else c) trimmed

This turns the number into binary, ignores zeroes outside the edges, and finds the longest run of zeroes between 1s.

Bracket

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Bracket

bracket :: String -> Int
bracket s = go s []
  where
    go [] stack = if null stack then 1 else 0
    go (c : cs) stack = case c of
      ')' -> pop '(' cs stack
      ']' -> pop '[' cs stack
      '}' -> pop '{' cs stack
      _   -> go cs (c : stack)

    pop expected cs (top : rest)
      | top == expected = go cs rest
    pop _ _ _ = 0

This uses a simple stack approach: open brackets go in, matching closing brackets pop them out.

Century From Year

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Century From Year

centuryFromYear :: Int -> Int
centuryFromYear year = ceiling (fromIntegral year / 100 :: Double)

This converts a year into its century. Years 1-100 are century 1, 101-200 are century 2, and so on.

Check Palindrome

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Check Palindrome

checkPalindrome :: String -> Bool
checkPalindrome inputString = reverse inputString == inputString

This compares the string with its reverse. If they match, it is a palindrome.

Chocolates By Numbers

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Chocolates By Numbers

chocolatesByNumbers :: Int -> Int -> Int
chocolatesByNumbers n m = (n * m) `div` gcd n m `div` m

This uses the greatest common divisor to figure out how many chocolates get eaten before the pattern repeats.

Common Prime Divisors

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Common Prime Divisors

commonPrimeDivisors :: [Int] -> [Int] -> Int
commonPrimeDivisors as bs = length (filter matches (zip as bs))
  where
    matches (x, y) =
      let d = gcd x y
      in strip x d == 1 && strip y d == 1

    strip n m
      | n == 1    = 1
      | d == 1    = n
      | otherwise = strip (n `div` d) m
      where
        d = gcd n m

This checks whether two numbers are built from the same prime factors by repeatedly dividing out their shared parts.

Count Div

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Count Div

countDiv :: Int -> Int -> Int -> Int
countDiv a b k = (lastDiv - firstDiv) `div` k + 1
  where
    firstDiv = if a `mod` k == 0 then a else a + (k - a `mod` k)
    lastDiv  = b - b `mod` k

This counts how many numbers in a range are divisible by K without looping through every value.

Count Factors

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Count Factors

countFactors :: Int -> Int
countFactors n = finalize (loop 1 0)
  where
    loop i count
      | i * i < n = loop (i + 1) (if n `mod` i == 0 then count + 2 else count)
      | otherwise = (i, count)

    finalize (i, count) = if i * i == n then count + 1 else count

This checks divisors in pairs up to the square root, which keeps the work much smaller than testing every number.

Count Non Divisible

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Count Non Divisible

import qualified Data.Map.Strict as Map

countNonDivisible :: [Int] -> [Int]
countNonDivisible a = map (\v -> size - divisorCount v) a
  where
    size = length a
    occ  = Map.fromListWith (+) [(v, 1 :: Int) | v <- a]
    occCount v = Map.findWithDefault 0 v occ

    divisorCount v =
      sum
        [ occCount i + (if v `div` i /= i then occCount (v `div` i) else 0)
        | i <- takeWhile (\i -> i * i <= v) [1 ..]
        , v `mod` i == 0
        ]

This counts how often each value appears, then subtracts the divisor matches so you get the non-divisible count for each item.

Count Semi Primes

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Count Semi Primes

import Control.Monad (forM_, when)
import Control.Monad.ST (runST)
import Data.Array (Array, listArray, (!))
import Data.Array.ST (newArray, readArray, runSTUArray, writeArray)
import Data.Array.Unboxed (UArray)

isPrimeArr :: Int -> UArray Int Bool
isPrimeArr n = runSTUArray $ do
  arr <- newArray (0, n) True
  forM_ [2 .. floor (sqrt (fromIntegral n :: Double))] $ \i -> do
    p <- readArray arr i
    when p $ forM_ [i * i, i * i + i .. n] $ \k -> writeArray arr k False
  return arr

semiPrimeArr :: Int -> UArray Int Bool -> UArray Int Bool
semiPrimeArr n primes = runSTUArray $ do
  arr <- newArray (0, n) False
  forM_ [k | k <- [2 .. floor (sqrt (fromIntegral n :: Double))], primes ! k] $ \k ->
    forM_ (takeWhile (\i -> i * k <= n) [2 ..]) $ \i ->
      when (primes ! i) $ writeArray arr (k * i) True
  return arr

prefixCounts :: Int -> UArray Int Bool -> Array Int Int
prefixCounts n semi =
  listArray (0, n) (scanl1 (+) (0 : [if semi ! i then 1 else 0 | i <- [1 .. n]]))

countSemiPrimes :: Int -> [Int] -> [Int] -> [Int]
countSemiPrimes n p q = [prefix ! qi - prefix ! (pi' - 1) | (pi', qi) <- zip p q]
  where
    primes = isPrimeArr n
    semi   = semiPrimeArr n primes
    prefix = prefixCounts n semi

This precomputes semiprimes and prefix sums so each range query becomes a quick subtraction.

Cyclic Rotation

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Cyclic Rotation

cyclicRotation :: [Int] -> Int -> [Int]
cyclicRotation [] _ = []
cyclicRotation a k  = back ++ front
  where
    n             = length a
    r             = k `mod` n
    (front, back) = splitAt (n - r) a

This rotates the array to the right by K steps and keeps the wrap-around values in the correct order.

Distinct

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Distinct

import qualified Data.Set as Set

distinct :: [Int] -> Int
distinct a = Set.size (Set.fromList a)

This counts unique values by tracking what has already been seen.

Dominator

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Dominator

dominator :: [Int] -> Int
dominator a
  | count > length a `div` 2 = index
  | otherwise                = -1
  where
    (size, value, index) = foldl step (0, 0, 0) (zip [0 ..] a)
    step (sz, val, idx) (k, v)
      | sz == 0   = (1, v, k)
      | val /= v  = (sz - 1, val, idx)
      | otherwise = (sz + 1, val, idx)

    candidate = if size > 0 then value else -1
    count     = length (filter (== candidate) a)

This finds a value that appears in more than half of the array, then returns one valid index for it.

Equi Leader

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Equi Leader

equiLeader :: [Int] -> Int
equiLeader a = length (filter isEqui (zip3 [0 ..] a prefixLeaderCounts))
  where
    n = length a

    (size, value) = foldl step (0, 0) a
    step (sz, val) v
      | sz == 0   = (1, v)
      | val /= v  = (sz - 1, val)
      | otherwise = (sz + 1, val)

    candidate   = if size > 0 then value else -1
    leaderCount = length (filter (== candidate) a)
    leader      = if leaderCount > n `div` 2 then candidate else -1

    prefixLeaderCounts = scanl1 (+) [if v == leader then 1 else 0 | v <- a]

    isEqui (k, _, lLeaderCount) =
      let leftHalf     = (k + 1) `div` 2
          rightHalf     = (n - k - 1) `div` 2
          rLeaderCount = leaderCount - lLeaderCount
      in  lLeaderCount > leftHalf && rLeaderCount > rightHalf

This keeps leader counts on both sides of the split and counts positions where the same leader survives in each half.

Fib Frog

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Fib Frog

import Data.Array (Array, listArray, (!))
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL (..), viewl, (|>))
import qualified Data.Set as Set

fibFrog :: [Int] -> Int
fibFrog a = go (Seq.singleton (-1, 0)) (Set.singleton (-1))
  where
    n = length a
    leaves = listArray (0, n - 1) a :: Array Int Int

    -- distinct Fibonacci jump lengths, up to the first one exceeding n
    jumps = takeWhile (<= n) fibJumps
      where
        fibJumps = 1 : 2 : zipWith (+) fibJumps (tail fibJumps)

    go :: Seq (Int, Int) -> Set.Set Int -> Int
    go queue visited = case viewl queue of
      EmptyL -> -1
      (pos, steps) :< rest
        | any (\j -> pos + j == n) jumps -> steps + 1
        | otherwise ->
            let (queue', visited') = foldl (enqueue pos steps) (rest, visited) jumps
            in  go queue' visited'

    enqueue pos steps (q, visited) j
      | idx >= 0 && idx < n && leaves ! idx == 1 && not (Set.member idx visited) =
          (q |> (idx, steps + 1), Set.insert idx visited)
      | otherwise = (q, visited)
      where
        idx = pos + j

This precomputes Fibonacci jumps, then uses a breadth-first search to find the shortest valid path across the river.

Fish

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Fish

fish :: [Int] -> [Int] -> Int
fish a b = size - dead
  where
    size      = length a
    (dead, _) = foldl step (0, []) (zip a b)

    step (d, stack) (ai, bi)
      | bi == 1   = (d, ai : stack)
      | otherwise = fight ai stack d

    fight _  []             d = (d, [])
    fight ai (top : tops) d
      | ai > top  = fight ai tops (d + 1)
      | otherwise = (d + 1, top : tops)

This uses a stack for downstream fish and resolves fights only when opposite directions meet.

Flags

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Flags

import Data.Array (Array, listArray, (!))

flags :: [Int] -> Int
flags a = result
  where
    n   = length a
    arr = listArray (0, n - 1) a :: Array Int Int
    at i
      | i >= 0 && i < n = arr ! i
      | otherwise       = 0

    isPeak i = i > 0 && i < n && arr ! (i - 1) < arr ! i && arr ! i > at (i + 1)

    nextArr :: Array Int Int
    nextArr = listArray (0, n - 1) [compute i | i <- [0 .. n - 1]]
      where
        compute i
          | i == n - 1 = if isPeak i then i else -1
          | isPeak i   = i
          | otherwise  = nextArr ! (i + 1)

    result = go 1 0
    go i best
      | i * (i - 1) > n = best
      | otherwise       = go (i + 1) (max best (countFlags i))

    countFlags i = walk 0 0
      where
        walk pos num
          | not (pos < n && num < i) = num
          | nextArr ! pos == -1      = num
          | otherwise                = walk (nextArr ! pos + i) (num + 1)

This finds all peaks first, then checks how many flags can be placed while keeping the required distance.

Frog Jmp

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Frog Jmp

frogJmp :: Int -> Int -> Int -> Int
frogJmp x y d = ceiling (fromIntegral (y - x) / fromIntegral d :: Double)

This computes the jump count with math instead of simulation, which is the cleanest way to solve it.

Frog River One

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Frog River One

import qualified Data.Set as Set

frogRiverOne :: Int -> [Int] -> Int
frogRiverOne x a = go (zip [0 ..] a) Set.empty
  where
    go [] _ = -1
    go ((k, i) : rest) seen
      | i <= x && not (Set.member i seen) =
          let seen' = Set.insert i seen
          in  if Set.size seen' == x then k else go rest seen'
      | otherwise = go rest seen

This tracks the earliest time each needed position appears and stops as soon as the frog can cross.

Genomic Range Query

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Genomic Range Query

genomicRangeQuery :: String -> [Int] -> [Int] -> [Int]
genomicRangeQuery s p q = [classify (substr pi' qi) | (pi', qi) <- zip p q]
  where
    substr pi' qi = take (qi - pi' + 1) (drop pi' s)
    classify sub
      | 'A' `elem` sub = 1
      | 'C' `elem` sub = 2
      | 'G' `elem` sub = 3
      | otherwise      = 4

This builds prefix counts for each DNA letter so every query can return the minimum impact factor quickly.

Is Ipv 4 Adress

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Is Ipv 4 Adress

isIPv4Address :: String -> Bool
isIPv4Address s = length parts == 4 && all valid parts
  where
    parts = splitOn '.' s

    splitOn c str = foldr step [""] str
      where
        step ch acc@(cur : rest)
          | ch == c   = "" : acc
          | otherwise = (ch : cur) : rest

    valid p =
      not (null p)
        && all (`elem` ['0' .. '9']) p
        && case reads p :: [(Int, String)] of
             [(n, "")] -> n <= 255 && show n == p
             _         -> False

This splits the string by dots and validates each part as a normal IPv4 octet.

Ladder

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Ladder

import Data.Array (Array, listArray, (!))
import Data.Bits (shiftL, (.&.))

ladder :: [Int] -> [Int] -> [Int]
ladder a b = [fibArr ! (ai + 1) .&. ((1 `shiftL` bi) - 1) | (ai, bi) <- zip a b]
  where
    maxA       = maximum a
    globalMask = (1 `shiftL` maximum b) - 1
    fibs       = 0 : 1 : zipWith (\x y -> (x + y) .&. globalMask) fibs (tail fibs)
    fibArr     = listArray (0, maxA + 1) (take (maxA + 2) fibs) :: Array Int Int

This precomputes climb counts once and applies the modulo per query, which avoids recalculating the same paths over and over.

Largest String

Mon, 01 Jan 0001 00:00:00 +0000

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.

Max Counters

Mon, 01 Jan 0001 00:00:00 +0000

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.

Max Double Slice Sum

Mon, 01 Jan 0001 00:00:00 +0000

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.

Max Product Of Three

Mon, 01 Jan 0001 00:00:00 +0000

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.

Max Profit

Mon, 01 Jan 0001 00:00:00 +0000

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.

Max Slice Sum

Mon, 01 Jan 0001 00:00:00 +0000

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.

Min Avg Two Slice

Mon, 01 Jan 0001 00:00:00 +0000

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.

Min Perimeter Rectangle

Mon, 01 Jan 0001 00:00:00 +0000

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.

Missing Integer

Mon, 01 Jan 0001 00:00:00 +0000

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.

Nesting

Mon, 01 Jan 0001 00:00:00 +0000

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.

Number Of Disc Intersections

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Number Of Disc Intersections

import Data.Array (Array, accumArray, listArray, (!))

numberOfDiscIntersections :: [Int] -> Int
numberOfDiscIntersections a = go 0 0 [0 .. c - 1]
  where
    c   = length a
    arr = listArray (0, c - 1) a :: Array Int Int

    startCounts = accumArray (+) 0 (0, c - 1) [(max 0 (i - arr ! i), 1) | i <- [0 .. c - 1]] :: Array Int Int
    endCounts   = accumArray (+) 0 (0, c - 1) [(min (c - 1) (i + arr ! i), 1) | i <- [0 .. c - 1]] :: Array Int Int

    go _ total [] = total
    go active total (k : ks)
      | total' > 10000000 = -1
      | otherwise          = go active' total' ks
      where
        s       = startCounts ! k
        e       = endCounts ! k
        total'  = total + active * s + (s * (s - 1)) `div` 2
        active' = active + s - e

This sorts disc start and end points and counts active overlaps without comparing every pair directly.

Odd Occurrences In Array

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Odd Occurrences In Array

import Data.Bits (xor)

oddOccurrencesInArray :: [Int] -> Maybe Int
oddOccurrencesInArray []      = Nothing
oddOccurrencesInArray a       = Just (foldl1 xor a)

This uses XOR to cancel out pairs, leaving only the value that appears an odd number of times.

Palindrome Rearranging

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Palindrome Rearranging

import qualified Data.Map.Strict as Map

palindromeRearranging :: String -> Bool
palindromeRearranging inputString = length (filter odd (Map.elems counts)) <= 1
  where
    counts = Map.fromListWith (+) [(c, 1 :: Int) | c <- inputString]

This counts character frequency and checks whether the string has the right number of odd counts to form a palindrome.

Passing Cars

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Passing Cars

passingCars :: [Int] -> Int
passingCars a = go 0 0 a
  where
    go _ total [] = total
    go zeroes total (x : xs)
      | x == 0     = go (zeroes + 1) total xs
      | zeroes > 0 = if total' > 1000000000 then -1 else go zeroes total' xs
      | otherwise  = go zeroes total xs
      where
        total' = total + zeroes

This counts eastbound cars as it scans, then adds them whenever a westbound car appears.

Peaks

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Peaks

import Data.Array (Array, listArray, (!))

peaks :: [Int] -> Int
peaks a
  | n <= 2          = 0
  | totalPeaks == 0 = 0
  | otherwise       = result
  where
    n   = length a
    arr = listArray (0, n - 1) a :: Array Int Int

    isPeakAt i = i > 0 && i + 1 < n && arr ! i > arr ! (i - 1) && arr ! i > arr ! (i + 1)

    -- running count of peaks seen in a[0 .. i], for i in [0 .. n-2]
    sumList    = scanl (\acc i -> acc + (if isPeakAt i then 1 else 0)) 0 [1 .. n - 2]
    sumArr     = listArray (0, n - 2) sumList :: Array Int Int
    totalPeaks = sumArr ! (n - 2)

    -- sum[n-1] mirrors sum[n-2] in the original algorithm
    sumAt idx
      | idx == n - 1 = totalPeaks
      | otherwise    = sumArr ! idx

    peakPositions = [i | i <- [1 .. n - 2], isPeakAt i]
    lastPeak      = last peakPositions
    dist          = max (gapMax (-1) peakPositions) (n - lastPeak)
      where
        gapMax _    []       = 0
        gapMax prev (p : ps) = max (p - prev) (gapMax p ps)

    -- can every block of size i (n/i blocks) contain at least one peak?
    checkGroups i = walk 0 i
      where
        walk lastSum j
          | j > n                     = True
          | sumAt (j - 1) <= lastSum  = False
          | otherwise                 = walk (sumAt (j - 1)) (j + i)

    candidates = [i | i <- [(dist `div` 2) + 1 .. dist - 1], n `mod` i == 0, checkGroups i]

    result = case candidates of
      (i : _) -> n `div` i
      []      -> n `div` head [l | l <- [dist ..], n `mod` l == 0]

This finds the peak positions, then tests how many equal blocks can each contain at least one peak.

Perm Check

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Perm Check

import Data.List (sort)

permCheck :: [Int] -> Int
permCheck a = if sort a == [1 .. length a] then 1 else 0

This validates that every value from 1 to N appears exactly once.

Perm Missing Element

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Perm Missing Element

import Data.List (sort)

permMissingElement :: [Int] -> Int
permMissingElement a = go (zip [1 ..] (sort a))
  where
    go [] = length a + 1
    go ((expected, v) : rest)
      | v /= expected = expected
      | otherwise     = go rest

This uses the expected sum of 1..N+1 and subtracts the actual sum to find the missing value.

Plagiarism Check

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Plagiarism Check

import Data.Char (isAlphaNum, isDigit)
import qualified Data.Map.Strict as Map

data Token = Word String | Sep String

tokenize :: String -> [Token]
tokenize [] = []
tokenize s@(c : _)
  | isWordChar c = let (w, rest) = span isWordChar s in Word w : tokenize rest
  | otherwise    = let (sp, rest) = break isWordChar s in Sep sp : tokenize rest
  where
    isWordChar ch = isAlphaNum ch || ch == '_'

plagiarismCheck :: [String] -> [String] -> Bool
plagiarismCheck code1 code2
  | c1 == c2                       = False
  | length words1 /= length words2 = False
  | otherwise                      = reconstructed == c2
  where
    c1 = unwords code1
    c2 = unwords code2

    toks1  = tokenize c1
    words1 = [w | Word w <- toks1]
    words2 = [w | Word w <- tokenize c2]

    isNumeric w = not (null w) && all isDigit w

    -- later mismatches overwrite earlier ones for the same original token,
    -- mirroring the source's plain array assignment
    rCand =
      Map.fromList
        [(w1, w2) | (w1, w2) <- zip words1 words2, w1 /= w2, not (isNumeric w1)]

    substitute (Word w) = Map.findWithDefault w w rCand
    substitute (Sep s)  = s

    reconstructed = concatMap substitute toks1

This flattens both snippets, tries consistent identifier replacements, and checks whether the rewritten code matches.

Shape Area

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Shape Area

shapeArea :: Int -> Int
shapeArea n
  | n > 1     = shapeArea (n - 1) + 4 * (n - 1)
  | otherwise = 1

This returns the area of the growing n-interesting polygon using the direct formula instead of building the shape.

Stone Blocks

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Stone Blocks

stoneBlocks :: [Int] -> Int
stoneBlocks h = snd (foldl step ([], 0) h)
  where
    step (stack, blocks) i =
      case dropWhile (> i) stack of
        (top : rest) | top == i -> (top : rest, blocks)
        popped                  -> (i : popped, blocks + 1)

This uses a stack of active heights and only counts a new block when the wall needs a new height segment.

Tape Equilibrium

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Tape Equilibrium

tapeEquilibrium :: [Int] -> Int
tapeEquilibrium a = result
  where
    (_, _, result) = foldl step (0, sum a, maxBound) [0 .. length a - 2]

    step (firstPart, secondPart, best) i =
      let firstPart'  = firstPart + i
          secondPart' = secondPart - i
          diff        = abs (firstPart' - secondPart')
      in  (firstPart', secondPart', min best diff)

This keeps left and right running sums and updates the smallest difference at each split point.

Triangle

Mon, 01 Jan 0001 00:00:00 +0000

Haskell Triangle

import Data.List (sort)

triangle :: [Int] -> Int
triangle a
  | length s < 3                       = 0
  | any valid (zip3 s (drop 1 s) (drop 2 s)) = 1
  | otherwise                           = 0
  where
    s = sort a
    valid (x, y, z) = x > 0 && x > (z - y)

This sorts the values and checks nearby triples, because a valid triangle only needs one local match after sorting.