Problem of the week – 9 Digit Problem
I’ve posted the following challenge to the jokes list of our company the last week, and asked my collegaues to use their imagination and exploit as many programming languages as possible, the more exotic the better…
Find a number consisting of 9 digits in which each of the digits from 1 to 9 appears only once. This number must also satisfy these divisibility requirements:
- The number should be divisible by 9.
- If the rightmost digit is removed, the remaining number should be divisible by 8.
- If the rightmost digit of the new number is removed, the remaining number should be divisible by 7.
- And so on, until there’s only one digit (which will necessarily be divisible by 1).
A couple of solutions arived, mostly from Maya and Cactus. Right now we have programs written in C#, Perl, Haskell, XSLT and Maya took our very own intentional editor and our internal language called CL1 and solved the problem in that. It could cleary be written in a much better style, but hey… that’s not so bad.
See the list of solutions here.
If you find that your favourite language is missing, don’t hesitate to share it with us, just provide a link to you solution, or copy the source code in the comment box below (bonus points for a Javascript XSS that works). I’m really longing for a version written in mod-rewrite and one with C++ template meta programming…
Mondta Cactus ekkor: 2010. április 20., 11:23 link
JFTR, I’m working on one-upping all of these programs by writing a proven solution in Agda. The only problem is that currently it is much too slow to actually run.
I’ve posted the details about the performance problem here:
http://gergo.erdi.hu/blog/2010-04-19-unary_arithmetics_is_even_slower_than_you%27d_expect/
Mondta attila ekkor: 2010. április 20., 11:26 link
v0.1 mert hataridonk van. de ha mar osszeraktam valamit (ha egyaltalan azt amit kene)…
(defun 9-digit-problem ()
(declare (optimize speed))
(labels ((from-digits (digits)
(loop
:for digit fixnum :in digits
:for position fixnum :from (1- (length digits)) :downto 0
:sum (the fixnum (* (expt 10 position) digit))))
(match? (digits)
(let ((number (from-digits digits))
(digit-count (length digits)))
(zerop (mod number digit-count)))))
(let ((matches ()))
(alexandria:map-derangements (lambda (digits)
(when (match? digits)
(push digits matches)))
‘(1 2 3 4 5 6 7 8 9))
matches)))
TEST> (progn
(sb-ext:gc :full t)
(time (length (9-digit-problem))))
Evaluation took:
0.272 seconds of real time
0.270000 seconds of total run time (0.260000 user, 0.010000 system)
[ Run times consist of 0.040 seconds GC time, and 0.230 seconds non-GC time. ]
99.26% CPU
615,302,479 processor cycles
21,381,728 bytes consed
133496
Mondta Cactus ekkor: 2010. április 20., 12:46 link
Ati: Valójában nem 133496, hanem csak egy megoldás van.
Eredetileg azt kezdtem el írni, hogy “ugyanis úgy tűnik, a Te kódod nem veszi figyelembe azt a követelményt, hogy a végső, 9 jegyű számban minden számjegy pontosan egyszer szerepeljen”, de aztán megnéztem, és az alexandria:map-derangements elvileg pont ezt csinálná. De valami kaki akkor is van.
Mondta Lőry ekkor: 2010. április 20., 14:47 link
Mekkora mértékben szabad nyesni ügyes megkötésekkel a keresési teret? Ez pl. elfogadható BASIC megoldás gyanánt?
10 PRINT “”
Mondta Lőry ekkor: 2010. április 20., 14:48 link
Oops, behalt a metaszintaktikai spoilerhelyettesítő notációm.
10 PRINT “{papír-ceruzás megoldás}”
Mondta Cactus ekkor: 2010. április 20., 16:10 link
Inkább írd meg azt a programot, ami a papíros-ceruzás algoritmust valósítja meg! Az engem is érdekelne :)
Mondta Lőry ekkor: 2010. április 21., 01:27 link
Azon még dolgozom, de gyorsan megírtam a C++TMP változatot, szép új, még ropogós variadic template-ekkel.
http://blog.lorentey.hu/2010/04/21/cpp-template-metaprogramming/
Mondta Maya ekkor: 2010. április 22., 13:20 link
For those interested (and eligible :) ) I’ve posted my CL1 solution onto Intentional’s support site. Look for the ’9 digit problem solver’ under CL1 Samples section.
As some of you know, I’ve also implemented the solution as an Excel sheet. I’m planning to post it on my blog soon, so stay tuned. :)
I’m also thinking about a Brainfuck implementation. However, for that I’ll definitely need a Brainfuck Workbench that can help in organizing the code. Well, one of these days…
Mondta solrize ekkor: 2010. május 25., 00:15 link
Here is my “efficient” solution using a few obvious symmetries of the problem in the nums function. It searches just 24**2=576 candidate solutions. nums’ is a brute force search through 9! candidates and takes a few secounds under ghci. nums is almost instantaneous.
import Data.List
nums = [num ns
| n1 <- permutations [1,3,7,9]
, n2 <- permutations [2,4,6,8]
, let { (n1a,n1b) = splitAt 2 n1
; (n2a,n2b) = splitAt 2 n2
; ns = interleave n1a n2a ++ [5] ++ interleave n2b n1b
}
, check ns
]
where
interleave ps qs = concat [[a,b] | (a,b)<-zip ps qs]
nums' = [num ns | ns <- permutations [1..9], check ns]
check ns = and [num (take k ns)`mod`k == 0 | k 10*n+d) ps
main = print nums
Mondta Maya ekkor: 2010. május 25., 08:10 link
For the brainfuck solution, see my blog. http://mayablog.blog.hu
Mondta Cactus ekkor: 2010. május 25., 12:20 link
Solrize: But you can make a dumb backtracking search efficient enough to be in the tens-of-miliseconds range as well, just check my Haskell solution (Haskell.zip in the list of solutions).
Mondta Mészáros Levente ekkor: 2010. június 17., 23:18 link
Egy kis sport után direkt jól esik az ilyesmi:
CL-USER> (time
(block nil
(labels ((solve (digits number)
(if (= 9 (length digits))
(return number)
(loop for digit :in (set-difference ‘(1 2 3 4 5 6 7 8 9) digits)
for new-number = (+ (* number 10) digit)
when (zerop (rem new-number (1+ (length digits))))
do (solve (cons digit digits) new-number)))))
(solve nil 0))))
Evaluation took:
0.000 seconds of real time
0.000000 seconds of total run time (0.000000 user, 0.000000 system)
100.00% CPU
190,935 processor cycles
8,192 bytes consed
381654729
Mondta Mészáros Levente ekkor: 2010. június 17., 23:21 link
Találtam egy rövidebb, gyorsabb megoldást:
CL-USER> (time 381654729)
Evaluation took:
0.000 seconds of real time
0.000000 seconds of total run time (0.000000 user, 0.000000 system)
100.00% CPU
900 processor cycles
0 bytes consed
381654729
CL-USER>
Ez nem csalás, ez is egy valid program… ;-)
Mondta Mészáros Levente ekkor: 2010. június 17., 23:42 link
Hehe, lefordítottam a Maya féle brainfuck megoldást a saját hackish compileremmel, egy teljesen unoptimized assembly-re. Ennek ellenére nem is olyan lassu… http://dwim.hu/darcs/hu.dwim.brainfuck/source/brainfuck.lisp
Van egy masik implementáciom is, ami egy brainfuck interpreter egy llvm interpreter tetetén csücsülve, ami partial evaluatorral fordít llvm kódot. Azt meg az llvm compiler és linker még tovább optimálja… meg kéne néznem azzal is, de már késő van. Legyen elég ennyi mára… :)
levy@tyrion:~$ wc -l digits.as
6651 digits.as
levy@tyrion:~$ time ./digits
381654729
real 0m0.219s
user 0m0.210s
sys 0m0.010s
Mondta Mészáros Levente ekkor: 2010. június 18., 09:10 link
Na jó, még egy utolsó post. Ez most a probléma általánosításáról szól, vagyis mi lenne, ha nem tizes számrendszerben csinálnánk… Extra feladat, milyen számrendszerekben van megoldása?
CL-USER> (time
(loop for base from 2 to 16 do
(labels ((solve (digits number)
(if (null digits)
(format t “~A in base ~A = ~A~%” number base (write-to-string number :base base))
(loop for digit :in digits
for new-number = (+ (* number base) digit)
when (zerop (rem new-number (- base (length digits))))
do (solve (remove digit digits) new-number)))))
(solve (loop for i from 1 below base collect i) 0))))
1 in base 2 = 1
27 in base 4 = 123
57 in base 4 = 321
2285 in base 6 = 14325
7465 in base 6 = 54321
874615 in base 8 = 3254167
1391089 in base 8 = 5234761
1538257 in base 8 = 5674321
381654729 in base 10 = 381654729
559922224824157 in base 14 = 9C3A5476B812D
Evaluation took:
0.062 seconds of real time
0.060000 seconds of total run time (0.060000 user, 0.000000 system)
[ Run times consist of 0.030 seconds GC time, and 0.030 seconds non-GC time. ]
96.77% CPU
112,013,496 processor cycles
4,165,776 bytes consed
Mondta Cactus ekkor: 2010. június 22., 00:04 link
I’ve implemented a Brainfuck interpreter and compiler just to try out Maya’s code :)
It turns out Maya’s code is buggy: after outputting the correct number, it tries to decrement the pointer below 0.
The interpreter and compiler is available at http://github.com/gergoerdi/brainfuck
Mondta lorro ekkor: 2010. október 8., 23:27 link
Hi – just read the problem and couldn’t stop thinking.. So I’ve implemented it in FORTH, probably the most natural way of expressing a program’s flow. I kept it functional instead of optimizing it – after all, it executes about 500 times / second now. If you don’t yet have it on your PC, apt-get install gforth (or download the .exe for windows).
: ?DIVISIBLE ( prefix n — prefix n flag ) \ is prefix divisible by n?
2dup MOD 0= ;
: _?NEW# ( prefix n — flag ) \ does prefix contain n?, destructive
over 0=
IF 2drop -1
ELSE over 10 MOD over – 0=
IF 2drop 0
ELSE swap 10 / swap RECURSE
THEN
THEN ;
: ?NEW# ( prefix n — prefix n flag ) \ does prefix contain n?
2DUP _?NEW# ;
: DIGITS ( prefix n — ) \ loop: number starting with prefix and has n digits
dup 10 =
IF drop .
ELSE 10 1
DO over 10 * i ?NEW#
IF + over ?DIVISIBLE
IF 1+ RECURSE
ELSE 2drop
THEN
ELSE 2drop
THEN
LOOP 2drop
THEN ;
: 9DIGITS ( — ) \ solve the 9-digits problem
0 0 1 DIGITS ;
9DIGITS
BYE
Mondta lorro ekkor: 2010. október 8., 23:28 link
(formatting disappeared, if you’d like to see the pretty formatted code, please use the link)