Lottery Ball Problem
edit 2: fixed
General solution for n > 1:
-- lottery2.hs
import System
import Control.Monad
import Data.Maybe
main = mapM_ print . map (solve . read) =<< getArgs
rdigits 0 = []
rdigits n = (n `mod` 10) : rdigits (n `div` 10)
digits = reverse . rdigits
undigits = foldl ((+) . (10*)) 0
c1 = c . digits
c [] = 0
c [0] = 0
c [_] = 1
c (0:xs) = c xs
c (1:xs) = d xs + c xs + undigits xs
c (x:xs) = c xs + x * (d xs - 1) + 10 ^ length xs
d xs = ds !! length xs
ds = map d' [0..]
where d' n = c1 (10 ^ n - 1) + 1
maxVal n =
fst . head . filter (uncurry $ (<) . (*n))
. map (liftM2 (,) undigits c . (1:) . flip replicate 9) $ [0..]
search f p q a b = s f (uncurry p) q (a, f a) (b, f b)
where
s f p q a b
| not (p a) = Nothing
| fst a + 1 == fst b = guard (not $ p b) >> return (fst a)
| a >= b = Nothing
| q a b = maybe (s f p q k b) Just (s f p q a k)
| otherwise = Nothing
where k = ((fst a + fst b) `div` 2, f (fst k))
solve n = fromJust $ search c1 ((>=) . (*n)) q 1 m
where
m = maxVal n
q (a, fa) (b, fb) = (a * n) - fa <= fb - fa
There seems to be a pattern here:
$ ghc -O --make lottery2.hs Linking lottery2 ... $ time ./lottery 1 2 3 4 5 6 199990 1999919999999980 19999199999999919999999970 199991999999999199999999919999999960 1999919999999991999999999199999999919999999950 19999199999999919999999991999999999199999999919999999940 real 0m3.580s user 0m3.508s sys 0m0.020s $ time ./lottery 7 8 9 10 11 12 199991999999999199999999919999999991999999999199999999919999999930 1999919999999991999999999199999999919999999991999999999199999999919999999920 19999199999999919999999991999999999199999999919999999991999999999199999999919999999918 199991999999999199999999919999999991999999999199999999919999999991999999999199999999919999999917 1999919999999991999999999199999999919999999991999999999199999999919999999991999999999199999999919999999916 19999199999999919999999991999999999199999999919999999991999999999199999999919999999991999999999199999999919999999915 real 1m10.855s user 1m3.868s sys 0m0.324s
awk (109)
brute force solution
yes|awk -F "" '{c("0123456789",1);c(NR,-1)}function c(C,m,i){for($0=C;NF-i++;)if((t[$i]+=m)<0){print NR-1;exit}}'
The awk
does not count in the character count if I understand the rules correctly.
The trick with yes|
+ NR
is a shorter way to define a loop counter than a BEGIN
+ while
or for
clause.
Replace ,1
with ,
[value of n]. With 1 it returns 199990
, with 2 it is still trying to find the answer.
Could write it as:
yes|awk -F "" -v n=1 '{c("0123456789",n);c(NR,-1)}function c(C,m,i){for($0=C;NF-i++;)if((t[$i]+=m)<0){print NR-1;exit}}'
And replace n=1
with n=
[whatever value] (now a parameter of the program, for an extra 6 characters plus the number of characters for the value of n. But like I said since it is still trying to compute for n=2, there may be no need to parameterise this version.
I'm sure there must be a much more clever algorithm than plain increment and count. Like a bit of algebra. No time for this... I'll leave that to someone else.