https://www.hackerrank.com/challenges/largest-rectangle/problem

largestRectangle.hs

{-# LANGUAGE RecordWildCards  #-}
{-# LANGUAGE PartialTypeSignatures #-}
import Data.List hiding (subsequences)
import Control.Monad
import Numeric.Natural

data State = State 
  { sStack :: [(Int, Int)]
  , sMax   :: Int 
  }
  deriving (Show)

initial :: State
initial = State [(0,0)] 0

largestRectangle = sMax . last . largestRectangleStates

largestRectangleStates :: [Int] -> [State]
largestRectangleStates =  scanl step initial . zip [0..] . (++ [0])

naiveSolution :: [Int] -> Int
naiveSolution [] = 0
naiveSolution xx = maximum . fmap (\x -> length x * minimum x) . subsequences $ xx

subsequences = init . tails >=> tail . inits

step :: State -> (Int, Int) -> State
step state@State{sStack = (hp,i) : stack, ..} (idx, h) =
  case compare h hp of
    EQ -> state
    GT -> state{sStack = (h, idx) : sStack state}
    LT -> fix i $ step state{sStack = stack , sMax = max sMax (hp * (idx - i)) } (idx,h)

  where
    fix i s@State{sStack = (hp,i'):stack} = s{sStack = (hp,min i' i) : stack}

propCorrect :: [Int] -> Bool
propCorrect ii = largestRectangle ii' == naiveSolution ii'
  where
    ii' = map abs ii