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

• Roman Czyborra: Your getLine arrow is impressive! You apparently forgot to check isSorted with allF? Where in the codeadvent spec did you read the exactly ==2 and noLeadingZeroes part? Contrary to your spec as well as your formula, it explicity says that 111111 is feasible, and implicitly that 000000 also is: non-decreasing and repetetive!
• Steven Fontanella: combinations generates only non-decreasing sequences so there's no need to check that condition a second time in my algorithm. I think that this is faster than generating all numbers in the range and checking that they're ascending. In part two of the question (not shown on the link until you solve part 1), the requirement changes to be exactly == 2 instead of at least 2. I will update my question.
• Steven Fontanella: @RomanCzyborra also the noLeadingZeroes part is because this question deals with numbers instead of strings of digits. If I didn't include that part, my algorithm would deem 000000 as good when in reality that would just be 0 which has no repeating digits.
• Roman Czyborra: I finished that codeadvent now too and you are right that the count requirement reduces to (==2) after you have correctly calculated the nubby (>=2) and also that you had already specified the nondecreasing in the combinations comment. As to zero leads: apparently codeadvent hands everybody a randomized individual [min..max] puzzle range to count thru that does seem to start above 111110 or at least it did for me nulling any ambiguity.

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.

• Roman Czyborra: a sorted number with a triplicate and no duplicate is also unequal to its nub and hence a false positive
• alexyorke: @RomanCzyborra what would be an example of that number?
• Roman Czyborra: nub "111" == "1‘' /= "111" but (all(/=2).map length.group) "111"
• alexyorke: @RomanCzyborra wouldn't that be allowed? 111111 meets these criteria (double 11, never decreases). and Two adjacent digits are the same. Let me know if I'm misunderstanding something
• Roman Czyborra: I would word your requirement as a group of at least two equal digits in a row unlike ours of at least one group of exactly two equal digits in a row. In my understanding, exactly means no less than and no more than.

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!