Ad
...
{-# OPTIONS_GHC -O1 #-}
module LongestPath (longestPath) where
{-
import Data.Vector.Unboxed as Vector (fromList,(!),(!?))
import Data.List (maximumBy,elemIndex)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Function (on)
import Data.Ord (Down(Down))

memo :: (Enum a) => (a -> b) -> (a -> b)
memo fn = (map fn [ toEnum 0 .. ] !!) . fromEnum

longestPath :: String -> String
longestPath s = maximumBy order $ ("" :) $ zipWith ( \ i c -> if c == '\n' then "" else getLongestPath i ) [0..] s where
  width = fromMaybe (length s) $ elemIndex '\n' s
  order = (compare `on` length) <> (compare `on` Down)
  v = fromList s
  getLongestPath = memo $ \ i ->
    v ! i : (maximumBy order $ ("" :)
                             $ map getLongestPath
                             $ filter ( \ j -> Just (v ! i) < v !? j )
                             $ [ i-width-2, i-width-1, i-width
                               , i-1                 , i+1
                               , i+width  , i+width+1, i+width+2
                               ]
            )

 -}

import           Control.Monad
import           Data.Function   ((&))
import           Data.Ix         (inRange)
import           Data.List.Split (chunksOf)
import           Data.Maybe
import           Data.Vector     (Vector)
import qualified Data.Vector     as V


minimumOn :: (Ord b) => (a -> b) -> [a] -> a
minimumOn f [] = error "Data.List.Extra.minimumOn: empty list"
minimumOn f (x:xs) = g x (f x) xs
    where
        g v mv [] = v
        g v mv (x:xs) | mx < mv = g x mx xs
                      | otherwise = g v mv xs
            where mx = f x

longestPath :: String -> String
longestPath = solve . lines

maximumCell :: [(Int, [Char])] -> (Int, [Char])
maximumCell = minimumOn (\(n, s) -> (-n, s))

solve :: [[Char]] -> [Char]
solve input = knot & V.toList & V.concat & V.toList & maximumCell & snd
 where
  grid   = V.fromList $ V.fromList <$> input
  height = length input
  width  = length (head input)
  knot   = V.fromList $ do
    row <- [0 .. height - 1]
    pure $ V.fromList $ seqLenAt grid knot row <$> [0 .. width - 1]

around :: [(Int, Int)]
around = (,) <$> [-1 .. 1] <*> [-1 .. 1] & filter (/= (0, 0))

seqLenAt
  :: Vector (Vector Char)
  -> Vector (Vector (Int, [Char]))
  -> Int
  -> Int
  -> (Int, [Char])
seqLenAt grid knot row col = maximumCell candidates
 where
  hereCh     = (grid V.! row) V.! col
  candidates = (1, [hereCh]) : do
    (dx, dy) <- around
    let (ty, tx) = (row + dy, col + dx)
    thereCh <- maybeToList $ (V.!? ty) >=> (V.!? tx) $ grid
    guard $ hereCh < thereCh
    let (n, s) = (knot V.! ty) V.! tx
    pure (n + 1, hereCh : s)