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

import Data.Bits (xor)

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

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]

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

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]

import Data.List (sort)

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

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

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

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

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)