Hello, I’m new to the forum and I decided to start things off by letting you all throw tomatoes at me!
It’s been quite some time since I last used Haskell and I wanted to get back to it. As an exercise, I decided to solve this problem https://codeforces.com/problemset/problem/1552/F.
The point is not to discuss the actual solution, so here is a link to the Rust playground with a reference implementation which I tried to replicate in Haskell (it’s not quite a solution to the problem mentioned above, but rather a simplification). Here is the Haskell implementation about which I’d like to have a critique.
- Main.hs
module Main (main) where
import Lib
main :: IO ()
main = do
let portals = [(4,1), (5,2), (7,3)]
let len = journeyLength portals
putStrLn $ show len
- Lib.hs
module Lib
( journeyLength
) where
import Data.Array
-- lowest index between `lo` and `hi` of an element not less than `x`
bisect :: (Ix i, Integral i, Ord e) => Array i e -> e -> (i, i) -> i
bisect a x (lo, hi)
| lo == hi = lo
| otherwise = let mid = lo + div (hi - lo) 2 in
if a!mid < x
then bisect a x (mid + 1, hi)
else bisect a x (lo, mid)
-- last element of an array
aLast :: Ix i => Array i e -> e
aLast a = a ! (snd $ bounds a)
journeyLength :: [(Int, Int)] -> Int
journeyLength portals = aLast entrances + 1 + aLast ps
where
entrances = listArray (1, length portals) (map fst portals)
exits = listArray (1, length portals) (map snd portals)
-- partial sums of the return times
ps = array (0, length portals) ((0,0) :
[(i, ps!(i-1) + rt)
| i <- [1..length portals]
-- first portal after the i-th exit
-- `ps!i` is the sum of the return times of the portals `1..i`
, let j = bisect entrances (exits!i) (1, i)
-- return time
, let rt = ps!(i-1) - ps!(j-1) + entrances!i - exits!i])
Some possible questions
- Is my code layout acceptable by common standards?
- Is the indentation and whitespace decent enough?
- Are line breaks where they are supposed to be?
(For instance theif then else
expression inbisect
and the list comprehension injourneyJength
)
- Is my usage of guards in
bisect
fine, or is there a better way to express it? - Is the usage of
let in
inbisect
fine, or should I prefer awhere
clause? - Is there a better way to define
ps
, which is possibly more readable or better in some other regards? - Should I refactor something?
- Is there anything else that catches the eye of an expert?
Basically, I’d like to have the harshest critique possible to see how this simple snippet would have been written more idiomatically by a Haskell guru.
Thanks!