Quantize Code
"QUANTIZE" for Commodore-64
NOTE: N,O,P,Q are substituted for b,e,d,a, in this program. 10 LET Y=0.001: Rem This is the allowable error factor for 1 part per million.(0.01 for error of 1/10,000)
20 INPUT "ENTER PERIGEE"; KO
30 INPUT "ENTER APOGEE"; JO
40 LET DO= (JO+KO)/2: Rem this obtains the semi-major diameter,D
50 FOR P= 1 TO 200000: Rem This starts a loop for trial root P= root d'
60 LET M=DO/P^2: Rem A square into semi-major diameter, for a multiplier.
70 LET N=M*JO/P: Rem Find trial root b' for trial root d'.
SEPARATE OUT POSSIBLE QUALIFYING SOLUTIONS. 80 If N>P THEN NEXT: Rem--short cuts the loop (b' must be less than d').
90 IF INT(N)=INT(N+1-Y) THEN GOTO 140: Rem Error factor is used to round down when N=x.000 to x.001
100 IF INT(N)=INT(N-1+Y) THEN GOTO 120: Rem, error factor is used to rounds up when n=x.999 to x+1.00
110 NEXT P: Rem next trial value
120 LET N = INT(N+1)
130 GOTO 150
140 LET N= INT(N): Cancels out error
150 Gosub 1000: Rem Check for coprimeness according to
Euclid VII-28
OUTPUT PRINTED & CHECKED
160 LET O= P-N: LET Q=P+O: REM Find roots e & a.
170 PRINT "N,O,P,Q=";N;",";O;","; P;",";Q: Rem Print out roots.
180 PRINT "PERIGEE=";P*N*M; "APOGEE =";P*Q*M: Rem Quantized values multiplied by the "coefficient" M to show quantum values in conventional math terms for corrected ellipse.
190 PRINT "ENTERED";JO;KO: Rem The empirical values entered.
SUB-ROUTINE FOR CHECKING PRIMENESS
1000 LET A=P: LET B=N: Rem Substitution to preserve calculations.
1010 IF A>B THEN LET A=A-B
1020 IF B>A THEN LET B=B-A
1030 IF A<>B THEN GOTO 1010
1040 IF A=B AND B<>1 THEN GOTO 1010
1050 RETURN: Rem continue to output stage, — line 160-190.
-----------------
The following program is written in HyperScript for the Macintosh used in the HyperCard program. In using the program below, it is necessary to install the appropriate fields and buttons on a card in a HyperCard Stack.
on mouseUp
set cursor to 4
put card field Jo into Jo
put card field Ko into Ko
Put the value of (Jo+Ko)/2 into it global d
put sqrt of it into d
global b
put Jo/d into b
put Ko/d into a
put 0.001 into y--Allowable empirical error put (1) into p
repeat until xy=yx
put (p^2)/(d^2) into M put M*Jo/p into N
put p into field id 6
if N>p then
put p+1 into p
next repeat
end if
put abs(N+0.5-y) into xy
put abs(N-0.5+y) into yx
put xy into field id 5
put yx into field id 4
if round(xy)<> round(yx) then
put p+1 into p
next repeat end if
exit repeat
end repeat
exit repeat end repeat
--Euclid VII,1
put abs(round(N)) into bb put p into pp
repeat until pp=bb
if bb>pp then
put bb-pp into bb next repeat
end if
if pp>bb then
put pp-bb into pp
next repeat end if
next repeat
end repeat
--ENTRY
put N/bb into b
put p/pp into d
put N/bb into field "b"
put p/pp into field "d"
put abs(round(N)/bb) into field id 9 --b put abs(p/pp) into field id 5--d
put field id 5 - field id 9 into field id 4 --e put field id 5 + field id 4 into field id 6--a
See Also