QB64: Wondrous Numbers.

2013-07-23T20:27:27-05:00

This is not a question, just an observation with a number game/function.

If you have read Godel Escher Bach, you would know what a Wondrous number is.

This site defines it nicely
http://mathforum.org/library/drmath/view/57184.html

Start with an arbitrary natural number (integer greater than zero). If the number is even, divide it by 2. If it is odd, multiply by 3 and add 1. Repeat until you come out with 1. A number is wondrous if and only if it eventually reaches 1 through this process

Now the site thinks you need pencil and paper to determine if a number is one or not. I have a computer. I'll make it do the work.

Here's the program I wrote back a few years ago. (Pardon my lack of new QB64 commands, we have a better basic now)

Code:

DECLARE FUNCTION get.a.key$ ()DECLARE SUB pause ()DECLARE FUNCTION w2! (a!)DECLARE FUNCTION wonderous! (a!)CLSPRINT "Wonderous numbers - what ones are?"PRINTqq = 1WHILE 0 = 0    FOR a = 1 TO 40        r = INT(RND * 1000000)        PRINT "W("; r; ") = "; w2(r)    NEXT    pauseWENDFOR t = 1 TO 10000    FOR a = qq TO qq + 39        PRINT "W("; a; ") = "; w2(a)    NEXT    pause    qq = qq + 40NEXTFUNCTION get.a.key$temp$ = INKEY$WHILE temp$ = ""    temp$ = INKEY$WENDget.a.key$ = temp$END FUNCTIONSUB pausePRINTPRINT ""aa$ = get.a.key$END SUBFUNCTION w2 (a)'inputs a, returns 1 if wonderous, not recursivea1 = a 'temp var to useWHILE a1 > 1    IF a1 = 1 THEN w2 = 1: EXIT FUNCTION     IF a1 < 1 OR INT(a1) <> a1 THEN PRINT "ERROR "; a: STOP     IF a1 / 2 = INT(a1 / 2) THEN        a1 = a1 / 2    ELSE        a1 = 3 * a1 + 1    END IF    'PRINT a1;WENDw2 = a1END FUNCTIONFUNCTION wonderous (a)IF a = 1 THEN wonderous = 1: EXIT FUNCTIONIF a < 1 THEN PRINT "ERROR "; a: STOPIF a / 2 = INT(a / 2) THEN    'PRINT "even": STOP    'PRINT a / 2    wonderous = wonderous(a / 2)ELSE    'PRINT "odd": STOP    wonderous = wonderous(3 * a + 1)END IFEND FUNCTION

Note the two functions. One is recursive, one is not. I'd be careful with the recursive one, you don't know how many steps it will take and the stack is vulnerable.

Anyone here into strange or useless functions?

Jack T.

Statistics: Posted by Jack002 — Tue Jul 23, 2013 8:27 pm

Pete's QBASIC Site

QB64: Wondrous Numbers.