Ramanujan's Taxi

24/12/2007 - 02:49 von mhx | Report spam
"Ramanujans bemerkenswerte Taxi Nummer 1729 und schnelle Forth Lösungen."

Alle 893 Lösungen die ein 32-bit Forth findet: eine Secunde (iForth 2.x).

-marcel

== =( *
* LANGUAGE : ANS Forth with extensions
* PROJECT : Forth Environments
* DESCRIPTION : Ramanujan Taxi-number puzzle in VD
* CATEGORY : Game
* AUTHOR : Marcel Hendrix
* LAST CHANGE : December 24, 2007, Marcel Hendrix
* )

ANEW -cubes

0 [IF]
Try: FIND-CUBES ok
FORTH> find-cubes
found: 12 1, matching: 10 9, num = 1
found: 16 2, matching: 15 9, num = 2
found: 24 2, matching: 20 18, num = 3
found: 27 10, matching: 24 19, num = 4
found: 32 4, matching: 30 18, num = 5
found: 34 2, matching: 33 15, num = 6
found: 39 17, matching: 36 26, num = 7
found: 48 4, matching: 40 36, num = 8
found: 51 12, matching: 43 38, num = 9
found: 48 6, matching: 45 27, num = 10
0.003 seconds elapsed. ok
[THEN]

\ #1290 find all 893 solutions that fit in 32-bits
#52 VALUE #cubes

: CUBES, #cubes 0 DO I I * I * , LOOP ;

CREATE cubes CUBES,

: cubed ( ix -- u ) CELLS cubes + @ ;

: TEST-CUBES? ( sum i j -- bool )
0 LOCALS| test j i sum |
BEGIN
i #cubes 1- >= j 1 <= OR IF FALSE EXIT ENDIF
i 1+ cubed j 1- cubed + TO test
test sum = IF CR ." found: " i 1+ 4 .R j 1- 4 .R TRUE EXIT ENDIF
test sum > IF -1 +TO j
ELSE 1 +TO i
ENDIF
AGAIN ;

: FIND-CUBES ( -- )
0 LOCALS| num |
TIMER-RESET
#cubes 1 ?DO
I 1 ?DO
J cubed I cubed + J I
TEST-CUBES? IF ." , matching: " J 4 .R I 4 .R
1 +TO num ." , num = " num .
LEAVE
ENDIF
LOOP
LOOP
CR .ELAPSED ;

: ABOUT CR ." Try: FIND-CUBES" ;

ABOUT

(* End of Source *)
 

Lesen sie die antworten

#1 anton
24/12/2007 - 22:34 | Warnen spam
: TEST-CUBES? ( sum i j -- bool )
0 LOCALS| test j i sum |
BEGIN
i #cubes 1- >= j 1 <= OR IF FALSE EXIT ENDIF
i 1+ cubed j 1- cubed + TO test
test sum = IF CR ." found: " i 1+ 4 .R j 1- 4 .R TRUE EXIT ENDIF
test sum > IF -1 +TO j
ELSE 1 +TO i
ENDIF
AGAIN ;

: FIND-CUBES ( -- )
0 LOCALS| num |
TIMER-RESET
#cubes 1 ?DO
I 1 ?DO
J cubed I cubed + J I
TEST-CUBES? IF ." , matching: " J 4 .R I 4 .R
1 +TO num ." , num = " num .
LEAVE
ENDIF
LOOP
LOOP
CR .ELAPSED ;



Warum ist das LEAVE hier korrekt?

Es folgt eine aequivalente, etwas verbesserte Loesung, besonders was
TEST-CUBES? betrifft.

Vorteile:
+ Nicht soviele 1+ und 1-.
+ Funktioniert auch fuer etwas groessere Zahlen auf 32-Bit-Systemen
+ Informativere Ausgabe
+ Kein +TO
+ Wenigstens eines von den

Nachteil:
- Funktioniert nur mit Gforth (wegen Locals-Definition innerhalb von BEGIN)


1508 VALUE #cubes

: CUBES, #cubes 0 DO I I * I * , LOOP ;

CREATE cubes CUBES,

: cubed ( ix -- u ) CELLS cubes + @ ;

: .pair ( i j -- )
4 .r ." ^3 +" 4 .r ." ^3" ;

: TEST-CUBES? ( sum i j -- bool )
r >r { sum } r> 1+ r> 1-


BEGIN { i j }
i #cubes < j 0 > and WHILE
i cubed j cubed + { test }
test sum = IF CR sum 12 u.r ." = " j i .pair TRUE EXIT ENDIF
test sum u> IF
i j 1-
ELSE
i 1+ j
ENDIF
REPEAT
FALSE ;



: FIND-CUBES ( -- )
0 { num }
#cubes 1 ?DO
I 1 ?DO
J cubed I cubed + J I
TEST-CUBES? IF ." = " i j .pair
num 1+ TO num ." , num = " num .
LEAVE
ENDIF
LOOP
LOOP
CR ;

FIND-CUBES

- anton
M. Anton Ertl Some things have to be seen to be believed
Most things have to be believed to be seen
http://www.complang.tuwien.ac.at/anton/home.html

Ähnliche fragen