! - - - - - - - - - - - - - - ! RECIMAGE.TRU Program
!
! to Calculate & Plot Adjacent primes in
!
! Pascal's Tetrahedron
!
! with values stored & searched for matches
!
! runs 6+ times as fast as other
!
! also prints out list of values & multiples
!
! written: January 27, 1988
!
! revised: February 24, 1988
!
! revised: December 9, 1988 color & recheck
!
! revised: August, 1989 for $ disk storage
!
! revised: November 4, 1989 format & comments
!
! revised: February 24, 1990 horizontl, lev128
!
! revised: 12/23/91 correct date stamping
!
! revised: 11/17/92 same Drive & levels 128-150
! - - - - - - - - - - - - - - !
at: Peoria, Illinois
! - - - - - - - - - - - - - - ! Initialization
DECLARE DEF isgreater,outd$
DECLARE DEF in$,prod$,prod2$,quot$,quot2$,int$,mod$,one$,two$,zero$
LIBRARY "C:\true\mtk\hugelib"
SET MODE "VGA"
Set back 8
set color 15
DIM pt$(140,140) !was 132
DIM point$(1622) !was 1432
DIM points(1622,3) ! was 1432
! !
SET CURSOR 12,2
PRINT " Program to calculate
the values"
PRINT " of one layer of elements
of the"
PRINT " three-dimensional
analogue of"
PRINT " Pascal's Triangle,
and to plot the"
PRINT " primeness of +1 &
-1 values."
PRINT " up to 3000
factors at level 219"
PRINT " (c) 1988,1989 by
Jim Nugent"
GET KEY a
CLEAR
PRINT "
This program"
PRINT " RECIMAGE.EXE generates
values and a graphic"
PRINT " display for one level
of Pascal's Tetrahedron."
PRINT " It saves the values
to a text file, and "
PRINT " the screen image
data to another file that can be"
PRINT " viewed using PLAIMAGE.EXE.
Start with levels"
PRINT " 5 to 20. Level
35 takes 5 minutes (XT) to calculate,"
PRINT " while level 55 will
take 3 or 4 hours (XT). Once "
PRINT " saved with this program,
PLAIMAGE can call any"
PRINT " level back in under
30 seconds."
GET KEY a
CLEAR
PRINT " Do you want to print
out all element values."
INPUT PROMPT " Use the printer
(y or n):":p$
print "
USING same drive & directory as program for data"
INPUT PROMPT " Save array to disk (y or n):":d$
INPUT prompt "level to start with:":start_level
INPUT prompt "level to end with:":max_level
! ! P R I
N T L E G E N D
LET level = start_level
DO while level < max_level
CLEAR
OPEN #1:screen .75,1,.6,1
SET COLOR 06
PRINT time$
PRINT date$[5:6];"/";date$[7:8];"/";date$[1:4]
PRINT " "
PRINT "ADJACENT PRIMES "
SET COLOR 15
PRINT " NONE"
SET COLOR 9
PRINT " MINUS "
SET COLOR 10
PRINT " PLUS
"
SET COLOR 12
PRINT " PLUS & MINUS"
SET COLOR 06
PRINT " "
PRINT "enter 0 to exit"
PRINT "LEVEL = ";level
LET ttt$=time$
LET ddd$=date$
CLOSE #1
IF level <3 then EXIT DO
LET index = level
! - - - - - - - - - - - - - - ! M A
I N L O O P
FOR row = 1 to index + 1
FOR col = 1
to ((index + 2) - row)
IF row = 1 and col = 1 then
LET pt$(1,1) = one$
ELSE IF row = 1 and col > 1 then
LET ratio1=(index+1)-(col-1)
LET temp1$ = prod2$(pt$(row,(col-1)),ratio1)
LET pt$(row,col) = int$(quot2$(temp1$,(col-1)))
ELSE IF row > 1 and col=1 then ! first column in each row
LET pt$(row,col)=pt$(col,row)
ELSE
! rest of points
LET ratio2=(level+3-(col+row))
LET temp2$=prod2$(pt$(row,(col-1)),ratio2)
LET pt$(row,col)=int$(quot2$(temp2$,(col-1)))
!print row,col
END IF
NEXT col
!print row
NEXT row
! - - - - - - - - - - - - - - ! D I S
P L A Y T E T S L I C E
OPEN #2:SCREEN 0,1,0,1
SET WINDOW 0, level+2, 0 , level+1.5
!x,x,y,y
LET minus_count,other_count = 0
LET plus_count,total_count = 0
LET top = 1
LET vf = .4
LET vcf = .3
LET index=level
FOR row = 1 to index + 1
FOR col = 1
to ((index + 2) - row)
LET offset=.5*(row-1)
LET pt_num$= pt$(row,col)
IF isgreater(two$,pt_num$) = 0 then
! ! check array for primes or prime check
FOR point_count = 1 to top
IF pt_num$ = point$(point_count) then !already got it
LET minus=points(point_count,1)
LET plus =points(point_count,2)
LET points(point_count,3) = points(point_count,3)+1
EXIT FOR
ELSEIF point_count>=top then ! don't have it
CALL prime_test(pt_num$,minus,plus)
LET point$(point_count)=pt_num$
LET points(point_count,1)=minus
LET points(point_count,2)=plus
LET points(point_count,3)=1
LET top = top + 1 ! save new top value
EXIT FOR
END IF
NEXT point_count
! ! D R A W I M A G E
O F S L I C E
IF minus = 1 and plus = 1 then ! flood +&-
primes
SET COLOR 4 ! 4 is red
BOX CIRCLE offset+col-vcf,offset+col+vcf,row-vf,row+vf
FLOOD offset+col,row
LET minus_count = Minus_count + 1
LET plus_count = plus_count + 1
LET diskimage$="B"
ELSE IF plus = 1 then ! flood +1 prime
SET COLOR 2 ! 2 is green
BOX CIRCLE offset+col-vcf,offset+col+vcf,row-vf,row+vf
FLOOD offset+col,row
LET plus_count = plus_count + 1
LET diskimage$="P"
ELSE IF minus = 1 then ! flood -1 prime
SET COLOR 1 ! 1 is blue
BOX CIRCLE offset+col-vcf,offset+col+vcf,row-vf,row+vf
FLOOD offset+col,row
LET minus_count = minus_count + 1
LET diskimage$="M"
ELSE
! flood no primes
SET COLOR 7 ! 7 is white
BOX CIRCLE offset+col-vcf,offset+col+vcf,row-vf,row+vf
FLOOD offset+col,row
LET other_count = other_count + 1
LET diskimage$="N"
END IF
ELSE
! flood vertex
SET COLOR 2 ! 2 is green
BOX CIRCLE offset+col-vcf,offset+col+vcf,row-vf,row+vf
FLOOD offset+col,row
LET plus_count = plus_count + 1
LET diskimage$="P"
END IF
! ! STORE GRAPHIC IN STRING FORM AS image$
LET image$=image$&diskimage$
LET diskimage$=""
LET pt_num$=zero$
LET total_count = total_count + 1
NEXT col
NEXT row
CLOSE #2
SET COLOR 2
! 2 is green
LET uuu$=time$
LET eee$=date$
! ! SAVE
GRAPHIC TO DISK AS STRING
OPEN #5: name "IMAGE"&STR$(level)&".txt",create
newold, org byte
WRITE #5: image$
CLOSE #5
LET image$=""
FOR warble = 1 to 8
SOUND 144,.1
SOUND 288,.05
NEXT warble
! get key a
! uncomment for pause
! ! P R I
N T V A L U E S T O D I S K
IF p$="y" then
OPEN #3:printer
ELSE IF d$="y" then
WHEN ERROR IN
OPEN #3: name "VALUE"&STR$(level)&".txt",create new, org text
USE
PRINT "FILE EXISTS"
! LET
d$="n"
OPEN #3:screen .75,1,.6,1
END WHEN
ELSE
OPEN #3:screen .75,1,.55,1
END IF
PRINT #3:
PRINT #3:
PRINT #3:"========================="
PRINT #3:" PLUS 1 PRIMES:";plus_count
PRINT #3:"MINUS 1 PRIMES:";minus_count
PRINT #3:"OTHER ELEMENTS:";other_count
PRINT #3:"TOTAL ELEMENTS:";total_count
PRINT #3:"
UNIQUE:";top
IF other_count>0 then
LET tot_primes = plus_count
+ minus_count
PRINT #3:" PRIMES/OTHER:";round((tot_primes)/other_count,4)
END IF
PRINT #3:" PRIMES/TOTAL:";round((tot_primes)/total_count,4)
PRINT #3:"
LEVEL:";level
PRINT #3:"=========================="
PRINT #3:ttt$;" ";ddd$[5:6];"/";ddd$[7:8];"/";ddd$[3:4]
!start
PRINT #3:uuu$;" ";eee$[5:6];"/";eee$[7:8];"/";eee$[3:4]
!finish
! get key a
! uncomment for pause
IF p$="y" OR d$="y" THEN
PRINT #3
PRINT #3:" -
+ ";"COUNT","VALUE"
PRINT #3:" 0";"
1";" 3";" 1"
! vertex values are 3 ones
FOR cnt = 1 to top
- 1
PRINT #3:points(cnt,1);" ";points(cnt,2);" ";points(cnt,3),outd$(point$(cnt),0)
NEXT cnt
ELSE
END IF
CLOSE #3
LET level = level + 1
LOOP
! - - - - - - - - - - - - - - ! R E S T O R E
E D I T W I N D O W
print "finished recording"
print "Tet levels from "
print start_level;" to ";max_level
GET KEY aasdfsdfa
CLEAR
set back 1
set color 15
clear
SET MODE "history"
END
! - - - - - - - - - - - - - - ! P R I M E T
E S T S U B
! adapted from True BASIC program
SUB Prime_test(test_num$,minus_prime,plus_prime)
DECLARE DEF sum$,isequal,dif$,pwrmod$,num$
DECLARE DEF one$,two$,zero$
LET n$,n1$,m$,m1$,power$,mpower$
= zero$
!
! first test our test_num minus one
LET n$ = dif$(test_num$,one$)
! n to test
LET n1$ = dif$(test_num$,two$)
! n-1
LET power$ = pwrmod$(two$,n1$,n$)
! 2^(n-1) mod n
IF isequal(power$,one$)=1 then
LET minus_prime
= 1
ELSE
LET minus_prime
= 0
END IF
! !
next test our test_num plus one
LET m$= sum$(test_num$,one$)
! add one to test_num
LET m1$ = test_num$
! n-1
LET mpower$ = pwrmod$(two$,m1$,m$)
! 2^(n-1) mod n
IF isequal(mpower$,one$)=1 then
LET plus_prime
= 1
ELSE
LET plus_prime
= 0
END IF
END SUB
! - - - - - - - - - - - - - - !