ë PROGRAMSJANø`TUNE BASÒ”SWEEP BAS ÌFACTOR BAS+PRIME BAS/"cNOSQUAREBASQÿ January 1985 ------------ "Audio-Frequency Analyzer," by Vince Banes, p. 223. TUNE.BAS 1792 Listing 7, p. 244. SWEEP.BAS 2944 Listing 8, p. 246. "Mathematical Recreations: The Fundamental Counting Principle," by Michael W. Ecker, p. 425. FACTOR.BAS 512 Listing 1, p. 426. ŠPRIME.BAS 4352 Listing 2, p. 427. NOSQUARE.BAS 384 Listing 3, p. 428. 10 ' AUDIO FREQUENCY ANALYZER [TUNE] 20 ' ---------------------------------- 30 ' 40 CLS:OUT 1923,137:DIM FL(14),CC(14),SL(14),FCL(14) 50 OUT 1921,128:OUT 1921,0:OUT 1920,255 60 ' 70 ' Read the calibration data from the DATA statements. 80 ' 90 FOR I= 0 TO 14 100 READ FL(I),CC(I),SL(I),FCL(I) 110 NEXT:KEY OFF 120 LOCATE 12,20:INPUT "FREQUENCY = ";F 130 IF (F<30000) AND (F>8) THEN GOTO 170 140 LOCATE 2,25 :PRINT"BAD FREQUENCY" 150 LOCATE 12,30:PRINT" " 160 GOTO 120 170 LOCATE 2,25 :PRINT" " 180 ' 190 ' Convert the frequency [hertz] to cap code and fine freq code. 200 ' 210 I=1 220 IF F>FL(I) THEN I=I+1:GOTO 220 230 I=I-1 240 DF=INT(.5+(F-FL(I))*SL(I)+FCL(I)) 250 IF DF<0 THEN OUT 1921,0:OUT 1920,255:GOTO 120 260 ' 270 ' Output the codes to the VCO. 280 ' 290 OUT 1920,DF :OUT 1921,CC(I):II=0 300 ' 310 ' Average the data over eight iterations. 320 ' 330 FOR J=1 TO 8 340 II=II+INP(1922) 350 NEXT 360 II=255-II/8 370 LOCATE 16,20 : PRINT "ADC VALUE =";INT(II) 380 A$=INKEY$:IF A$<>"" THEN GOTO 120 390 GOTO 290 400 DATA 8,31,9.1667 , 0 410 DATA 21,30,6.7857 , 70 420 DATA 36,19,2.5294 , 31 430 DATA 71, 7,2.1111 , 90 440 DATA 126,22,0.6081 , 15 450 DATA 201,22,0.5960 , 61 460 DATA 301,16,0.4699 , 78 470 DATA 553, 6,0.1521 , 23 480 DATA 1005, 2,0.1184 , 58 490 DATA 2009, 4,0.04332, 26 500 DATA 4001, 4,0.04814,112 510 DATA 6670, 0,0.01490, 0 520 DATA 7785, 0,0.01001, 16 530 DATA 14280, 0,0.01004, 81 540 DATA 30000, 0,0.00000, 0 2 510 DATA 6670, 0,0.01490, 0 520 DATA 7785, 0,0.01001, 16 530 DATA 14280, 0,0.01004, 81 540 D10 ' AUDIO FREQUENCY ANALYZER [SWEEP] 20 ' --------------------------------- 30 ' This system will sweep through a frequency range and 40 ' display the responce to each frequency. 50 ' 60 CLS:OUT 1923,137:DIM FL(14),CC(14),SL(14),FCL(14) 70 PRINT:PRINT" AUDIO FREQUENCY ANALYZER" 80 ' 90 ' Output the pulse to start the ADC conversion. 100 ' Also, park the VCO at the lowest frequency. 110 ' 120 OUT 1921,128:OUT 1921,31:OUT 1920,0 130 ' 140 ' READ THE CALIBRATION DATA FROM THE DATA STATEMENTS. 150 ' 160 FOR I= 0 TO 14 170 READ FL(I),CC(I),SL(I),FCL(I) 180 NEXT 190 KEY OFF:IX=5 200 ' 210 ' Input the lower and upper bounds of the range to sweep. 220 ' 230 LOCATE 10,15:INPUT "FREQ LOW = ";FL 240 LOCATE 12,15:INPUT "FREQ HIGH=";FH 250 FD=(FH-FL)/72 260 CLS 270 IF (FD>0) AND (FH<30000) AND (FL>8) THEN GOTO 330 280 CLS:LOCATE 3,30:PRINT"BAD FREQUENCY LIMITS" 290 GOTO 230 300 ' 310 ' Print the axis on the screen. 320 ' 330 FOR I = 1 TO 22:PRINT " -":NEXT:PRINT " "; 340 FOR I = FL+FD*3 TO FH STEP FD*6:PRINT USING " #####";I;:NEXT 350 FOR F = FL TO FH STEP FD 360 ' 370 ' CONVERT THE FREQUENCY [F] FROM HERTZ TO CAPACITOR CODE AND 380 ' FINE FREQUENCY CODE. 390 ' 400 I=1 410 IF F>FL(I) THEN I=I+1:GOTO 410 420 I=I-1 430 DF=INT(.5+(F-FL(I))*SL(I)+FCL(I)) 440 ' 450 ' If an incorrect code appears, then abort the run and start over. 460 ' 470 IF DF<0 THEN OUT 1921,0:OUT 1920,255:GOTO 230 480 OUT 1920,DF :OUT 1921,CC(I):II=0 490 ' 500 ' Delay to let the stereo settle to it's responce. 510 ' 520 FOR T = 1 TO 50:I=I+1:NEXT 530 IF F=FL THEN FOR I = 1 TO 300: T=T+3: NEXT 540 ' 550 ' Take eight samples and average. 560 ' 570 FOR I=1 TO 8 580 II=II+INP(1922) 590 NEXT 600 II=II/8 610 ' 620 ' Convert the data to a range of 1 to 22 for the screen. 630 ' 640 I=INT(22-(255-II)/4) 650 X$="+" 660 ' 670 ' Check for out-of-range conditions 680 ' 690 IF I<1 THEN I=1 :X$="^" 700 IF I>22 THEN I=22 :X$="#" 710 ' 720 ' Place the mark on the screen. 730 ' 740 LOCATE I,IX: PRINT X$; 750 IX=IX+1 760 NEXT 770 OUT 1921,31:OUT 1920,0 780 LOCATE 23,1:END 790 ' -------------------- 800 ' - CALIBRATION DATA - 810 ' -------------------- 820 ' FREQ LOW, CAP CODE, SLOPE, FINE FREQ LOW 830 ' 840 DATA 8, 31, 9.1667 , 0 850 DATA 21, 30, 6.7857 , 70 860 DATA 36, 19, 2.5294 , 31 870 DATA 71, 7, 2.1111 , 90 880 DATA 126, 22, 0.6081 , 15 890 DATA 201, 22, 0.5960 , 61 900 DATA 301, 16, 0.4699 , 78 910 DATA 553, 6, 0.1521 , 23 920 DATA 1005, 2, 0.1184 , 58 930 DATA 2009, 4, 0.04332, 26 940 DATA 4001, 4, 0.04814, 112 950 DATA 6670, 0, 0.01490, 0 960 DATA 7785, 0, 0.01001, 16 970 DATA 14280, 0, 0.01004, 81 980 DATA 30000, 0, 0.00000, 0  6670, 0, 0.01490, 0 10 REM ROUTINE TO COMPUTE FACTORIALS TO 33!. 33! IS THE LARGEST FACTORIAL THAT MICROSOFT BASIC CAN HANDLE IN THIS WAY. 20 CLS 30 DEFDBL F 40 DIM FACTORIAL(33) 50 FACTORIAL(0)=1 'DEFINE 0! TO BE 1. 60 REM COMPUTE FACTORIALS 70 FOR I=1 TO 33 80 FACTORIAL(I)=I*FACTORIAL(I-1) 90 NEXT 100 REM PRINT RESULTS 110 FOR I=0 TO 32 STEP 2 120 PRINT I;"! =";FACTORIAL(I);TAB(40);I+1;"! =";FACTORIAL(I+1) 130 NEXT 140 END 10 '************************************************************************** 20 '* * 30 '* PROGRAM TO FACTOR A NUMBER INTO PRODUCTS OF PRIMES * 40 '* * 50 '************************************************************************** 60 CLS 70 DEFINT A-Z 80 INPUT "Enter largest number to be factored";NUMBER 90 IF NUMBER<2 THEN PRINT "NUMBER MUST BE LARGER THAN 1":GOTO 80 100 REM FIRST, FIND THE NECESSARY PRIMES. FLAG.ARRAY WILL FLAG NONPRIME (COMPOSITE) NUMBERS, PRIME ARRAY WILL HOLD PRIMES WHEN FOUND. SOME BASICS REQUIRE SHORTER VARIABLE NAMES. 110 REM SIEVE ALGORITHM PROVIDED BY WILLIAM F. DOSSETT OF AUSTIN,TX. 120 DIM FLAG.ARRAY(NUMBER),PRIME(NUMBER) 130 COMPOSITE=-1 'NONPRIME FLAG.ARRAY ELEMENT WILL BE GIVEN TRUTH-VALUE `T' 140 INDEX=1 'SUBSCRIPT OF LARGEST NONEMPTY ENTRY IN PRIME ARRAY 150 PRIME(INDEX)=2 'DECLARE 2 PRIME AND LIMIT PRIME SEARCH TO ODD NUMBERS 160 REM AVOID UNNECESSARY DUPLICATION IN SEARCH. FIRST NONPRIME ODD NUMBER IS 9 (3 SQUARED), FIRST COMPOSITE ODD NUMBER NOT DIVISIBLE BY 3 IS 25 (5 SQUARED), ETC. 170 FOR K=3 TO SQR(NUMBER) STEP 2 180 IF FLAG.ARRAY(K) THEN 220 'SKIP TO NEXT PRIME 190 FOR I=K*K TO NUMBER STEP K+K 'FLAG THE ODD NUMBERS IT DIVIDES 200 FLAG.ARRAY(I)=COMPOSITE 210 NEXT 220 NEXT 230 INPUT "Do you want a listing of the primes found (y/n)";PRIMEPRINT$ 240 IF PRIMEPRINT$="y" THEN PRIMEPRINT$="Y" 250 REM COPY ALL PRIMES FOUND TO PRIME ARRAY, PRINT PRIMES IF SO REQUESTED IN 230. 260 FOR I=3 TO NUMBER STEP 2 270 IF NOT FLAG.ARRAY(I) THEN INDEX=INDEX+1:PRIME(INDEX)=I:IF PRIMEPRINT$= "Y" THEN PRINT PRIME(INDEX); 280 NEXT 290 PRINT:PRINT 300 PRIME(INDEX+1)=NUMBER+1 'MARK END OF PRIME ARRAY IN CASE NUMBER IS PRIME 310 MAXNUMBER=NUMBER 'SAVE VALUE OF LARGEST NUMBER GUARANTEED FACTORABLE WITH CURRENT PRIMES LIST. 320 DIVISORS=1 'INITIALIZE NUMBER OF DIVISORS COUNTER 330 SUBSCRIPT=1 'ACTIVE ELEMENT OF PRIME ARRAY 340 PRIME=PRIME(SUBSCRIPT) 350 REM PRINT UNIQUE FACTORING OF NUMBER 360 PRINT NUMBER;" CAN BE UNIQUELY FACTORED AS:" 370 REM IF YOUR BASIC DOES NOT SUPPORT `WHILE...WEND', CHANGE LINE 380 TO: IF PRIME>NUMBER THEN 480. 380 WHILE PRIME<=NUMBER 390 REM WHAT POWER OF THE ACTIVE PRIME IS A FACTOR OF THE NUMBER? NOTE THAT, ALTHOUGH ALL VARIABLES HAVE BEEN DECLARED INTEGER, NUMBER/PRIME NEED NOT HAVE AN INTEGER VALUE. 400 IF NUMBER/PRIME=INT(NUMBER/PRIME) THEN EXPONENT=EXPONENT+1: NUMBER=NUMBER/PRIME:GOTO 400 410 REM PRINT THE RUNNING RESULTS, INCREMENT DIVISORS 420 IF EXPONENT>0 THEN PRINT "(";PRIME;"TO THE";EXPONENT;")";: DIVISORS=DIVISORS*(EXPONENT+1) 430 REM RESET POWER COUNTER, LOOP 440 EXPONENT=0 450 SUBSCRIPT=SUBSCRIPT+1:PRIME=PRIME(SUBSCRIPT) 460 WEND 470 REM IF YOUR BASIC DOES NOT SUPPORT `WHILE...WEND', CHANGE LINE 460 TO: GOTO 380 480 PRINT:PRINT "NUMBER OF DIVISORS =";DIVISORS 490 PRINT :PRINT 500 REM IF MORE NUMBERS ARE TO BE FACTORED, DETERMINE WHETHER THE CURRENT PRIMES LIST IS ADEQUATE. IF SO, USE IT. IF NOT, ERASE ARRAYS TO AVOID PROGRAM CRASH AND RECALCULATE PRIMES. 510 INPUT "Do you want to factor another number (y/n)";CHOICE$ 520 IF CHOICE$<>"y" AND CHOICE$<>"Y" THEN 560 530 CLS 540 INPUT "Enter the new number to be factored";NUMBER 550 IF NUMBER<=MAXNUMBER THEN 320 ELSE ERASE FLAG.ARRAY,PRIME:GOTO 120 560 END 10 REM ROUTINE TO GENERATE NON-SQUARE NATURAL NUMBERS. PROGRAM CREATES AN INFINITE LOOP. HIT THE BREAK KEY TO TERMINATE. 20 CLS 30 COUNTER=1 40 NONSQUARE=INT(COUNTER+SQR(COUNTER)+.5) 50 PRINT "Nonsquare number";COUNTER;" is";NONSQUARE 60 COUNTER=COUNTER+1 70 GOTO 40