HackerRank - Filter huge list for elements that occur more than a given number of times

Question

I'm trying to solve this problem on HackerRank, which basically requires the solution to read an input like this (comments are mine)

3                      # the number of cases, each of which consists of a pair of lines below
9 2                    # case 1, the two numbers are N and K
4 5 2 5 4 3 1 3 4      # case 1, the N numbers; filter out those that occur less than K times
9 4                    # case 2
4 5 2 5 4 3 1 3 4      # case 2
10 2                   # case 3
5 4 3 2 1 1 2 3 4 5    # case 3

and the desired output is

4 5 3
-1
5 4 3 2 1

where the second line signifies that there's no number in case 2 which occurs 4 times or more, first and third lines list those elemnts of cases 1 and 3 which all occur the prescribed number of times or more (in this case the threshold is 2 for both case 1 and case 2).

I came up with an algorithmically correct solution, but apparently it has poor performance, as it fails for timeout on this input (expected output)

import Control.Monad (liftM2)
import Data.List (sort,groupBy)
import Data.List (foldl')
main :: IO()
main = do
  nCasesStr <- getLine
  let nCase = read nCasesStr :: Int
  sequence_ $ replicate nCase $ do
    firstLine <- getLine
    secondLine <- getLine
    let [_,k] = asInts $ firstLine
    let list  = asInts $ secondLine      -- LINE A
    let outList = processList k list
    if null outList
      then putStr $ show (-1)
      else mapM_ (putStr . (++" ") . show) outList -- LINE B
    putStrLn ""
    where
      asInt :: String -> Int
      asInt s = read s :: Int
      asInts :: String -> [Int]
      asInts = map asInt . words

processList :: Int -> [Int] -> [Int]
processList k = map fst . filter ((>= k) . snd) . foldl' step []
  where
    step acc@((n,c):ac) val
      | n == val = (n,c + 1):ac
      | otherwise = (n,c):step ac val
    step _ val = [(val,1)]

I'm especially worried about the lines marked as -- LINE A ad -- LINE B: they both traverse the full long input and output lines respectively; then the processList function traverses the input too. Traversing the input only once while spitting out output, however, would not change the BigO complexity, but just reduce it by a factor of 3, am I right?

As regards the processList function, I'm quite happy I had the idea of using a fold (the three of them don't seem to have a consistent difference in performances, as regards the bulk test cases), but maybe I've chosen the wrong stepping function?

Or maybe folding is not the right tool in this case?

Answer 1

Looks like you already solved it, so good job! :)

I took the liberty to solve the challenge too, so I'll post my code below. I tried to make the code a bit more "functional", or less imperative, if you will: there is less logic in IO. It's also slightly shorter than yours, though that's not really a goal. I also used a number of techniques and library functions that you could have used, but didn't; using them all is not necessarily what you want, but I wanted to showcase them nevertheless.

{-# LANGUAGE LambdaCase #-}
import Control.Monad
import Data.List
import qualified Data.Map.Strict as Map

main :: IO ()
main = do
    let readInts = map read . words <$> getLine
    [numCases] <- readInts
    cases <- sequence $ replicate numCases
                            (processCase <$> fmap (!!1) readInts
                                         <*> readInts)
    forM_ cases $ \case [] -> putStrLn "-1"
                        l  -> putStrLn (intercalate " " (map show l))
  where
    processCase :: Int -> [Int] -> [Int]
    processCase k l =
        let groups = [head g | g <- group (sort l), length g >= k]
            order = foldr (uncurry (Map.insertWith const))
                          mempty (zip l [0::Int ..])
        in sortOn (order Map.!) groups

In my subjective opinion, this is somewhat "cleaner", whatever that may mean. But make your own judgement, and most important is that you solved it. :)

Answer 2

It seems that the suggestion I got in the comment is enough to pass the HR test:

import Data.Maybe (fromJust)
import Data.List (foldl', nub)
import qualified Data.Map as M

main :: IO()
main = do
  nCasesStr <- getLine
  let nCase = read nCasesStr :: Int
  sequence_ $ replicate nCase $ do
    k    <- (str2int. last . words) <$> getLine
    list <-    map str2int . words  <$> getLine
    let outList = processList k list
    if null outList
      then putStr $ show (-1)
      else mapM_ (putStr . (++" ") . show) outList
    putStrLn ""
    where
      str2int = read :: String -> Int

processList :: Int -> [Int] -> [Int]
processList k = nub . (filter <$> (flip (\x -> (k <=) . fromJust . M.lookup x . list2map)) <*> id)
  where
    list2map = foldl' step M.empty
    step map num = M.insertWith (+) num 1 map