Advent of Code #4 in Haskell - Ascending digits with double digit

Question

This problem is from Advent of Code day 4 (part 1). The problem is to find the number of ints in the given range satisfying:

• all digits are non decreasing
• there is at least one group of at least two equal digits in a row

combinations only generates non-decreasing sequences; for example:

λ> combinations 2 ['1'..'3']
["11","12","13","22","23","33"]   

The algorithm generates all non-decreasing combinations from ['0'..'9'], then checks that there's at least one repeating character, that there are no leading zeros, and that the number is in range. Running it with the input 125730-579381 correctly prints 2081.

The main things I want to know about are whether there's a way to improve the algorithm, and whether the readability is good.

import Data.List (tails, group)
import Control.Arrow
import Control.Monad

-- all non-decreasing combinations of k from xs
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations k xs = do
  xs'@(x:_) <- tails xs
  map (x:) $ combinations (pred k) xs'

-- return True iff all predicates are satisfied
allF :: [a -> Bool] -> a -> Bool
allF fs x = and $ map ($ x) fs

-- all ints within the range satisfying:
  -- strictly increasing digits
  -- at least one sequence of exactly 2 of the same digit
solve :: Int -> Int -> Int
solve low hi = length . takeWhile (<= hi) . dropWhile (< low) . map read .
  filter (allF [hasDouble, noLeadingZeros]) $ combinations 6 ['0'..'9']
  where hasDouble = any ((> 1) . length) . group
        noLeadingZeros = (/= '0') . head

main :: IO ()
main = do
  (low, high) <- join (***) read <$> second tail <$> span (/= '-') <$> getLine
  print $ solve low high

Answer 1

Disclaimer: I don't know Haskell and I have never used it before.

solve low hi = length . takeWhile (<= hi) . dropWhile (< low) . map read .
  filter (allF [hasDouble, noLeadingZeros]) $ combinations 6 ['0'..'9']
  where hasDouble = any ((== 2) . length) . group
        noLeadingZeros = (/= '0') . head

Instead of running combinations 6 ['0'..'9'] and then chopping off everything which has a zero at the start, generate numbers from 100000..999999 and then convert it to a string. This would eliminate the combinations method.

I was able to make the following conclusions about the algorithm:

• if the numbers are sorted from smallest to largest, then it should equal the original number (i.e. they are already sorted from smallest to greatest)

• if the numbers with no duplicates does not equal the original number, then it means that there is at least two which were "de-duped", therefore it has two duplicates

I was able to produce the following code:

import Data.List

checkNum num = do return ((sort(show num) == (show num) && (nub (show num)) /= (show num)))
main = do checkNum 4222211

This checks if the sorted number (as a string) is equal to itself (which means that it is increasing correctly), and nub removes all duplicate digits.

Answer 2

I would take the show(Int->[Char]) shortcut instead of going the zero-prefixing read([Char]->Int) roundabout:

count[from,to]=
 sum[1|
  i<-[from..to],
  let s=show i,
  any(==2)[length g|g<-group s],
  s==sort s]

Or a little more efficiently assembled:

sorted [a, b] = a <= b
sorted (a:b:c) = sorted [a, b] && sorted (b: c)
sorted _ = True
duplicate s = [ ] < [2 | [_,_] <- group s]
good s = sorted s && duplicate s
count [min, max] = sum [1 | i <- [min..max], good(show i)]

Or single-scanned:

good (pair, span, max, rest) = 
   if rest == 0 then pair || span == 2 else
    let (q, r) = quotRem rest 10
     in case compare r max of
      GT -> False
      EQ -> good (pair, span + 1, r, q)
      LT -> good (pair || span == 2, 1, r, q)
count min max =
 sum [1 | i <- [min..max], good(False, 0, 9, i)]

When referencing the original codeadvent instead of the codereview specification, this diverts to a calculation of 4795 feasible passwords in one million combinations:

import Data.List
main=print$sum[1|i<-[1000000..1999999],s<-[tail.show$i],s/=nub s,s==sort s]

Try it online!

If 000000 and its likes are no legal six-digit numbers the password space reduces to 2919 in 900000:

import Data.List
main=print$sum[1|
 i<-[100000..999999],
 s<-[show$i],s/=nub s,s==sort s]

Try it online!

But the codeadvent challenge asks to count (>=2) group occurrences upfront and then upon success to count the exactly (==2) group occurrences in an unambiguous range:

puzzle=[156218..652527]
v(0,_)2_=[1,1];v(0,_)1x=x;v(0,_)_[_,z]=[1,z]
v(n,m)s x=let(q,r)=quotRem n 10 in case compare r m of
 GT->[0,0];EQ->v(q,r)(s+1)x;LT->v(q,r)1$v(0,0)s x
instance Num a=>Num[a]where
 (+)=zipWith(+); (*)=zipWith(*); (-)=zipWith(-);
 abs=map abs; signum=map signum; fromInteger=repeat.fromInteger;
main=print$sum[v(i,9)0[0,0]|i<-puzzle]

Try it online!