SBC6502 - 58 - basic programs - Fourier analyze.

By Administrator at September 26, 2022 12:15
Filed Under: SBC6502

 

Zmysluplné programy pre Basic hlavne na UK101 a Ohio Scientific (vedecký ...) sa dosť ťažko zháňajú a hľadajú. Napokon, už odvtedy skutočne uplynulo pekných pár rokov.

Keď sa pozriem na to koľko knižných titulov aj s ukážkami v jazyku Basic vyšlo napríklad pre Atari - nuž tam sú to oproti OSI a UK101 vskutku lukulské hody, tu je to ako hľadať zrnko piesku v púšti.


Pozrime si tento výpočet na SBC6502 (UK101):

Doplnená poznámka:

Včera som bol priamo pod článkom upozornený v komentári na chybu v programe a tak nasledovala oprava (vďaka dex !). Čo je zaujímavé, mám tento program z dvoch nezávislých  zdrojov, jeden v časopise a druhý na webe (a tvrdí sa tam že je to otestované) - ale v obidvoch sa nachádza uvedená chyba, jednoducho niet nad kvalitné podklady.Tongue out

 

Poďme si pozrieť vypichnutú "problémovú"  časť programu, je označená podčiarknutím textu:

...

150 INPUT "IS FUNCTION ODD, EVEN OR NEITHER";Q$
200 PRINT "HARMONIC","NO. OF LOOPS","RESULT"
212 IF Q$="ODD" THEN 340
213 IF Q$="EVEN" THEN 450
216 IF Q$="ODD" THEN 340
220 N=0:A1=-L:B1=L:G=1

...

 
Opravená časť programu je zvýraznené, riadok č.220 v programe nebol vôbec použitý. Zmena je v obsahu riadku 216 a jeden riadok (217) pribudol, rieši chybu zlého zadania voľby. Ak ešte niekto nájde nejakú chybu - dajte vedieť.
...
150 INPUT "IS FUNCTION ODD, EVEN OR NEITHER";Q$
200 PRINT "HARMONIC","NO. OF LOOPS","RESULT"
212 IF Q$="ODD" THEN 340
213 IF Q$="EVEN" THEN 450
216 IF Q$="NEITHER" THEN 220
217 GOTO 150

220 N=0:A1=-L:B1=L:G=1
...

Kompletný listing programu s už uvedenou opravou:


1 REM 48char. x 16 lines
5 POKE (11),237:POKE (12),254:PI=3.1415927
10 PRINT:PRINT:PRINT "FOURIER SERIES!!!"
20 PRINT "-----------------":PRINT
30 DIM A(99),B(99)
40 LL=54220
50 GOTO 9000
60 REM SAMPLE EQUATION OF A SQUARE WAVE WHEN
61 REM DEFINED AS EVEN
70 INPUT "NO. OF HARMONICS";M:M=INT(ABS(M))
80 N=0:G=0
100 DEF FNA(X)=X*X+1
110 REM PUT YOUR FUNCTION ON LINE 100 AS A
120 REM FUNCTION OF X, AS ABOVE
130 INPUT "PERIOD";L:L=ABS(L/2)
150 INPUT "IS FUNCTION ODD, EVEN OR NEITHER";Q$
200 PRINT "HARMONIC","NO. OF LOOPS","RESULT"
212 IF Q$="ODD" THEN 340
213 IF Q$="EVEN" THEN 450
216 IF Q$="NEITHER" THEN 220
217 GOTO 150
220 N=0:A1=-L:B1=L:G=1
260 GOSUB 2000:A(N)=I9/L:N=N+1:IF N<=M THEN 260
280 N=0:G=0
290 GOSUB 2000:B(N)=I9/L:N=N+1:IF N<=M THEN 290
330 GOTO 540
340 N=1:A1=0:B1=L:G=0
380 GOSUB 2000:B(N)=I9*2/L:N=N+1:IF N<=M THEN 380
440 GOTO 540
450 N=0:A1=0:B1=L:G=1
490 GOSUB 2000:A(N)=I9*2/L:N=N+1:IF N<=M THEN 490
540 PRINT:INPUT "TABLE PRINTOUT";Q$
545 IF LEFT$(Q$,1)="Y" THEN 1000
550 PRINT"F(X)=";A(0)/2;"+[";
560 FOR N=1 TO M:IF A(N)=0 THEN 610
580 IF B(N)=0 THEN 630
590 PRINT A(N);"COS(";N/L;"*PI*X)+";B(N);"SIN(";N/L;"*PI*X)+";
600 GOTO 640
610 PRINT B(N);"SIN(";N/L;"*PI*X)+";
620 GOTO 640
630 PRINT A(N);"COS(";N/L;"*PI*X)+";
640 NEXT N:PRINT "]":END
670 INPUT "GRAPH";Q$:IF Q$="NO" THEN END
690 INPUT "LINES PER CYCLE";L1
700 C=100
710 INPUT "AMPLITUDE";A1:A1=24/A1
720 FOR X=0 TO 2*L*C STEP 2*L/L1
730 P=0:FOR N=1 TO M
740 P=P+A(N)*COS(N*PI*X/L)+B(N)*SIN(N*PI*X/L)
750 NEXT N
760 P=P+A(0)/2
770 PRINT:POKE (LL+24),73
780 R=(P*A1)+24:IF R<0 OR R>48 THEN 880
785 LN=INT(((R-INT(R))*8)+4.5)
787 IF LN>7 THEN LN=LN-8:R=R+1
790 POKE (LL+R),LN+136
880 NEXT X
890 END
1000 PRINT:PRINT "F(X)="F$"=";A(0)/2;"+"
1020 PRINT "HARMONIC","COS/SIN COEFF."
1030 FOR N=1 TO M
1035 IF A(N)=0 THEN 1044
1040 PRINT N,A(N),"*COS(";N/L;"*PI*X)"
1044 IF B(N)=0 THEN 1046
1045 PRINT N,B(N),"*SIN(";N/L;"*PI*X)"
1046 IF N/6=INT(N/6)THEN X=USR(X)
1050 NEXT N
1060 GOTO 670
2000 REM NUMERICAL INTEGRATION OF FNX
2010 REM SEVEN POINT SIMPSONS RULE
2050 DEF FNX(X)=FNA(X)*(COS(N*PI*X/L)*G+SIN(N*PI*X/L)*(1-G))
2060 X1=(B1-A1)/6:I1=FNX(A1)+FNX(B1)
2070 I2=FNX(A1+X1):I3=FNX(A1+2*X1)
2080 I4=FNX(A1+3*X1):I5=FNX(A1+4*X1)
2090 I6=FNX(A1+5*X1):I7=0
2095 I=X1*(41*I1+216*I2+27*I3+272*I4+27*I5+216*I6)/140
2100 H9=I2+I5:I5=I3+I6:I3=H9:I7=I7+I4
2110 I2=0:I4=0:I6=0:X1=X1/2
2140 X=A1+X1
2150 I2=I2+FNX(X):I4=I4+FNX(X+2*X1)
2155 I6=I6+FNX(X+4*X1):X=X+6*X1:IF X<B1 THEN 2150
2180 I9=X1*(41*I1+216*I2+27*I3+272*I4+27*I5+216*I6+82*I7)/140
2181 IF (B1-A1)/X1<=96 THEN 2200
2182 IF (B1-A1)/X1>760 THEN 2220
2184 IF ABS(I9)<.00001 THEN 2220
2185 IF I=I9 THEN 2220
2190 IF ABS((I-I9)/I)<=.000001 THEN 2220
2200 I=I9:GOTO 2100
2220 REM RESULT IN I9
2225 PRINT N,(B1-A1)/X1,I9*2/L
2230 RETURN
9000 PRINT "THIS PROGRAM DOES A FOURIER ANALYSIS OF"
9010 PRINT "ANY FUNCTION."
9020 PRINT "TO GIVE THE EQUIVALENT FUNCTION AS A SUM"
9030 PRINT "OF A FUNDIMENTAL SINE WAVE AND ITS HARMONICS"
9040 PRINT "DEFINE THE FUNCTION ON LINE 100"
9045 PRINT "AS FNA. THEN INPUT THE NO. OF HARMONICS"
9050 PRINT "AND THE PERIOD, AND THE DEFINITION OF"
9060 PRINT "THE FUNCTION AS ODD, EVEN OR NEITHER"
9070 PRINT "THE RESULTS CAN BE PRINTED IN TABLE OR"
9080 PRINT "EQUATION FORM AND A GRAPH OF THE HAMONICS"
9090 PRINT "CAN BE PLOTTED IF NEEDED":GOTO 60

 

Download modifikovaného programu:

Fourier analyze_modify.txt (3,53 kb)

(Pri x-tale= 4.9152MHz výpočty prebiehajú celkom rýchlo ...)

 

Download pôvodného programu zo spomenutou chybou (rovnaké riadky 212 a 216):

Fourier analyze.txt (3,51 kb)

______________________________________________________

Vaše hodnotenie, Rate post:

Comments

9/26/2022 12:19:06 PM #

trackback

Directory SBC6502

Directory SBC6502

Igi blog |

9/26/2022 3:47:03 PM #

dex

Ty řádky 212-216 jsou divné. Podmínka se opakuje.

dex Czech Republic |

9/27/2022 7:24:00 AM #

Admin

Po podrobnejšom skúmaní sa našlo riešenie - odpoveďou je oprava priamo v článku. Ďakujem !

Admin Slovakia |

Comments are closed

Info o autorovi

Volám sa Igor Gramblička, bydlisko: Bratislava, Slovakia. Môj nick: Igi. Blog je o mojich záujmoch, predtým som pracoval ako IT špecialista na počítačové siete a redakčné systémy pre viaceré denníky - až som pred rokmi nakoniec v jednom z nich zakotvil a kde som to potiahol až do konca mojej profesnej kariéry.

Rok, mesiac, počet článkov: