The Missing Number - Version 2
Clean - Complexity Unknown
Currently works, explanation and further optimization in progress
module main
import StdEnv, StdLib, System.IO
:: Position :== [Int]
:: Positions :== [Position]
:: Digit :== (Char, Int)
:: Digits :== [Digit]
:: Number :== ([Char], Positions)
:: Numbers :== [Number]
:: Complete :== (Numbers, Positions)
decouple =: snd o unzip
//lcouple :: (.a -> .b) (.a, .c) -> (.b, .c)
lcouple fn (arg, oth) :== (fn arg, oth)
getCases :: Int *World -> ([(String, [[Char]])], *World)
getCases n world
# (range, world)
= evalIO getLine world
# range
= fromString range
# spacePos
= elemIndex ' ' range
| isNothing spacePos
= abort "invalid input, expected space in range\n"
# (a, b)
= splitAt (fromJust spacePos) range
# (a, b)
= (toInt (toString a), toInt (toString (tl b)))
# numbers
= [(fromString o toString) number \\ number <- [a..(b-1)]]
# (string, world)
= evalIO getLine world
| n > 1
# (cases, world)
= getCases (n - 1) world
= ([(string, numbers) : cases], world)
= ([(string, numbers)], world)
singletonSieve :: Complete -> Complete
singletonSieve (list, sequence)
| sequence_ == sequence
= reverseSieve (list, sequence)
= (list_, sequence_)
where
singles :: Positions
singles
= [hd pos \\ (_, pos) <- list | length pos == 1]
list_ :: Numbers
list_
= map (app2 (id, filter notInOtherSingle)) list
where
notInOtherSingle :: Position -> Bool
notInOtherSingle pos
= not (isAnyMember pos (flatten (filter ((<>) pos) singles)))
sequence_ :: Positions
sequence_
= foldr splitSequence sequence singles
reverseSieve :: Complete -> Complete
reverseSieve (list, sequence)
| sequence_ == sequence
= (list, sequence)
= (list_, sequence_)
where
singles :: Positions
singles
= [hd pos \\ pos <- [[subSeq \\ subSeq <- sequence | isMember subSeq p] \\ (_, p) <- list] | length pos == 1]
//= [hd pos \\ pos <- | length pos == 1]
list_ :: Numbers
list_
= map (app2 (id, filter (\b_ = (notInOtherSingle b_) && (hasContiguousRun b_)))) list
where
notInOtherSingle :: Position -> Bool
notInOtherSingle pos
= not (isAnyMember pos (flatten (filter ((<>) pos) singles)))
hasContiguousRun :: Position -> Bool
hasContiguousRun pos
//= any (any (isPrefixOf pos) o tails) sequence_
= and [isMember p (flatten sequence_) \\ p <- pos]
sequence_ :: Positions
sequence_
= foldr splitSequence sequence singles
splitSequence :: Position Positions -> Positions
splitSequence split sequence
= flatten (map newSplit (map (span (not o ((flip isMember) split))) sequence))
where
newSplit :: (Position, Position) -> Positions
newSplit ([], b)
# b
= drop (length split) b
| b > []
= [b]
= []
newSplit (a, b)
# b
= drop (length split) b
| b > []
= [a, b]
= [a]
indexSubSeq :: [Char] Digits -> Positions
indexSubSeq _ []
= []
indexSubSeq a b
# remainder
= indexSubSeq a (tl b)
| isPrefixOf a (map fst b)
= [[i \\ (_, i) <- take (length a) b] : remainder]
//= [[i \\ _ <- a & (_, i) <- b] : remainder]
= remainder
missingNumber :: String [[Char]] -> [[Char]]
missingNumber string numbers
# string
= [(c, i) \\ c <-: string & i <- [0..]]
# locations
= [(number, indexSubSeq number string) \\ number <- numbers]
# digits
= [length (indexSubSeq [digit] [(c, i) \\ c <- (flatten numbers) & i <- [0..]]) \\ digit <-: "0123456789-"]
# missing
= flatten [repeatn (n - length i) c \\ n <- digits & (c, i) <- [(digit, indexSubSeq [digit] string) \\ digit <-: "0123456789-"]]
# (answers, _)
= until (\e = e == singletonSieve e || length [(a, b) \\ (a, b) <- fst e | length b == 0 && isMember a (candidates missing)] > 0) singletonSieve (locations, [indexList string])
# answers
= filter (\(_, i) = length i == 0) answers
= filter ((flip isMember)(candidates missing)) ((fst o unzip) answers)
where
candidates :: [Char] -> [[Char]]
candidates chars
= moreCandidates chars []
where
moreCandidates :: [Char] [[Char]] -> [[Char]]
moreCandidates [] nums
= removeDup (filter (\num = isMember num numbers) nums)
moreCandidates chars []
= flatten [moreCandidates (removeAt i chars) [[c]] \\ c <- chars & i <- [0..]]
moreCandidates chars nums
= flatten [flatten [moreCandidates (removeAt i chars) [ [c : num] \\ num <- nums ]] \\ c <- chars & i <- [0..]]
Start world
# (number, world)
= evalIO getLine world
# (cases, world)
= getCases (toInt number) world
= flatlines[flatten(intersperse [', '] (missingNumber string numbers)) \\ (string, numbers) <- cases]
Try it online!