Programozási alapfeladatok gyűjteménye
1985 - Bárdos Attila, Körtvélyesi Gézáné
Tartalom
Előszó
1. Elemi algoritmusok
Soros algoritmusok
Feltételes és elágazásos algoritmusok
2. Ciklusok
Léptetéses Ciklusok
Feltételes ciklusok
Összetett ciklusok (Tömbkezelés)
Tablókészítés
3. Alapalgoritmusok
Maximum-minimum feladatok
Rendezés
Tömbök összeválogatása
Keresési eljárások
4. Adatfeldolgozási algoritmusok
Adatfeldolgozási alapalgoritmusok
Személyi nyilvántartási rendszer
Kidolgozandó feladatok
5. Vegyes feladatok
Kombinatorika
Játékok
444 programozási alapfeladatból álló feladatgyűjteményt tart a kezében az olvasó. Aki ilyen könyvet a kezébe vesz, az vagy tanulja, vagy tanítja a programozást. Mindkettőjük számára nyilvánvaló, hogy a programozás tulajdonképpen számítógépes problémamegoldás (tehát nem csupán kódolás), és hogy e téren is "gyakorlat teszi a mestert".
A számítógépes problémamegoldás elsajátítása terén - éppúgy, mint a problémamegoldás terén általában - nincs univerzális módszer, de igenis vannak olyan elsajátítható módszerek, fogások, "receptek", amelyek begyakorlása révén jártasságot szerezhetünk a további problémák megoldásában. A programozás ezen alapvető, nagyobb alkalmazási feladatoknál is használható módszereinek begyakorlásához kíván segítséget adni e könyv.
A feladatgyűjtemény célja az egymásra épülő programozási típusfeladatok széles skálájának bemutatása és az önálló feladatmegoldási munka segítése.
A feladatok nehézségi foka az egy-két utasításos "triviális" feladatelemektől a 2-300 utasításos, több eljárást is alkalmazó, jelentősebb adatmennyiséget megmozgató, közepes méretű és bonyolultságú programokéig terjed.
A feladatgyűjtemény
fejezeti csoportosításban, a fejezeteken belül pedig logikai és nehézségi sorrendben közli a megoldandó problémákat - követve a számítógépes problémamegoldásban való előrehaladás útját.
A feladatoknak egy részéhez megoldásokat, illetve megoldási ötleteket, segítséget is közlünk: ezek formája általában programterv, algoritmus, program vagy programrészlet.
Azt tanácsoljuk az olvasónak, hogy a megoldásokhoz csak a problémákkal való alapos foglalkozás után, valamilyen saját megoldás birtokában forduljanak, és hogy senki se tekintse egyedüli "jó" megoldásoknak őket. E megoldások, illetve megoldási ötletek célja ugyanis az önálló megoldások helyességének ellenőrzésén túl elsősorban a teljesen önálló megoldás kimunkálásához való segítségnyújtás.
Feladatgyűjteményünk kapcsolódik a SZÁMOK kiadásában 1977-ben megjelent Bárdos-Budinszky-Mérey-Nagy: A programozás alapjai c. tankönyvhöz, de elsősorban önálló gyakorlásra alkalmas, mivel megértésének ismereti feltétele nem haladja meg az átlagos középiskolái ismeretszintet.
Ha a felhasználó a könyv feladatait fejezetről fejezetre, a feladatok egymásraépülésének megfelelően összeállított sorrendben feldolgozza, az egyszerű feladatok megoldásait és megoldási tapasztalatait felhasználva eljuthat a már bonyolultabb problémákig, s így kellő jártasságot szerezhet a számítógépes alapfeladatok megoldásában.
Reméljük, hogy e feladattár minden érdeklődőnek segítséget nyújt, aki elindul a számítógépes problémamegoldás e kalandos és néha rögös, de mindig is érdekes útján. Ehhez a vállalkozáshoz sok sikert kívánnak, és a felhasználás során nyert tapasztalatokra alapozott minden segítő véleményt szívesen fogadnak
A SZERZŐK
1.1. Kör kerülete, területe
Számítsuk ki az R változóban megadott sugarú kör kerületét és területét. Az eredményt írassuk ki!
100 PROGRAM "Kor.bas"
110 INPUT PROMPT "A kor sugara: ":R
120 LET K=2*R*PI
130 LET T=R^2*PI
140 PRINT R;"cm sugaru kor"
150 PRINT TAB(6);"kerulete: ";K;"cm"
160 PRINT TAB(6);"terulete: ";T;"ncm"
1.2. Háromszög területe
Olvassuk be egy háromszög oldalának hosszát, és a hozzá tartozó magasságot. Számítsuk ki a háromszög területét!
100 PROGRAM "Haromsz1.bas"
110 INPUT PROMPT "Haromszog egy oldala (cm): ":A
120 INPUT PROMPT "Az oldalhoz tarozo magassag (cm): ":M
130 PRINT "A haromszog terulete: ";A*M/2;"ncm"
1.3. Kamatos kamat
Írjunk programot, amely kiírja a beolvasott összeg kamatos kamattal megnövekedett értékét beolvasott kamatláb és futamidő esetén! Az eredményt kerekítsük két tizedesjegyre.
A képlet:
100 PROGRAM "KKamat.bas"
110 PRINT "Kamatos kamat szamitasa"
120 INPUT PROMPT "Osszeg: ":OSSZEG
130 INPUT PROMPT "Kamatlab: ":LAB
140 INPUT PROMPT "Futamido: ":EV
150 LET ERTEK=OSSZEG*(1+LAB/100)^EV
160 PRINT "Ertek: ";ROUND(ERTEK,2);"Ft"
1.4. Sebesség
Olvassunk be egy sebességadatot km/h-ban, írjuk ki m/s-ban, mérföld/órában és csomóban!
100 PROGRAM "Sebesseg.bas"
110 PRINT "Sebesseg atvaltas"
120 INPUT PROMPT "Sebesseg (km/h): ":V
130 PRINT V/3.6;" m/s"
150 PRINT V/1.609;" mph"
160 PRINT V/1.852;" csomo"
1.5. Időegység átváltás
Olvassunk be egy időtartamot négy változóba (nap, óra, perc, másodperc). Írjuk ki ezt az időtartamot másodpercbe átszámolva!
100 PROGRAM "Idotart.bas"
110 PRINT "Idotartam:"
120 INPUT PROMPT " Nap: ":N
130 INPUT PROMPT " Ora: ":O
140 INPUT PROMPT " Perc: ":P
150 INPUT PROMPT " Masodperc: ":M
160 LET T=N*86400+O*3600+P*60+M
160 PRINT "Idotartam masodpercben:";T
1.6. Csere
Írjunk eljárást, amely felcseréli két változó értékét!
100 DEF SWAP(REF A,REF B)
110 LET T=A:LET A=B:LET B=T
120 END DEF
1.7. Részkarakterlánc kiírása
Vizsgáljuk meg, hogy egy beolvasott karakterlánc első karaktere szám-e. A maradék karakterekből írjunk ki annyit amennyit az első karakter jelez.
100 PROGRAM "Karlanc.bas"
110 INPUT PROMPT "Szovegfuzer: ":ST$
120 PRINT ST$(2:VAL(ST$(:1))+1)
1.8. Maffia (Osztozás)
Adva van egy 5 tagú maffia G1, G2, G3, G4 és G5 gengszterekkel, valamint MRBIG, a Nagy Főnök, aki fedezi az üzelmeiket és a távolból szervezi az akciókat. A gengszterek dolgozhatnak csoportosan, de a saját szakállukra is. Így az elmúlt évben mindegyik különböző: H1, H2, H3 H4 és H5 hasznot hozott a konyhára. Ezt ők becsületesen be is fizették a svájci bankszámlára. Tehát az év végén BR = H1+H2+H3+H4+H5.
Ezt az összeget a levonandók levonása után igazságosan, a hasznok arányában akarják elosztani. A levonandók az alábbiak:
Megállapodtak, hogy az osztozkodást programmal végzik el, és a programot a legfiatalabb G1 gengszter készíti el. Tiszteletdíjuk a kerekítésből származó maradékot ajánlották fel, Milyen programot írt a legfiatalabb gengszter?
100 PROGRAM "Maffia.bas"
110 INPUT PROMPT "A gengszterek altal hozott hasznok dollarban: ":H1,H2,H3,H4,H5
120 LET H,BR=H1+H2+H3+H4+H5
130 PRINT "Osszeg ",,,BR
140 LET MRBIG=INT(BR*.45):LET BR=BR-MRBIG
150 LET CS=INT(5*.05*BR):LET BR=BR-CS
160 LET G2=INT(H2*BR/H):LET G3=INT(H3*BR/H)
170 LET G4=INT(H4*BR/H):LET G5=INT(H5*BR/H)
180 LET G1=BR-(G2+G3+G4+G5)
190 PRINT "Gengszterfonok:",,MRBIG
200 PRINT "Csuszopenz:",,CS
210 PRINT "Elso gengszter:",,G1
220 PRINT "Masodik gengszter:",G2
230 PRINT "Harmadik gengszter:",G3
240 PRINT "Negyedik gengszter:",G4
250 PRINT "Otodik gengszter:",G5
Feltételes és elágazásos algoritmusok
1.9. Számtani közép és mértani közép
Olvassunk be a rendszer bemenetéről két valós számot. Írjuk ki a számtani közepüket, - ha a két szám pozitív - a mértani közepüket, és harmonikus közepüket!
100 PROGRAM "Kozep.bas"
110 INPUT PROMPT "A =":A
120 INPUT PROMPT "B =":B
130 PRINT "Szamtani kozepuk: ",(A+B)/2
140 IF A>0 AND B>0 THEN PRINT "Mertani kozepuk: ",SQR(A*B)
150 PRINT "Harmonikus kozepuk: ",2/(1/A+1/B)
1.10. Lóerő - kilowatt átszámítás
Készítsünk programot lóerő - kilowatt, kilowatt - lóerő átszámításra. Gombnyomással lehessen választani, melyik mértékegységből, melyikbe kívánunk átszámolni.
100 PROGRAM "KW-Le.bas"
110 DO
120 PRINT "(1) Loero -> KW":PRINT "(2) KW -> Loero":PRINT "ESC - vege":PRINT
130 DO
140 LET KEY$=INKEY$
150 LOOP UNTIL KEY$="1" OR KEY$="2" OR KEY$=CHR$(27)
160 IF KEY$="1" THEN
170 INPUT PROMPT "Loero: ":KEY$
180 LET BE=VAL(KEY$)
190 PRINT BE;"loero =";BE*.74;"KW"
200 ELSE IF KEY$="2" THEN
210 INPUT PROMPT "KW: ":KEY$
220 LET BE=VAL(KEY$)
230 PRINT BE;"KW =";BE*1.34;"loero"
240 END IF
250 PRINT
260 LOOP UNTIL KEY$=CHR$(27)
1.11. Osztályzat
Olvassunk be egy tanulói osztályzatot, és írjuk ki a szöveges megfelelőjét!
100 PROGRAM "Osztalyz.bas"
110 INPUT PROMPT "Osztalyzat: ":A
120 SELECT CASE A
130 CASE 1
140 PRINT "Elegtelen"
150 CASE 2
160 PRINT "Elegseges"
170 CASE 3
180 PRINT "Kozepes"
190 CASE 4
200 PRINT "jo"
210 CASE 5
220 PRINT "Jeles"
230 CASE ELSE
240 PRINT "Hibas erdemjegy!"
250 END SELECT
1.12. Minősítés
Egy beolvasott pontszám (P) alapján a következő minősítést adjuk:
100 PROGRAM "Ertekel.bas"
110 INPUT PROMPT "Pontszam: ":P
120 SELECT CASE P
130 CASE 1 TO 49
140 PRINT "Nem felelt meg"
150 CASE 50 TO 74
160 PRINT "Alapfokon megfelelt"
170 CASE 75 TO 89
180 PRINT "Kozepfokon megfelelt"
190 CASE 90 TO 100
200 PRINT "Felsofokon megfelelt"
210 CASE ELSE
220 PRINT "Hibas pontszam!"
230 END SELECT
1.13. Magánhangzó-mássalhangzó
Írjunk programrészletet, amely egy A$ változóban tárolt karakterről eldönti, hogy az magánhangzó, mássalhangzó, számjegy, vagy egyéb írásjel!
...
120 SELECT CASE UCASE$(A$)
130 CASE "0" TO "9"
140 PRINT "Szamjegy"
150 CASE "A","E","I","O","U"
160 PRINT "Maganhangzo"
170 CASE "B" TO "D","F" TO "H","J" TO "N","P" TO "T","V" TO "Z"
180 PRINT "Massalhangzo"
190 CASE ELSE
200 PRINT "Irasjel"
210 END SELECT
1.14. Előjel vizsgálat
Olvassunk be két számot, majd a két szám előjelének megfelelően írjuk ki a következő üzenetek egyikét:
100 PROGRAM "Elojel.bas"
110 INPUT PROMPT "A = ":A
120 INPUT PROMPT "B = ":B
130 IF SGN(A)=SGN(B) THEN
140 PRINT "Azonos elojeluek"
150 ELSE
160 PRINT "Kulonbozo elojeluek."
170 END IF
1.15. Páros-páratlan
Írjunk függvényt, amely igaz értéked ad vissza, ha a paraméterként megadott szám páratlan, egyéb esetben hamis értéket!
100 DEF ODD(X)
110 IF MOD(X,2)=0 THEN
120 LET ODD=0
130 ELSE
140 LET ODD=-1
150 END IF
160 END DEF
1.16. Háromszög területe, kerülete
Olvassuk be egy háromszög oldalainak hosszát, és a Herón-képlet
segítségével számítsuk ki és írassuk ki a háromszög területét és kerületét!
s=(a+b+c)/2
ahol a, b, c a háromszög oldalai, s pedig a kerület fele. Jelezzük, ha a háromszög nem szerkeszthető!
100 PROGRAM "Haromsz2.bas"
110 PRINT "A haromszog oldalai:"
120 INPUT PROMPT " A oldal: ":A
130 INPUT PROMPT " B oldal: ":B
140 INPUT PROMPT " C oldal: ":C
150 IF A+B>C AND A+C>B AND B+C>A THEN
160 LET S=(A+B+C)/2
170 LET T=SQR(S*(S-A)*(S-B)*(S-C))
180 LET K=A+B+C
190 PRINT " Terulete: ";T;" ncm"
200 PRINT " Kerulete: ";K;" cm"
210 ELSE
220 PRINT "A haromszog nem szerkesztheto!"
230 END IF
1.17. Haromszög szögeinek kiszámítása
Adott három szakasz. Határozzuk meg a szakaszokból szerkesztett háromszög szögeit! Ha a három szakaszból nem szerkeszthető háromszög, jelezze a program!
A három szakaszt először nagyság szerint sorbarendezzük. Erre azért van szükség, hogy a legnagyobb oldallal szemközti szöget meg tudjuk határozni koszinusztétel segítségével. A következő szöget szinusztétellel számítunk ki. A harmadik szöget - a másik két szög ismeretében - kivonással (is) számolhatjuk.
100 PROGRAM "Haromsz3.bas"
110 OPTION ANGLE DEGREES
120 INPUT PROMPT "A= ":A
130 INPUT PROMPT "B= ":B
140 INPUT PROMPT "C= ":C
150 IF A<B THEN LET T=A:LET A=B:LET B=T
160 IF B<C THEN LET T=B:LET B=C:LET C=T
170 IF A<B THEN LET T=A:LET A=B:LET B=T
180 IF B+C<=A THEN
190 PRINT "Nem szerkesztheto haromszog!"
200 ELSE
210 LET X=ACOS((A^2+B^2-C^2)/(2*A*B))
220 LET Y=ASIN(SIN(X)*B/C)
230 LET Z=180-X-Y
240 PRINT " Alfa = ";X;"fok"
250 PRINT " Beta = ";Y;"fok"
260 PRINT "Gamma = ";Z;"fok"
270 END IF
1.18. Másodfokú egyenlet valós megoldása
Készítsünk programot az ax^2 + bx + c = 0 másodfokú egyenlet valós gyökeinek meghatározására a megoldóképlet alapján:
Számoljuk ki minden esetben a gyököket! Ha nincs valós gyök, küldjünk hibaüzenetet!
100 PROGRAM "Masodfe.bas"
110 PRINT "Masodfoku egyenlet megoldasa"
120 INPUT PROMPT "A = ":A
130 INPUT PROMPT "B = ":B
140 INPUT PROMPT "C = ":C
150 IF A=0 THEN
160 IF B=0 THEN
170 IF C=0 THEN
180 PRINT "Minden valos szam gyok."
190 ELSE
200 PRINT "Nincs valos gyok!"
210 END IF
220 ELSE
230 PRINT "Egyetlen valos megoldas van: ";-C/B
240 END IF
250 ELSE
260 LET D=B^2-4*A*C
270 IF D<0 THEN
280 PRINT "Nincs valos gyok!"
290 ELSE
300 LET SQD=SQR(D)
310 LET X1=(-B+SQD)/(2*A)
320 LET X2=(-B-SQD)/(2*A)
330 PRINT " X1 = ";X1:PRINT " X2 = ";X2
350 END IF
360 END IF
1.19. Kétismeretlenes lineáris egyenletrendszer
Adva van egy kétismeretlenes egyenletrendszer:
ax + by = c
dx + ey = f
Az a, b, c, d, e, f értékeket olvassuk be és számítsuk ki az x és y gyökök értékét!
x = (ce-bf)/(ae-bd) és y = (af-cd)/(ae-bd)
Vigyázzunk a nullával való osztásra!
100 PROGRAM "LinEgy.bas"
110 PRINT "Linearis egyenletrendszer megoldasa"
120 PRINT "ax+by = c":PRINT "dx+ey = f"
130 INPUT PROMPT "A,B,C,D,E,F = ":A,B,C,D,E,F
140 LET DET=A*E-B*D
150 IF DET<>0 THEN
160 PRINT "X=";(C*E-B*F)/DET
170 PRINT "Y=";(A*F-C*D)/DET
180 ELSE
190 PRINT "A determinans nulla!"
200 END IF
1.20. Húsvét napjának kiszámítása
Számítsuk ki, hogy adott évben mely napra esik húsvétvasárnap!
A húsvét kiszámítására a legismertebb algoritmus Gauss módszere:
Az év sorszámát jelöljük Y-nal. Először számoljuk ki a, b és c egész számokat:
Majd ezekből a következő értékeket:
d = (19a + M) mod 30
e = (2b + 4c + 6d + N) mod 7
A Gergely-naptár szerint M és N a következő táblázatból kapható:
Évek M N 1583-1699 22 2 1700-1799 23 3 1800-1899 23 4 1900-2099 24 5 2100-2199 24 6 2200-2299 25 0
Ha d+e < 10 akkor márciusnak (d+e+22)-edik napja húsvét, különben április (d+e-9)-edik napja.
A következő kivételeket kell figyelembe venni:
100 PROGRAM "Husvet.bas"
110 DO
120 INPUT PROMPT "Melyik ev? (1583-2299) ":EV$
130 LET EV=INT(VAL(EV$))
140 LOOP UNTIL EV>1582 AND EV<2300
150 LET A=MOD(EV,19):LET B=MOD(EV,4):LET C=MOD(EV,7)
160 SELECT CASE EV
170 CASE 1583 TO 1699
180 LET M=22:LET N=2
190 CASE 1700 TO 1799
200 LET M=23:LET N=3
210 CASE 1800 TO 1899
220 LET M=23:LET N=4
230 CASE 1900 TO 2099
240 LET M=24:LET N=5
250 CASE 2100 TO 2199
260 LET M=24:LET N=6
270 CASE 2200 TO 2299
280 LET M=25:LET N=0
290 END SELECT
300 LET D=MOD((19*A+M),30):LET E=MOD((2*B+4*C+6*D+N),7)
310 IF D+E<10 THEN
320 LET HO=3:LET NAP=D+E+22
330 ELSE
340 LET HO=4:LET NAP=(D+E-9)
350 END IF
360 IF HO=4 AND NAP=26 THEN LET NAP=19
370 IF HO=4 AND NAP=25 AND D=28 AND E=6 AND A>10 THEN LET NAP=18
380 PRINT "Husvet: ";EV;HO;NAP
1.21. Öröknaptár
Írjunk öröknaptár függvényt, amely 1582-től 2499-ig tetszőleges dátumról megmondhatja, hogy a hét melyik napjára esik (1 - hétfő, 2 - kedd, ..., 7 - vasárnap). Bemenő paraméterek E - év, H - hónap, N - nap.
100 DEF ONAPTAR(E,H,N)
110 IF H<3 THEN LET E=E-1:LET H=H+12
120 LET E=INT(365.25*E)-INT(E/100)+INT(E/400)+31*(H-1)-INT(.4*H+2.3)+N+1721060
130 LET ONAPTAR=E-INT(E/7)*7+1
140 END DEF
1.22. Két dátum között eltelt napok száma
Írjunk programot, amely kiszámolja két megadott dátum között eltelt napok számát!
Az 1.21. feladatban elkészített öröknaptár függvénnyel könyen megoldhatjuk a feladatot:
100 PROGRAM "NAPOK.BAS"
110 DEF NAPOK(E,H,N)
120 IF H<3 THEN LET E=E-1:LET H=H+12
130 LET NAPOK=INT(365.25*E)-INT(E/100)+INT(E/400)+31*(H-1)-INT(.4*H+2.3)+N+1721060
140 END DEF
150 PRINT NAPOK(2016,8,20)-NAPOK(1973,12,24)
Ha a 150 sorban lévő kifejezést kiegészítjük egy ABS függvénnyel, a két dátum tetszőleges sorrendben megadható:
150 PRINT ABS(NAPOK(1973,12,24)-NAPOK(2016,08,20))
2.1. Összegzés
Számítsuk ki az első n szám összegét!
100 PROGRAM "Osszeg.bas"
110 LET N=100:LET SUM=0
120 FOR I=1 TO N
130 LET SUM=SUM+I
140 NEXT
150 PRINT SUM
Egyszerűbb megoldás:
100 LET N=100
110 PRINT N*(N+1)/2
2.2. Számtani sorozat
Olvassunk be egy n elemű T vektorba számokat. Állapítsuk meg, hogy a vektor elemei számtani sorozatot alkotnak-e! (Egy legalább három számból álló - akár véges, akár végtelen - sorozatot akkor nevezünk számtani sorozatnak, ha a szomszédos elemek különbsége (a sorozatra jellemző) állandó.)
100 PROGRAM "Sorozat.bas"
110 LET N=5
120 NUMERIC T(1 TO N)
130 FOR I=1 TO N
140 PRINT I;:INPUT PROMPT "elem: ":T(I)
150 NEXT
160 LET D=T(2)-T(1):LET SOROZAT=-1
170 FOR I=3 TO N
180 IF T(I)-T(I-1)<>D THEN LET SOROZAT=0:EXIT FOR
190 NEXT
200 IF SOROZAT THEN
210 PRINT "A sorozat szamtani sorozat."
220 ELSE
230 PRINT "A sorozat nem szamtani sorozat."
240 END IF
2.3. Fibonacci-számok
Állítsuk elő a Fibonacci-számsorozat első 36 elemét! A Fibonacci-számok sorozatának eleje: 0, 1, 1, 2, 3, 5, 8, 13, 21, . ; az első kettőt kivéve a sorozat bármely eleme az előző két elem összegeként állítható elő.
100 PROGRAM "Fibonacc.bas"
110 LET F=0:LET PREV=1
120 PRINT F;
130 FOR Z=1 TO 35
140 LET NXT=F+PREV
150 LET PREV=F:LET F=NXT
160 PRINT F;
170 NEXT
2.4. Szorzótábla
Jelenítsünk meg a képernyőn 10x10-es szorzótáblát!
100 PROGRAM "szorzot.bas"
110 TEXT 80
120 FOR I=1 TO 10
130 FOR J=1 TO 10
140 PRINT USING " £££":I*J;
150 NEXT
160 PRINT
170 NEXT
Másik megoldás, fejléccel:
100 PROGRAM "Szorzot2.bas"
110 TEXT 80
120 PRINT TAB(7);
130 FOR I=1 TO 12
140 PRINT USING " £££":I;
150 NEXT
160 PRINT AT 2,5:"----------------------------------------------------"
170 FOR I=1 TO 12
180 PRINT USING "£££ |":I;:PRINT TAB(I*4+3);
190 FOR J=I TO 12
200 PRINT USING " £££":I*J;
210 NEXT
220 PRINT
230 NEXT
2.5. Faktoriális számítás
Írjunk függvényt, amely kiszámítja a paraméter faktoriálisát!
100 DEF FACT(X)
110 FOR Y=2 TO X-1
120 LET X=X*Y
130 NEXT
140 LET FACT=X
150 END DEF
2.6. Cím középre illesztése
Olvassunk be egy max. 32 karakter hosszú címet (karakterfüzért), majd képernyőtörlés után írjuk ki a képernyő tetejére, középre igazítva, a megfelelő számú kötőjel (-) karakterrel aláhúzva.
100 PROGRAM "Cimsor.bas"
110 DO
120 INPUT PROMPT "Cim (max. 32 karakter): ":CIM$
130 LET L=LEN(CIM$)
140 LOOP UNTIL L<33 AND L>0
150 CLEAR SCREEN
160 PRINT CIM$;CHR$(241)
170 FOR I=1 TO L
180 PRINT "-";
190 NEXT
200 PRINT CHR$(241)
2.7. Hőmérséklet átszámítás
Készítsünk táblázatot, amely 32 Celsius foktól -9 fokig feltünteti a hőmérsékletet Fahrenheit- és Kelvin-fokban.
Átszámítási képletek:
F = 1.8*C+32
K= C+273.15
100 PROGRAM "Homersek.bas"
110 LET FEJLEC$=" Celsius Fahrenheit Kelvin":LET T=3
120 TEXT 80
130 PRINT FEJLEC$;TAB(48);FEJLEC$
140 FOR C=32 TO-9 STEP-1
150 PRINT TAB(T);
160 PRINT USING "£££ £££.£ £££.££":C;1.8*C+32;C+273.15
170 IF C=12 THEN LET T=50:PRINT AT 2,T:;
180 NEXT
2.8. Pénzváltás
Olvassunk be egy pénzösszeget (legyen öttel osztható egész szám!). Határozzuk meg, hogy a legkevesebb címlet felhasználásával az egyes címletekből hányat kell felhasználni az összeg pontos kifizetéséhez!
100 PROGRAM "Penzvalt.bas"
110 PRINT "Penzvaltas"
120 DO
130 INPUT PROMPT "Osszeg: ":OSZ
140 LOOP UNTIL OSZ>=5 AND REM(OSZ,5)=0
150 FOR I=1 TO 12
160 READ PENZ
170 LET DB=INT(OSZ/PENZ)
180 IF DB>0 THEN
190 PRINT USING "£££££":PENZ;:PRINT " Ft-os: ";DB;"db"
200 LET OSZ=OSZ-DB*PENZ
210 END IF
220 NEXT
230 DATA 20000,10000,5000,2000,1000,500,200,100,50,20,10,5
2.9. Időegység átváltás II.
A másodpercben megadott időintervallumot írjuk ki hét, nap, óra, perc, másodperc formában. A nulla értékeket ne jelenítse meg a program!
100 PROGRAM "Masodper.bas"
110 NUMERIC T(1 TO 5),MP,EGYS
120 STRING T$(1 TO 5)*4
130 LET T(1)=604800:LET T(2)=86400:LET T(3)=3600:LET T(4)=60:LET T(5)=1
140 LET T$(1)="het":LET T$(2)="nap":LET T$(3)="ora":LET T$(4)="perc":LET T$(5)="mp"
150 INPUT PROMPT "Idotartam masodpercben: ":MP
160 PRINT MP;"mp =";
170 FOR I=1 TO 5
180 IF MP>=T(I) THEN
190 LET EGYS=INT(MP/T(I)):LET MP=MOD(MP,T(I))
200 PRINT EGYS;T$(I);
210 IF I<4 AND MP>0 THEN PRINT ",";
220 END IF
230 NEXT
240 PRINT
2.10. Kamatos kamat
Írjunk programot, amely kiszámítja és kiírja a beolvasott összeg kamatos kamattal megnövekedett értékét, a beolvasott kamatláb esetén, a szintén beolvasott futamidő intervallumában, minden év végén.
100 PROGRAM "KKamat2.bas"
110 PRINT "Kamatos kamat szamitas eves bontasban"
120 INPUT PROMPT "Osszeg: ":OSSZEG
130 INPUT PROMPT "Kamatlab (%): ":KAMATLAB
140 INPUT PROMPT "Ev ":EV
150 PRINT
160 FOR I=1 TO EV
170 LET OSSZEG=OSSZEG*(1+KAMATLAB/100)
180 PRINT USING "£££":I;:PRINT ". ev vegen az osszeg:";
190 PRINT USING "££££££££££££.££":OSSZEG
200 NEXT
2.11. Kétismeretlenes egyenlet
Számítsuk ki azokat az x y értékeket, amelyekre igaz az ax+by=c egyenlőség. a b és c értékét olvassuk be.
100 PROGRAM "Egyenlet.bas"
110 PRINT "ax+by=c megoldasa"
120 INPUT PROMPT " A= ":A
130 INPUT PROMPT " B= ":B
140 INPUT PROMPT " C= ":C
150 FOR X=1 TO C/A
160 FOR Y=1 TO C/B
170 IF A*X+B*Y=C THEN PRINT "X =";X;TAB(12);"Y =";Y
180 NEXT
190 NEXT
2.12. Karakterlánc megfordítása
Olvassunk be egy karakterláncot, majd írjuk ki megfordítva, valamint a nagybetűs és kisbetűs alakját is.
100 PROGRAM "Fordit.bas"
110 INPUT PROMPT "Kerek egy szovegfuzert: ":ST$
120 FOR I=LEN(ST$) TO 1 STEP-1
130 PRINT ST$(I);
140 NEXT
150 PRINT :PRINT UCASE$(ST$)
160 PRINT LCASE$(ST$)
2.13. Vektor "megfordítása"
Írjunk programrészletet, amely az N elemszámú A vektor elemeinek sorrendjét megfordítja. Például egy 11 elemből álló vektor esetében ez így ábrázolható:
...
110 LET N=12
120 NUMERIC A(1 TO N)
...
190 DEF FORDIT
200 FOR I=1 TO INT(N/2)
210 LET S=A(I)
220 LET A(I)=A(N+1-I)
230 LET A(N+1-I)=S
240 NEXT
250 END DEF
...
2.14. Ismétlődő elemek eltávolítása
Egy rendezett sorozatból távolítsuk el az ismétlődő elemeket! Jelenítsük meg az eredeti sorozat elemeit, majd a "tisztázott" sorozatot is.
100 PROGRAM "Ismetlod.bas"
110 RANDOMIZE
120 NUMERIC VEKT(1 TO 20),TOP
130 LET TOP=TOLT(VEKT)
140 CALL KIIR(VEKT,TOP)
150 LET TOP=TOROL(VEKT)
160 CALL KIIR(VEKT,TOP)
170 DEF KIIR(REF A,N)
180 FOR I=1 TO N
190 PRINT A(I);
200 NEXT
210 PRINT
220 END DEF
230 DEF TOLT(REF A)
240 LET TOLT=UBOUND(A):LET A(LBOUND(A))=1
250 FOR I=LBOUND(A)+1 TO UBOUND(A)
260 LET A(I)=A(I-1)+RND(3)
270 NEXT
280 END DEF
290 DEF TOROL(REF A)
300 LET ST=0
310 FOR I=LBOUND(A)+1 TO UBOUND(A)
320 IF A(I-1)=A(I) THEN LET ST=ST+1
330 IF ST>0 THEN LET A(I-ST)=A(I)
340 NEXT
350 LET TOROL=UBOUND(A)-ST
360 END DEF
2.15. Vavevi beszéd
Írjunk programot, amely beolvas egy ékezetes karakterek nélküli mondatot és kiírja a következőképen átalakítva: a szöveg magánhangzóit lecseréli az alábbi módon:
a
ava, e
Például: Ma szep idonk van.
Visszaírja: Mava szevep idiovo vavan.
100 PROGRAM "Vavevi.bas"
110 INPUT PROMPT "Mondat: ":M$
120 LET M2$=""
130 FOR I=1 TO LEN(M$)
140 SELECT CASE LCASE$(M$(I))
150 CASE "a","e","i","o","u"
160 LET M2$=M2$&M$(I)&"v"&LCASE$(M$(I))
170 CASE ELSE
180 LET M2$=M2$&M$(I)
190 END SELECT
200 NEXT
210 PRINT M2$
2.16. Év napjai
Olvassunk be egy dátumot. Ha a megadott dátum helyes, számítsuk ki, hogy a beolvasott dátum az év hányadik napja! Ne használjuk az 1.21-es feladatra adott megoldást!
Ehhez tudnunk kell, melyek a szökőévek. Szökőévek a következők: minden néggyel osztható év, kivéve a százzal is oszthatókat. Szökőévek viszont a 400-zal osztható évek. Vagyis a századfordulók évei közül csak azok szökőévek, amelyek 400-zal is oszthatók.
100 PROGRAM "Evnap.bas"
110 DO
120 LET HIBA=0
130 INPUT PROMPT "Ev: ":IN$
140 LET EV=INT(VAL(IN$))
150 INPUT PROMPT "Honap: ":IN$
160 LET HO=INT(VAL(IN$))
170 INPUT PROMPT "Nap: ":IN$
180 LET NP=INT(VAL(IN$))
190 IF EV<1600 OR HO<1 OR HO>12 OR NP<0 OR NP>NAPOS(HO) THEN LET HIBA=-1
200 IF HIBA THEN PRINT "Hibas datum!":PRINT
210 LOOP WHILE HIBA
220 LET NAP=0
230 FOR H=1 TO HO-1
240 LET NAP=NAP+NAPOS(H)
250 NEXT
260 LET NAP=NAP+NP
270 PRINT "Ez a datum az ev ";NAP;". napja."
280 END
290 DEF SZOKOEV(E)=MOD(E,4)=0 AND MOD(E,100)<>0 OR MOD(E,400)=0
300 DEF NAPOS(H)
310 SELECT CASE H
320 CASE 4,6,9,11
330 LET NAPOS=30
340 CASE 2
350 IF SZOKOEV(EV) THEN
360 LET NAPOS=29
370 ELSE
380 LET NAPOS=28
390 END IF
400 CASE ELSE
410 LET NAPOS=31
420 END SELECT
430 END DEF
A feladat megoldható az 1.21. feladatra adott programmal is. Ha az 1.21-es programot kiegészítjük az itt elkészített SZOKOEV és NAPOS eljárásokkal, az adatbevitel bolondbiztossá tehető.
2.17. Pascal-háromszög
Állítsuk elő programmal a Pascal-háromszög első 13 sorát! A háromszöget a következő egyszerű módon lehet megszerkeszteni: A nulladik sorba csak be kell írni az 1-est. A következő sorok szerkesztésénél a szabály a következő: az új számot úgy kapjuk meg, ha összeadjuk a felette balra és felette jobbra található két számot. Ha az összeg valamelyik tagja hiányzik (sor széle), akkor nullának kell tekinteni.
Használjuk fel a programunkban azt az ismeretet, hogy ezek a számok az úgynevezett binomiális együtthatók, melyek a következő szabály alapján számíthatók ki:
100 PROGRAM "Pascal.bas"
110 TEXT 80
120 LET SOR=12
130 FOR I=0 TO SOR
140 LET C=1
150 PRINT TAB(37-I*3);
160 FOR K=0 TO I
170 PRINT USING " ££££":C;
180 LET C=C*(I-K)/(K+1)
190 NEXT
200 PRINT
210 NEXT
2.18. Zsebpénz
Egy gyerek a szüleitől P Ft zsebpénzt kapott. Az első napon 5 Ft-ot költött, majd ezután minden nap 1 Ft-tal többet. Hány napig tudta ezt a költekezést folytatni, és mennyi "töredék" pénze maradt?
100 PROGRAM "Zsebpenz.bas"
110 INPUT PROMPT "Zsebpenz: ":P
120 LET KI=5:LET NAP=1
130 DO WHILE P>=KI
140 LET P=P-KI
150 PRINT NAP;"nap, kiadas:";KI;"Ft, maradek:";P;"Ft."
160 LET KI=KI+1:LET NAP=NAP+1
170 LOOP
2.19. Három elem rendezése
Írjunk eljárást, ami három tetszőleges numerikus változót sorrendbe rendez. Cserélgessük a három változó tartalmát, amíg A <= B <= C be nem következik!
100 LET X=77444:LET Y=-12:LET Z=0
110 CALL SHORT(X,Y,Z)
120 PRINT X;Y;Z
130 DEF SWAP(REF A,REF B)
140 LET T=A:LET A=B:LET B=T
150 END DEF
160 DEF SHORT(REF A,REF B,REF C)
170 FOR I=1 TO 2
180 IF A>B THEN CALL SWAP(A,B)
190 IF B>C THEN CALL SWAP(B,C)
200 NEXT
210 END DEF
2.20. Számsorozat rendezettsége
Olvassunk be egy pozitív egész számokból álló számsorozatot 0 végjelig. Állapítsuk meg, hogy a sorozat növekvő, csökkenő, egyenlő, vagy rendezetlen! A növekvő illetve csökkenő rendezettségnél az egyenlő számokat is megengedjük. Ha a sorozatról menet közben kiderül, hogy rendezetlen, fejezzük be a bevitelt!
100 PROGRAM "Szamsor.bas"
110 PRINT "Kerem a szamokat, megnezem, rendezett-e a sorozat:"
120 INPUT PROMPT " 1 . szam: ":AKT
130 LET EL=AKT:LET REND$="egyenlo":LET NR=1
140 DO WHILE AKT<>0 AND REND$<>"rendezetlen"
150 SELECT CASE REND$
160 CASE "egyenlo"
170 IF EL<AKT THEN LET REND$="novekvo"
180 IF EL>AKT THEN LET REND$="csokkeno"
190 CASE "novekvo"
200 IF EL>AKT THEN LET REND$="rendezetlen"
210 CASE "csokkeno"
220 IF EL<AKT THEN LET REND$="rendezetlen"
230 END SELECT
240 IF REND$<>"rendezetlen" THEN
250 LET EL=AKT:LET NR=NR+1
260 PRINT NR;:INPUT PROMPT ". szam: ":AKT
270 END IF
280 LOOP
290 PRINT "A sorozat ";REND$
2.21. Legnagyobb közös osztó
Az euklideszi algoritmus felhasználásával határozzuk meg, hogy a két beolvasott pozitív egész értékeknek mi a legnagyobb közös osztója (LNKO)! Határozzuk meg továbbá a két szám legkisebb közös többszörösét (LKKT)!
Az euklideszi algoritmus első lépésében maradékosan osztjuk A-t B-vel, majd az előbbi maradékot az új maradékkal, és így tovább, mindig az osztót a maradékkal. A maradék véges sok lépés után nulla lesz, hiszen amíg nem nulla, addig minden lépésben legalább eggyel csökkenni fog. A keresett legnagyobb közös osztó az utolsó nem nulla maradék.
Az algoritmust megvalósító eljárások:
...
340 DEF LNKO(A,B)
350 DO WHILE B>0
360 LET T=B
370 LET B=MOD(A,B)
380 LET A=T
390 LOOP
400 LET LNKO=A
410 END DEF
420 DEF LKKT(A,B)=(A*B)/LNKO(A,B)
...
2.22. Törzstényezőkre bontás
Olvassunk be egy egész számot és határozzuk meg a törzstényezőit!
Az algoritmus:
A kiírásnál arra kell figyelnünk, hogy az utolsó osztáskor a szám tartalma egy lesz-e. Ha egy feltételes utasításban megvizsgáljuk, hogy a szám tartalma 1 lett, akkor az utolsó osztó után nem írunk csillagot (szorzás jelet).
100 PROGRAM "Torzst1.bas"
110 TEXT 80
120 PRINT "Torzstenyezokre bontas"
130 INPUT PROMPT "Szam: ":SZAM
140 PRINT "Torzstenyezoi: ";
150 DO WHILE SZAM<>1
160 LET OSZTO=2
170 DO WHILE MOD(SZAM,OSZTO)<>0
180 LET OSZTO=OSZTO+1
190 LOOP
200 LET SZAM=SZAM/OSZTO
210 IF SZAM=1 THEN
220 PRINT OSZTO
230 ELSE
240 PRINT OSZTO;"*";
250 END IF
260 LOOP
2.23. Törzstényezőkre bontás II.
Olvassunk be egy egész számot és határozzuk meg a törzstényezőit! Az eredményt hatványkitevős alakban jelenítsük meg.
100 PROGRAM "Torzst2.bas"
110 TEXT 80
120 PRINT "Torzstenyezokre bontas"
130 DO
140 PRINT
150 INPUT PROMPT "Szam: ":SZAM
160 PRINT "Torzstenyezoi: ";TORZST$(SZAM)
170 LOOP
180 DEF TORZST$(SZAM)
190 LET ELOZO,ELSO=2:LET HATV=0:LET T$=""
200 DO WHILE SZAM<>1
210 LET OSZTO=2
220 DO WHILE MOD(SZAM,OSZTO)<>0
230 LET OSZTO=OSZTO+1
240 LOOP
250 IF ELSO THEN
260 LET ELOZO=OSZTO:LET ELSO=0
270 LET T$=T$&STR$(OSZTO)
280 END IF
290 IF ELOZO=OSZTO THEN
300 LET HATV=HATV+1
310 ELSE
320 IF HATV>1 THEN
330 LET T$=T$&"^"&STR$(HATV)&" * "&STR$(OSZTO)
340 LET HATV=1
350 ELSE
360 LET T$=T$&" * "&STR$(OSZTO)
370 END IF
380 END IF
390 LET SZAM=SZAM/OSZTO
400 IF SZAM=1 AND ELOZO=OSZTO AND HATV>1 THEN LET T$=T$&"^"&STR$(HATV)
410 LET ELOZO=OSZTO
420 LOOP
430 LET TORZST$=T$
440 END DEF
2.24. Számtani-mértani közép
Készítsünk függvényt, amely megadja két pozitív valós szám számtani-mértani közepét.
100 DEF AGM(A,G)
110 DO
120 LET TA=A
130 LET A=(A+G)/2:LET G=SQR(TA*G)
140 LOOP UNTIL A=TA
150 LET AGM=A
160 END DEF
Összetett ciklusok (Tömbkezelés)
2.25. Tömb feltöltése
Hozzunk létre egy kétdimenziós tömböt, A(5,7)-et. Töltsük fel és jelenítsük meg a tömböt úgy, hogy minden eleme a két indexének összegét vegye fel!
100 PROGRAM "Feltolt.bas"
110 NUMERIC A(1 TO 5,1 TO 7)
120 FOR I=1 TO 7
130 FOR J=1 TO 5
140 LET A(J,I)=I+J
150 PRINT USING " £££":A(J,I);
160 NEXT
170 PRINT
180 NEXT
2.26. Maximális értékű részsorozat keresése
Egy n elemű, pozitív és negatív számokból álló sorozatból válasszuk ki azt a folyamatos alszekvenciát melynek elemeinek értéke a legnagyobb. Az üres alszekvencia értékének nullának kell lennie; így ha minden elem negatív, az eredménynek üresnek kell lennie.
100 PROGRAM "Reszsor.bas"
110 RANDOMIZE
120 LET N=25
130 NUMERIC A(1 TO N)
140 TEXT 80
150 PRINT "Sorozat:"
160 FOR I=LBOUND(A) TO UBOUND(A)
170 LET A(I)=RND(11)-6
180 PRINT USING "££":A(I);
190 NEXT
200 LET MAXSUM,ST=0:LET EN=-1
210 FOR I=LBOUND(A) TO UBOUND(A)
220 LET SUM=0
230 FOR J=I TO UBOUND(A)
240 LET SUM=SUM+A(J)
250 IF SUM>MAXSUM THEN LET MAXSUM=SUM:LET ST=I:LET EN=J
260 NEXT
270 NEXT
280 PRINT :PRINT "Legnagyobb osszegu reszsorozat:"
290 IF ST>0 THEN PRINT TAB(ST*3-2);
300 FOR I=ST TO EN
310 PRINT USING "££":A(I);
320 NEXT
330 PRINT :PRINT "Osszeg: ";MAXSUM
2.27. Tömb elemeinek átlagai
Írjunk függvényeket, melyek kiszámolják tetszőleges tömb elemeinek
100 DEF AM(REF A)
110 LET T=0
120 FOR I=LBOUND(A) TO UBOUND(A)
130 LET T=T+A(I)
140 NEXT
150 LET AM=T/SIZE(A)
160 END DEF
170 DEF GM(REF A)
180 LET T=1
190 FOR I=LBOUND(A) TO UBOUND(A)
200 LET T=T*A(I)
210 NEXT
220 LET GM=T^(1/SIZE(A))
230 END DEF
240 DEF HM(REF A)
250 LET T=0
260 FOR I=LBOUND(A) TO UBOUND(A)
270 LET T=T+(1/A(I))
280 NEXT
290 LET HM=SIZE(A)/T
300 END DEF
2.28. Tömb listázása
Írjunk programot, amely egy n*n méretű tömböt listáz ki:
100 PROGRAM "tomblist.bas"
110 NUMERIC TOMB(1 TO 10,1 TO 10)
120 DO
130 INPUT PROMPT "Kerem a sorok es oszlopok szamat (max.10):":N
140 LOOP UNTIL N<=10 AND N>=1
150 FOR I=1 TO N
160 FOR J=1 TO N
170 PRINT "tomb(";I;",";J;:INPUT PROMPT ") = ":TOMB(I,J)
180 NEXT
190 NEXT
200 PRINT "A tomb:"
210 FOR I=1 TO N
220 FOR J=1 TO N
230 PRINT USING " ££":TOMB(I,J);
240 NEXT
250 PRINT
260 NEXT
270 PRINT "A tomb elemei sorfolytonosan:"
280 FOR I=1 TO N
290 FOR J=1 TO N
300 PRINT TOMB(I,J);
310 NEXT
320 NEXT
330 PRINT :PRINT "A tomb elemei oszlopfolytonosan:"
340 FOR I=1 TO N
350 FOR J=1 TO N
360 PRINT TOMB(J,I);
370 NEXT
380 NEXT
390 PRINT :PRINT "A foatloban levo elemek:"
400 FOR I=1 TO N
410 FOR J=1 TO N
420 IF I=J THEN PRINT TOMB(I,J);
430 NEXT
440 NEXT
2.29. Szimmetriavizsgálat
Állapítsuk meg, hogy szimmetrikus-e egy n*n-es kétdimenziós tömb, azaz minden i,j-re TOMB(I,J)=TOMB(J,I).
100 PROGRAM "Szimmetr.bas"
110 NUMERIC TOMB(1 TO 10,1 TO 10)
120 DO
130 INPUT PROMPT "Kerem a sorok es oszlopok szamat (max.10): ":N
140 LOOP UNTIL N<=10 AND N>=1
150 FOR I=1 TO N
160 FOR J=1 TO N
170 PRINT "tomb(";I;",";J;:INPUT PROMPT ") = ":TOMB(I,J)
180 NEXT
190 NEXT
200 LET SZIM=-1
210 FOR I=1 TO N
220 FOR J=1 TO N
230 PRINT USING " ££":TOMB(I,J);
240 IF TOMB(I,J)<>TOMB(J,I) THEN LET SZIM=0
250 NEXT
260 PRINT
270 NEXT
280 IF SZIM THEN
290 PRINT "A tomb szimmetrikus"
300 ELSE
310 PRINT "A tomb nem szimmetrikus"
320 END IF
2.30. Bűvös négyzet vizsgálata
Vizsgáljuk meg programmal azt, hogy egy n*n-es négyzetes mátrix tartalma bűvös négyzet-e! Bűvös négyzetnek nevezzük azokat az n sorból és n oszlopból álló négyzetes mátrixokat, amelynek mezőin egész számokat helyezünk el úgy, hogy minden sorban és oszlopban, továbbá a két átlóban ugyanakkora legyen a számok összege. Például 3*3-as méretű bűvös négyzet esetén az 1-9 számok összege (1+9)*9/2 = 45. Mivel 3 sor van, egy-egy sor összege 15 kell, hogy legyen.
Bűvös négyzet például az alábbi:
17 24 1 8 15 23 5 7 14 16 4 6 13 20 22 10 12 19 21 3 11 18 25 2 9
Végezzük el a tömb elemeinek beolvasását is és jelenítsük meg azokat a képernyő közepére illesztve!
100 PROGRAM "Buvosn1.bas"
110 DO
120 INPUT PROMPT "Buvos negyzet merete (max. 19): ":N
130 LOOP UNTIL N>2 AND N<20
140 NUMERIC BN(1 TO N,1 TO N)
150 TEXT 80
160 CALL BEOLVAS
170 IF BUVOS THEN
180 PRINT AT 22,1:"Buvos negyzet!";CHR$(161)
190 ELSE
200 PRINT AT 22,1:"Nem buvos negyzet!";CHR$(161)
210 END IF
220 DEF BEOLVAS
230 LET PX=38-N*4/2:LET PY=10-N/2
240 FOR I=1 TO N
250 FOR J=1 TO N
260 PRINT AT I+PY,PX+J*4+2:"?";
270 DO
280 PRINT AT 22,1:I;". sor, ";J;". oszlop";CHR$(161);:INPUT BE$
290 LET BN(I,J)=INT(VAL(BE$))
300 LOOP UNTIL BN(I,J)<=N^2 AND BN(I,J)>0
310 PRINT AT I+PY,PX+J*4,USING "£££":BN(I,J);
320 NEXT
330 NEXT
340 END DEF
350 DEF BUVOS
360 LET BUVOS=-1:LET S3,S4=0
370 LET SUM=(1+N^2)*N^2/2/N
380 FOR I=1 TO N
390 LET S1,S2=0
400 FOR J=1 TO N
410 LET S1=S1+BN(I,J)
420 LET S2=S2+BN(J,I)
430 NEXT
440 IF S1<>SUM OR S2<>SUM THEN LET BUVOS=0:EXIT DEF
450 LET S3=S3+BN(I,I)
460 LET S4=S4+BN(I,N-I+1)
470 NEXT
480 IF S3<>SUM OR S4<>SUM THEN LET BUVOS=0
490 END DEF
2.31. Mátrix bejárása csigavonalban
Adva van egy n*n méretű négyzetes mátrix. Készítsünk olyan programot, amely az 0..n^2-1 természetes számokkal csigavonalban tölti fel a mátrixot. Példa 5x5 méretű mátrixra:
0 1 2 3 4
15 16 17 18 5
14 23 24 19 6
13 22 21 20 7
12 11 10 9 8
100 PROGRAM "SpiralMa.bas"
110 TEXT 80
120 INPUT PROMPT "A matrix merete (max. 10): ":N
130 NUMERIC A(1 TO N,1 TO N)
140 CALL INIT(A)
150 CALL WRITE(A)
160 DEF INIT(REF T)
170 LET BCOL,BROW,COL,ROW=1:LET TCOL,TROW=N:LET DIR=0
180 FOR I=0 TO N^2-1
190 LET T(COL,ROW)=I
200 SELECT CASE DIR
210 CASE 0
220 IF ROW<TROW THEN
230 LET ROW=ROW+1
240 ELSE
250 LET DIR=1:LET COL=COL+1:LET BCOL=BCOL+1
260 END IF
270 CASE 1
280 IF COL<TCOL THEN
290 LET COL=COL+1
300 ELSE
310 LET DIR=2:LET ROW=ROW-1:LET TROW=TROW-1
320 END IF
330 CASE 2
340 IF ROW>BROW THEN
350 LET ROW=ROW-1
360 ELSE
370 LET DIR=3:LET COL=COL-1:LET TCOL=TCOL-1
380 END IF
390 CASE 3
400 IF COL>BCOL THEN
410 LET COL=COL-1
420 ELSE
430 LET DIR=0:LET ROW=ROW+1:LET BROW=BROW+1
440 END IF
450 END SELECT
460 NEXT
470 END DEF
480 DEF WRITE(REF T)
490 FOR I=LBOUND(T,1) TO UBOUND(T,1)
500 FOR J=LBOUND(T,2) TO UBOUND(T,2)
510 PRINT USING " ££":T(I,J);
520 NEXT
530 PRINT
540 NEXT
550 END DEF
2.32. Gyakoriság eloszlás
Nagyszámú dolgozatjegy eloszlását kell meghatározni, a rendszer bemenetéről érkező osztályzatok sorozatából. Csak a helyes - egy és öt közé eső egész számokat - fogadjuk el. A beolvasás a STOP billentyű megnyomásáig tart, ezután táblázatosan írjuk ki, hány jeles, jó, közepes, stb. osztályzat szerepelt, valamint az érdemjegyek átlagát.
100 PROGRAM "Osztalyz.bas"
110 NUMERIC JEGY(1 TO 5)
120 FOR I=1 TO 5
130 LET JEGY(I)=0
140 NEXT
150 LET NR=1:LET SUM=0
160 PRINT "Dolgozatra adott erdemjegyek:"
170 WHEN EXCEPTION USE STOP
180 DO
190 DO
200 PRINT NR;:INPUT PROMPT ". erdemjegy: ":J$
210 LET J=VAL(J$)
220 LOOP UNTIL INT(J)=J AND J>0 AND J<6
230 LET JEGY(J)=JEGY(J)+1:LET NR=NR+1:LET SUM=SUM+J
240 LOOP
250 END WHEN
260 HANDLER STOP
270 PRINT :PRINT
280 FOR I=1 TO 5
290 PRINT I;"osztalyzat: ";JEGY(I);"db"
300 NEXT
310 IF NR>1 THEN PRINT "Osztalyatlag: ";SUM/(NR-1)
320 END
330 END HANDLER
2.33. Egy szám osztói
Olvassunk be egy egész számot, írjuk ki az összes osztóját (kivéve az egyet és a számot önmagát)!
A legegyszerűbb megoldás, ha ciklusban megkeressük és kiírjuk a szám összes osztóját, egészen addig, amíg az osztó el nem éri a szám felét:
100 PROGRAM "Osztok.bas"
110 INPUT PROMPT "Szam: ":N
120 PRINT N;"osztoi:"
130 FOR I=2 TO N/2
140 IF MOD(N,I)=0 THEN PRINT I,
150 NEXT
Hatékonyabb megoldás azonban, ha az osztókat csak a szám gyökéig keressük, a többi osztót, pedig az előzőekből számítjuk ki:
100 PROGRAM "Osztok2.bas"
110 INPUT PROMPT "Szam: ":N
120 NUMERIC OSZT(1 TO 200)
130 LET DB=0
140 FOR I=2 TO CEIL(SQR(N))
150 IF MOD(N,I)=0 THEN LET DB=DB+1:LET OSZT(DB)=I
160 NEXT
170 FOR J=DB TO 1 STEP-1
180 LET OSZT(DB+1)=N/OSZT(J)
190 IF OSZT(DB+1)<>OSZT(DB) THEN LET DB=DB+1
200 NEXT
210 PRINT N;"osztoi:"
220 FOR I=1 TO DB
230 PRINT OSZT(I),
240 NEXT
2.34. Prímszámok I.
Határozzuk meg és írjuk ki az első N (pl. 100 db) prímszámot!
Az alábbi algoritmus két elvet használ:
100 PROGRAM "Prim1.bas"
110 LET N=100
120 NUMERIC PRIM(1 TO N)
130 PRINT "Az elso ";N;"primszam:"
140 LET PRIM(1)=2:PRINT 2;
150 LET UTOLSO=1:LET SZAM=3
160 DO
170 LET X=1:LET OSZTO=INT(SQR(SZAM))
180 DO WHILE MOD(SZAM,PRIM(X))<>0 AND PRIM(X)<=OSZTO
190 LET X=X+1
200 LOOP
210 IF MOD(SZAM,PRIM(X))<>0 THEN
220 LET UTOLSO=UTOLSO+1:LET PRIM(UTOLSO)=SZAM
230 PRINT SZAM;
235 END IF
240 LET SZAM=SZAM+2
250 LOOP UNTIL UTOLSO=N
2.35. Prímszámok II.
Állítsuk elő az 5000-nél kisebb prímszámokat!
Ha ilyen mennyiségű prímszámot kell megkeresni, leghatékonyabb megoldás, ha Eratoszthenész szitáját alkalmazzuk. Eratoszthenész szitája a neves ókori görög matematikus, Eratoszthenész módszere, melynek segítségével egyszerű kizárásos algoritmussal megállapíthatjuk, hogy melyek a prímszámok. Ennek menete a következő:
100 PROGRAM "Prim2.bas"
110 LET N=2000
120 NUMERIC T(1 TO N)
130 TEXT 80
140 FOR I=1 TO N
150 LET T(I)=1
160 NEXT
170 LET I=2
180 DO WHILE I<=INT(SQR(N))
190 LET J=2*I
200 DO WHILE J<=N
210 LET T(J)=0:LET J=J+I
220 LOOP
230 LET I=I+1
240 DO WHILE NOT T(I)
250 LET I=I+1
260 LOOP
270 LOOP
280 FOR I=2 TO N
290 IF T(I) THEN PRINT I;
300 NEXT
310 PRINT
2.36. Palindrom (rákvers)
Palindromnak vagy (régiesebb elnevezéssel) palindrómának az olyan szöveget nevezzük, amely előre és visszafelé olvasva ugyanaz - szóközöktől és írásjelektől eltekintve). Pl:
Készítsünk függvényt, amely a paraméterként megadott szövegfüzérről eldönti, hogy palindrom-e. Készítsünk főprogramot, amely az eljárást hívja!
100 PROGRAM "Palindom.bas"
110 PRINT "Palindroma kereses":LINE INPUT PROMPT "Mondat: ":ST$
120 IF LEN(ST$)>2 AND PALINDROM(ST$) THEN
130 PRINT "Palindoma!"
140 ELSE
150 PRINT "Nem palindoma."
160 END IF
170 DEF PALINDROM(S$)
180 LET I=1:LET J=LEN(S$):LET PALINDROM=-1:LET S$=LCASE$(S$)
190 DO WHILE I<J
200 DO WHILE S$(I)=" " OR S$(I)="," OR S$(I)=";" OR S$(I)="." OR S$(I)="!" OR S$(I)="?"
210 LET I=I+1
220 LOOP
230 DO WHILE S$(J)=" " OR S$(J)="," OR S$(J)=";" OR S$(J)="." OR S$(J)="!" OR S$(J)="?"
240 LET J=J-1
250 LOOP
260 IF S$(I)<>S$(J) THEN
270 LET PALINDROM=0
280 EXIT DO
290 ELSE
300 LET I=I+1:LET J=J-1
310 END IF
320 LOOP
330 END DEF
Tipp a program továbbfejlesztésére: jelen állapotban A kettős (cs, dz, gy, ly, ny, sz, ty, zs) és hármas (dzs) betűk megtévesztik a programot.
Angol nyelvben lényegesen egyszerűbb pontos programot készíteni:
100 PROGRAM "Palindr.bas"
110 LINE INPUT PROMPT "Text: ":TX$
120 PRINT """";TX$;""" is ";
130 IF PALIND(TX$) THEN
140 PRINT "a palindrome."
150 ELSE
160 PRINT "not a palindrome."
170 END IF
180 DEF TRIM$(TX$)
190 LET T$=""
200 FOR I=1 TO LEN(TX$)
210 IF TX$(I)>="A" AND TX$(I)<="Z" THEN LET T$=T$&TX$(I)
220 NEXT
230 LET TRIM$=T$
240 END DEF
250 DEF PALIND(TX$)
260 LET PALIND=-1:LET TX$=TRIM$(UCASE$(TX$))
270 FOR I=1 TO LEN(TX$)/2
280 IF TX$(I)<>TX$(LEN(TX$)-I+1) THEN LET PALIND=0:EXIT FOR
290 NEXT
300 END DEF
2.37. Szabaduló rabok
A szultán börtönében 1000 (általánosabb esetben n db) cella van, mindegyikben egy rab ül. Kezdetben minden cella zárva van. A szultánnak egyik nap nagyon jókedve van, ezért amnesztiát hirdet. De azért nem akarja az összes foglyot elengedni, mert akkor üres lenne a börtön, ezért a következő furfangos megoldást találja ki: a börtönőr először végigmegy az összes cella előtt, és mindegyik ajtó zárján fordít egyet. Fordításkor a nyitott cellát bezárja, illetve a zártat kinyitja. Ha végigment, elkezdi elölről, és minden második cella zárján fordít egyet. Aztán minden harmadikon fordít, és így tovább, végül fordít egyet az ezrediken, és kész. Ezután amelyik cella ajtaja nincs zárva, abból a rab elmehet. Kik a szerencsés rabok?
Nyilvánvaló, hogy minden cellához tárolnunk kell azt az információt, hogy az ajtó éppen nyitva van-e, vagy sem. Összesen 1000 cella van, a tömb indexe tehát 1..1000. Ezután egymásba ágyazott ciklusokkal, a megfelelő lépéseket beállítva végigsétáltat a börtönőr a tömbön.
100 PROGRAM "Cellak.bas"
110 LET N=1000
120 NUMERIC SZABAD(1 TO N)
130 FOR I=1 TO N
140 LET SZABAD(I)=0
150 NEXT
160 FOR LEPES=1 TO N
170 FOR I=LEPES TO N STEP LEPES
180 LET SZABAD(I)=NOT SZABAD(I)
190 NEXT
200 NEXT
210 PRINT "A szerencses rabok:"
220 FOR I=1 TO N
230 IF SZABAD(I) THEN PRINT I,
240 NEXT
Ha lefuttatjuk a programot, azt látjuk, hogy azok a rabok lesznek szerencsések, akiknek ajtajára négyzetszám van írva: 1, 4, 9, 16, 25, 36, 49, 64, 81, 100 ...
Ennek matematikai magyarázata pedig a következő: Egy ajtóra annyiszor kerül sor, ahány osztója van az ajtó sorszámának. Amikor a börtönőr minden 3. ajtón fordít egyet, ebbe a szórásba az ajtó akkor esik bele, ha a számnak osztója a 3. Kérdés az, hogy egy számnak hány osztója van összesen, hiszen annyiszor lesz zárfordítás. A rabot persze csak az érdekli, hogy az osztók száma páros, vagy páratlan, hiszen csak páratlan számú kulcsfordítás esetén szabadulhat. Ha n osztója a számnak, akkor a szám/n is osztója a számnak - ilyen formán az osztókat párba állíthatjuk. Egyetlen osztónak nincsen csak párja, ha a pár önmaga lenne. Ezért van az, hogy csak a négyzetszámoknak van páratlan számú osztójuk, minden más számnak páros számú osztója van.
A feladatot tehát egyszerűbben is megoldhatjuk a, 1..1000 közé eső négyzetszámok keresésével:
100 PROGRAM "Cellak2.bas"
110 LET N=1000:LET NR=1:LET D=3
120 DO
125 PRINT NR,
130 LET NR=NR+D:LET D=D+2
140 LOOP WHILE NR<=N
2.38. Konverzió: arab számból római szám
Olvassunk be egész számokat a bemenetről. Ha 4000-nél kisebb számot adtunk meg, konvertáljuk római számmá!
100 PROGRAM "Romai_sz.bas"
110 NUMERIC ARAB(1 TO 14)
120 STRING ROMAI$(1 TO 14)*2
130 FOR I=1 TO 13
140 READ ARAB(I),ROMAI$(I)
150 NEXT
160 DO
170 INPUT PROMPT "Arab szam: ":BE$
180 PRINT "Romai szam: ";ROMAISZ$(INT(VAL(BE$))):PRINT
190 LOOP
200 DEF ROMAISZ$(X)
210 IF X>3999 THEN
220 LET ROMAISZ$=CHR$(165)&"Tul nagy!"
230 ELSE
240 LET S$=""
250 FOR I=1 TO 13
260 DO WHILE X>=ARAB(I)
270 LET S$=S$&ROMAI$(I):LET X=X-ARAB(I)
280 LOOP
290 NEXT
300 LET ROMAISZ$=S$
310 END IF
320 END DEF
330 DATA 1000,M,900,CM,500,D,400,CD,100,C,90,XC,50,L,40,XL,10,X,9,IX,5,V,4,IV,1,I
2.39. Ranglista
Írjunk programot, amely egy pontozásos sportversenyt követ, és minden versenyző szereplése után kiírja a pillanatnyi első nr. helyezettet! Az adatokat a rendszer bemenetéről a következő formában vigyük be: rajtszám (egész szám), versenyző neve (max. 20 karakter), elért pontszám (valós szám). A program működése a 0 rajtszám bevitelekor fejeződjön be!
Az eredmény a rendszer kimenetén jelenjen meg mindig az új versenyző adatainak feldolgozása után.
100 PROGRAM "Ranglista.bas"
110 TEXT
120 LET NR=10:LET DB=0
130 STRING NEV$(1 TO NR+1)*20
140 NUMERIC PONT(1 TO 2,1 TO NR+1)
150 DO
160 INPUT PROMPT "Rajtszam: ":BE$
170 LET RSZAM=INT(VAL(BE$))
180 IF RSZAM=0 THEN EXIT DO
190 INPUT PROMPT "Nev: ":N$
200 INPUT PROMPT "Pontszam: ":BE$
210 LET P=VAL(BE$):LET N$=N$(:20)
220 CALL BESZUR
230 CALL KIIR
240 LOOP
250 DEF KIIR
260 CLEAR SCREEN:PRINT "Pontszamtabla";CHR$(241):PRINT
270 PRINT "Hely. rajtszam, nev";TAB(34);"pont"
280 FOR I=1 TO DB
290 PRINT I;TAB(6);PONT(1,I);TAB(12);NEV$(I);TAB(33);PONT(2,I)
300 NEXT
310 PRINT :PRINT
320 END DEF
330 DEF BESZUR
340 IF DB>0 THEN
350 LET IDX=DB+1
360 FOR I=DB TO 1 STEP-1
370 IF P>PONT(2,I) THEN
380 LET PONT(1,I+1)=PONT(1,I):LET PONT(2,I+1)=PONT(2,I)
390 LET NEV$(I+1)=NEV$(I):LET IDX=I
400 END IF
410 NEXT
420 ELSE
430 LET IDX=1
440 END IF
450 LET NEV$(IDX)=N$:LET PONT(2,IDX)=P:LET PONT(1,IDX)=RSZAM
460 LET DB=MIN(DB+1,NR)
470 END DEF
2.40. Bérkifizetés
A rendszer bemenetén adva van egy vállalat havi bérlistája: NÉV, ÖSSZEG párok. Az adatsorozat végét egy *** végjel zárja le.
Személyenként számoljuk ki a kifizetendő címleteket (ld. 2.8. feladat), majd a feldolgozás végén írjuk, hogy az egyes címletekből összesen mennyire van szükség ahhoz, hogy a béreket ki tudjuk fizetni!
100 PROGRAM "Berkifiz.bas"
110 NUMERIC CIMLETEK(1 TO 12)
120 LET SUM=0
130 FOR I=1 TO 12
140 LET CIMLETEK(I)=0
150 NEXT
160 OPEN £1:"Berlista.dat"
170 DO
180 INPUT £1:NEV$
190 IF NEV$="***" THEN EXIT DO
200 INPUT £1:OSSZEG
210 PRINT NEV$;TAB(26);OSSZEG;"Ft"
220 LET SUM=SUM+OSSZEG
230 FOR I=1 TO 12
240 READ PENZ
250 LET DB=INT(OSSZEG/PENZ)
260 IF DB>0 THEN
262 LET CIMLETEK(I)=CIMLETEK(I)+DB
264 LET OSSZEG=OSSZEG-DB*PENZ
268 END IF
270 NEXT
280 RESTORE
290 LOOP
300 CLOSE £1
305 PRINT
310 FOR I=1 TO 12
320 READ PENZ
330 PRINT PENZ;"Forintos:";TAB(18);CIMLETEK(I);"db"
340 NEXT
350 PRINT ,"Osszesen:";SUM;"Ft"
360 DATA 20000,10000,5000,2000,1000,500,200,100,50,20,10,5
2.41. Tanulmányi eredmények
Olvassuk be egy táblázatba egy osztály tanulóinak tantárgyankénti (irodalom, nyelvtan, matematika, fizika, földrajz orosz) érdemjegyeit. Az osztály létszáma maximum 35 lehet. Írjuk ki tanulónként, tantárgyanként valamint az egész csoportra vonatkozó osztályátlagot!
100 PROGRAM "Osztaly.bas"
110 STRING TARGY$(1 TO 6)*10,NEV$(1 TO 35)*20
120 NUMERIC JEGY(1 TO 35,1 TO 6),SUMT(1 TO 6)
130 LET TARGY$(1)="irodalom":LET TARGY$(2)="nyelvtan":LET TARGY$(3)="matematika":LET TARGY$(4)="fizika":LET TARGY$(5)="foldrajz":LET TARGY$(6)="orosz"
140 LET NR,SUMO=0
150 FOR I=1 TO 6
160 LET SUMT(I)=0
170 NEXT
180 DO
190 LET NR=NR+1
200 PRINT NR;"tanulo ";:INPUT PROMPT "neve: ":NEV$(NR)
210 IF NEV$(NR)="" THEN LET NR=NR-1:EXIT DO
220 FOR I=1 TO 6
230 PRINT TARGY$(I);" osztalyzat: ";TAB(23);
240 LET JEGY(NR,I)=READKEY:PRINT JEGY(NR,I)
250 NEXT
260 PRINT
270 LOOP UNTIL NEV$(NR)="" OR NR=35
280 PRINT :PRINT "Tanulmanyi atlagok"
290 FOR I=1 TO NR
300 LET SUM=0
310 FOR J=1 TO 6
320 LET SUM=SUM+JEGY(I,J)
330 LET SUMT(J)=SUMT(J)+JEGY(I,J)
340 NEXT
350 PRINT NEV$(I);": ";TAB(21);SUM/6
360 NEXT
370 PRINT :PRINT "Tantargyankenti atlagok"
380 FOR I=1 TO 6
390 PRINT TARGY$(I);TAB(12);SUMT(I)/NR
400 LET SUMO=SUMO+SUMT(I)/NR
410 NEXT
420 PRINT :PRINT "Osztalyatlag:";SUMO/6
430 DEF READKEY
440 DO
450 LET K$=INKEY$
460 LOOP UNTIL K$>="1" AND K$<="5"
470 LET READKEY=VAL(K$)
480 END DEF
2.42. Kimutatás készítése áruházi bevételekről
Készítsünk táblázatos kimutatást a budapesti Centrum Áruházak havi bevételeiről!
A lista képe a következő legyen (példa):
100 PROGRAM "Bevetel.bas"
110 STRING HO$(1 TO 12)*10,ARUHAZ$(1 TO 4)*12
120 NUMERIC BEVETEL(1 TO 5,1 TO 12)
130 TEXT 80
140 CALL INIC
150 CALL BEOLVAS
160 CALL KIIR
170 DEF INIC
180 FOR I=1 TO 12
190 READ HO$(I)
200 NEXT
210 FOR I=1 TO 4
220 READ ARUHAZ$(I)
230 NEXT
240 DATA januar,februar,marcius,aprilis,majus,junius,julius,augusztus,szeptember,oktober,november,december
250 DATA Corvin," Lotto",Otthon,Divatcsarnok
260 END DEF
270 DEF BEOLVAS
280 FOR I=1 TO 4
290 PRINT :PRINT ARUHAZ$(I);" aruhaz bevetelei:"
300 FOR J=1 TO 12
310 DO
320 PRINT USING ">££££££££££":HO$(J);:INPUT PROMPT " havi bevetel (MFT): ":BE$
330 LOOP UNTIL VAL(BE$)>0 AND VAL(BE$)<2000
340 LET BEVETEL(I,J)=VAL(BE$)
350 NEXT
360 NEXT
370 END DEF
380 DEF KIIR
390 NUMERIC SUM2(1 TO 4)
400 CLEAR SCREEN
410 PRINT "A Centrum aruhazak eves bevetelei (MFt)";CHR$(241)
420 PRINT :PRINT TAB(12);
430 FOR I=1 TO 4
440 PRINT USING "££££££££££££ ":ARUHAZ$(I);
450 LET SUM2(I)=0
460 NEXT
470 PRINT TAB(68);"Osszesen"
480 FOR I=1 TO 12
490 PRINT USING ">££££££££££":HO$(I);:PRINT TAB(12);
500 LET SUM=0
510 FOR J=1 TO 4
520 PRINT USING " ££££.£ ":BEVETEL(J,I);
530 LET SUM=SUM+BEVETEL(J,I):LET SUM2(J)=SUM2(J)+BEVETEL(J,I)
540 NEXT
550 PRINT TAB(69);:PRINT USING "£££££.£":SUM
560 NEXT
570 LET SUM=0
580 PRINT " Osszesen:";
590 FOR I=1 TO 4
600 PRINT USING " £££££.£ ":SUM2(I);
610 LET SUM=SUM+SUM2(I)
620 NEXT
630 PRINT TAB(69);:PRINT USING "£££££.£":SUM
640 END DEF
2.43. Népszámlálási kimutatás
A népszámlálás alkalmából egy városban minden lakosról az alábbi rekordot rögzítik:
A program (bolondbiztosan) végezze el az adatbevitelt (maximum n fő adatainak fogadására készítsük fel), majd a fenti rekordszerkezetű adatok alapján készítse el a következő kimutatást:
A lakosok adatait egy LAKOS(n,5) kétdimenziós tömbben tároljuk az alábbi sorrendben: nem, születési év, lakás típusa, társadalmi csoport, családi állapot).
100 PROGRAM "Nepszam.bas"
110 LET N=1000:LET NR=0
120 NUMERIC LAKOS(1 TO N,1 TO 5)
130 STRING TCS$(1 TO 5),LAK$(1 TO 4)
140 TEXT 80
150 INPUT PROMPT "Ev: ":EV
160 CALL INIC
170 CALL BEOLVAS
180 CALL ERTEKEL
190 DEF INIC
200 LET LAK$(1)="oszkomfortos":LET LAK$(2)="komfortos": LET LAK$(3)="felkomfortos":LET LAK$(4)="komfort nelkuli"
210 LET TCS$(1)="tanulo":LET TCS$(2)="allami szektorban dolgozik": LET TCS$(3)="maganszektorban dolgozik":LET TCS$(4)="munkanelkuli":LET TCS$(5)="nyugdijas, egyeb"
220 END DEF
230 DEF BEOLVAS
240 DO
250 PRINT :PRINT "Kod: ";NR+1
260 PRINT "Nem? (1 - ferfi, 2 - no, ESC - vege)";
270 LET KEY=READKEY(2)
280 IF KEY=0 THEN
290 EXIT DO
300 ELSE
310 LET NR=NR+1:LET LAKOS(NR,1)=KEY:PRINT KEY
320 END IF
330 DO
340 INPUT PROMPT "Szuletesi ev: ":BE$
350 LOOP UNTIL VAL(BE$)=INT(VAL(BE$)) AND VAL(BE$)<=EV AND VAL(BE$)>EV-130
360 LET LAKOS(NR,2)=VAL(BE$)
370 PRINT "Lakas tipusa?"
380 FOR I=1 TO 4
390 PRINT I;"- ";LAK$(I);", ";
400 NEXT
410 LET LAKOS(NR,3)=READKEY(4):PRINT LAKOS(NR,3)
420 IF EV-LAKOS(NR,2)<16 THEN
430 LET LAKOS(NR,4)=1:LET LAKOS(NR,5)=1
440 ELSE
450 PRINT "Tarsadalmi csoport?"
460 FOR I=1 TO 5
470 PRINT I;"- ";TCS$(I);", ";
480 NEXT
490 LET LAKOS(NR,4)=READKEY(5):PRINT LAKOS(NR,4)
500 PRINT "Csaladi allapot? (1 - egyedulallo, 2 - hazas)";
510 DO
520 LET LAKOS(NR,5)=READKEY(2)
530 LOOP UNTIL LAKOS(NR,5)>0
540 PRINT LAKOS(NR,5)
550 END IF
560 LOOP
570 END DEF
580 DEF READKEY(MAX)
590 DO
600 LET KEY$=INKEY$
610 LOOP UNTIL KEY$>"0" AND KEY$<=STR$(MAX) OR KEY$=CHR$(27) AND MAX=2
620 LET READKEY=VAL(KEY$)
630 END DEF
640 DEF ERTEKEL
650 NUMERIC LAKAS(1 TO 5),TARSCS(1 TO 5)
660 FOR I=1 TO 5
670 LET LAKAS(I),TARSCS(I)=0
680 NEXT
690 LET GYEREK,FERFI,NOTLEN=0
700 FOR I=1 TO NR
710 IF EV-LAKOS(I,2)<=16 THEN LET GYEREK=GYEREK+1
720 IF LAKOS(I,1)=1 THEN LET FERFI=FERFI+1
730 IF LAKOS(I,5)=1 THEN LET NOTLEN=NOTLEN+1
740 LET LAKAS(LAKOS(I,3))=LAKAS(LAKOS(I,3))+1
750 LET TARSCS(LAKOS(I,4))=TARSCS(LAKOS(I,4))+1
760 NEXT
770 CLEAR SCREEN
780 PRINT "Nepszamlalas ";EV;CHR$(241)
790 PRINT :PRINT "Lakosok szama";TAB(32);NR;" fo"
800 PRINT " Gyerek:";TAB(32);GYEREK;" fo"
810 PRINT " Felnott:";TAB(32);NR-GYEREK;" fo"
820 PRINT "Nemek megoszlasa:"
830 PRINT " Ferfi:";TAB(32);ROUND(FERFI/NR*100,2);"%"
840 PRINT " No:";TAB(32);ROUND((NR-FERFI)/NR*100,2);"%"
850 PRINT "Csaladi allapot:"
860 PRINT " Egyedulallo:";TAB(32);ROUND(NOTLEN/NR*100,2);"%"
870 PRINT " Hazas:";TAB(32);ROUND((NR-NOTLEN)/NR*100,2);"%"
880 PRINT "Tarsadalmi csoportok:"
890 FOR I=1 TO 5
900 PRINT " ";TCS$(I);":";TAB(32);ROUND(TARSCS(I)/NR*100,2);"%"
910 NEXT
920 PRINT "Milyen lakasban lakik:"
930 FOR I=1 TO 4
940 PRINT " ";LAK$(I);":";TAB(32);ROUND(LAKAS(I)/NR*100,2);"%"
950 NEXT
960 END DEF
3.1. Maximum-minimum keresés
Írjunk programot, amely számsorozatot olvas be a STOP billentyű megnyomásáig. Írjuk ki a sorozatban előforduló legnagyobb és legkisebb elemet!
100 PROGRAM "Min-max.bas"
110 LET N=0:LET MN=INF:LET MX=-INF
120 WHEN EXCEPTION USE STOP
130 DO
140 PRINT N+1;:INPUT PROMPT ". szam: ":SZAM
150 LET MN=MIN(SZAM,MN):LET MX=MAX(SZAM,MX)
160 LET N=N+1
170 LOOP
180 END WHEN
190 HANDLER STOP
200 PRINT
210 IF N>0 THEN
220 PRINT "A legnagyobb elem: ";MX
230 PRINT "A legkisebb elem: ";MN
240 ELSE
250 PRINT "Ures a lista!"
260 END IF
270 END HANDLER
3.2. Vektor maximuma-minimuma
Határozzuk meg a rendszer bemenetéről valós számokkal feltöltött n elemű vektor legkisebb és legnagyobb elemét Jelenítsük meg az elem sorszámát és értékét is!
100 PROGRAM "Max-min2.bas"
105 LET N=10:LET MN,MX=1
110 NUMERIC A(1 TO N)
120 FOR I=1 TO N
130 PRINT I;:INPUT PROMPT ". szam: ":A(I)
140 NEXT
150 FOR I=2 TO N
160 IF A(I)>A(MX) THEN
170 LET MX=I
180 ELSE IF A(I)<A(MN) THEN
190 LET MN=I
200 END IF
210 NEXT
220 PRINT "A legnagyobb elem sorszama: ";MX
230 PRINT " erteke:";A(MX)
240 PRINT "A legkisebb elem sorszama: ";MN
250 PRINT " erteke:";A(MN)
3.3. Mátrix oszlopainak, sorainak összegzése
Készítsünk programot amely meghatározza egy NxN méretű kétdimenziós tömb azon sorát, melyben az elemek összege a legkevesebb, és azon oszlopát, ahol az elemek értéke a legtöbb. A tömböt véletlenszerűen töltsük fel. A mátrixot jelenítsük meg, a kiválasztott sort és oszlopot jelöljük be!
100 PROGRAM "Min_Max.bas"
110 RANDOMIZE
120 SET £102:PALETTE 0,91,4,254
130 LET N=10:LET MN,MX=0
140 NUMERIC A(1 TO N,1 TO N)
150 CALL TOLT
160 CALL MIN_MAX(MN,MX)
170 CALL KIIR(MN,MX)
180 DEF TOLT
190 FOR I=1 TO N
200 FOR J=1 TO N
210 LET A(I,J)=RND(N^2)
220 NEXT
230 NEXT
240 END DEF
250 DEF KIIR(PX,PY)
260 FOR I=1 TO N
270 FOR J=1 TO N
280 IF I=PX OR J=PY THEN SET £102:INK 3
290 PRINT USING " ££":A(I,J);:SET £102:INK 1
300 NEXT
310 PRINT
320 NEXT
330 END DEF
340 DEF MIN_MAX(REF MN,REF MX)
350 LET MINSUM=INF:LET MAXSUM=-INF
360 FOR I=1 TO N
370 LET S1,S2=0
380 FOR J=1 TO N
390 LET S1=S1+A(I,J):LET S2=S2+A(J,I)
400 NEXT
410 IF S2>MAXSUM THEN LET MAXSUM=S2:LET MX=I
420 IF S1<MINSUM THEN LET MINSUM=S1:LET MN=I
430 NEXT
440 END DEF
3.4. Mátrix nyeregpontja
Készítsünk programot, egy kétdimenziós, NxN méretű tömb azon elemeinek meghatározására, amelyek sorukban minimális, ugyanakkor oszlopukban maximális értékűek (vagyis a mátrix nyeregpontjának nevezzük azt az elemét, amely a legkisebb a sorában és legnagyobb az oszlopában)! Egy mátrixban több nyeregpont is lehet, de elképzelhető, hogy egy sem található.
A feladat megoldása a 3.3. feladatra adott program alapján nem nehéz: a sorok legkisebb elemeit a SORMIN vektorban, az oszlopok legnagyobb elemeit a OSZLMAX vektorban gyűjtjük. Majd ezen vektorok összehasonlításával megállapíthatjuk, valamely sor legkisebb eleme egyenlő valamelyik oszlop legnagyobb elemével. A nyeregpontok koordinátáit az NYP vektorban gyűjtjük.
A mátrix elemeinek beolvasásához a 2.23 feladatban használt eljárás pontosan megfelelő.
100 PROGRAM "Nyeregp.bas"
120 DO
130 INPUT PROMPT "Matrix merete (2-12): ":BE$
140 LET N=INT(VAL(BE$))
150 LOOP UNTIL N>1 AND N<13
160 NUMERIC A(1 TO N,1 TO N),SORMIN(1 TO N),OSZLMAX(1 TO N),NYP(0 TO N^2,1 TO 2)
170 LET PX=18-N*3/2:LET PY=10-N/2:LET MN,MX=0
180 TEXT 40
190 SET £102:PALETTE 0,91,4,254
200 CALL BEOLVAS
210 CALL NYEREGP
220 CALL KIJELOL
230 DEF KIJELOL
240 PRINT AT 22,1:"A matrixnak ";NYP(0,1);"nyeregpontja van."
250 SET £102:INK 3
260 FOR I=1 TO NYP(0,1)
270 PRINT AT NYP(I,2)+PY,PX+NYP(I,1)*3,USING "££":A(NYP(I,2),NYP(I,1));
280 NEXT
290 PRINT AT 23,1:;:SET £102:INK 1
300 END DEF
310 DEF NYEREGP
320 LET NYP(0,1)=0
330 FOR I=1 TO N
340 LET SORMIN(I)=INF:LET OSZLMAX(I)=-INF
350 FOR J=1 TO N
360 LET SORMIN(I)=MIN(SORMIN(I),A(I,J))
370 LET OSZLMAX(I)=MAX(OSZLMAX(I),A(J,I))
380 NEXT
390 NEXT
400 FOR I=1 TO N
410 FOR J=1 TO N
420 IF SORMIN(I)=OSZLMAX(J) THEN LET NYP(0,1)=NYP(0,1)+1: LET NYP(NYP(0,1),1)=J:LET NYP(NYP(0,1),2)=I
430 NEXT
440 NEXT
450 END DEF
460 DEF BEOLVAS
470 FOR I=1 TO N
480 FOR J=1 TO N
490 PRINT AT I+PY,PX+J*3+1:"?";
500 DO
510 PRINT AT 22,1:I;". sor, ";J;". oszlop";CHR$(161);:INPUT BE$
520 LET A(I,J)=INT(VAL(BE$))
530 LOOP UNTIL A(I,J)<100 AND A(I,J)>-10
540 PRINT AT I+PY,PX+J*3,USING "££":A(I,J);
550 NEXT
560 NEXT
570 PRINT
580 END DEF
3.5. Legjobb tanulók osztályszinten
Olvassuk be egy n létszámú osztály tanulóinak nevét, valamint év végi irodalom, matematika, földrajz, történelem, fizika osztályzatát. Jelenítsük meg az elért eredményeket táblázatosan, majd soroljuk fel a legjobb átlageredményt elért tanulót / tanulókat!
A feladat megoldásának lépései:
100 PROGRAM "Osztaly.bas"
110 TEXT 80
120 INPUT PROMPT "Osztalyletszam: ":N
130 NUMERIC OSZT(N,5),SUM(1 TO N)
140 STRING TTARGY$(1 TO 5)*11,NEV$(1 TO N)*25
150 FOR I=1 TO 5
160 READ TTARGY$(I)
170 NEXT
180 LET MX=0
190 FOR I=1 TO N ! Beolvasas
200 PRINT I;:INPUT PROMPT ". tanulo neve: ":NEV$(I)
210 LET SUM(I)=0
220 FOR J=1 TO 5
230 DO
240 PRINT TAB(8);TTARGY$(J);:INPUT PROMPT " erdemjegy: ":BE$
250 LET OSZT(I,J)=VAL(BE$)
260 LOOP UNTIL OSZT(I,J)=INT(OSZT(I,J)) AND OSZT(I,J)>0 AND OSZT(I,J)<6
270 LET SUM(I)=SUM(I)+OSZT(I,J)
280 NEXT
290 LET SUM(I)=SUM(I)/5
300 LET MX=MAX(SUM(I),MX)
310 NEXT
320 CLEAR SCREEN
330 PRINT TAB(26); ! Eredmenyek kiirasa
340 FOR I=1 TO 5
350 PRINT TTARGY$(I)(1:3),
360 NEXT
370 PRINT "atlag"
380 FOR I=1 TO N
390 PRINT NEV$(I);TAB(26);
400 FOR J=1 TO 5
410 PRINT OSZT(I,J),
420 NEXT
430 PRINT SUM(I)
440 NEXT
450 PRINT :PRINT "Legjobb eredmenyt elert tanulok:"
460 FOR I=1 TO N
470 IF SUM(I)=MX THEN PRINT NEV$(I);TAB(26);SUM(I)
480 NEXT
490 DATA irodalom,matematika,foldrajz,tortenelem,fizika
3.6. Dolgozói statisztika
Egy vállalat dolgozóinak neveit a NEV(n) tömbben, adataikat (nem, születés éve, fizetés) az adat(3,n) kétdimenziós tömbben tároljuk. Írjunk programot, amely beolvassa a dolgozók adatait sorfolytonosan, úgy hogy maximum n dolgozóra számít! Készítsük el a következő statisztikai adatokat:
100 PROGRAM "Dolgozok.bas"
110 TEXT 80
120 LET N=200
130 STRING NEV$(1 TO N)*26
140 NUMERIC ADAT(1 TO 3,1 TO N)
150 LET DB=0
160 INPUT PROMPT "Akt. ev: ":EV
170 PRINT "Felvitel:"
180 DO
190 LET DB=DB+1
200 PRINT DB;"dolgozo:"
210 INPUT PROMPT " Nev: ":NEV$(DB)
220 DO
230 INPUT PROMPT " Nem: ":ADAT(1,DB)
240 LOOP UNTIL ADAT(1,DB)=1 OR ADAT(1,DB)=2
250 INPUT PROMPT " Szul. ev: ":ADAT(2,DB)
260 INPUT PROMPT " Fizetes: ":ADAT(3,DB)
270 IF DB<>N THEN
280 PRINT "Uj felvitel?"
290 DO
300 LET KEY$=INKEY$
310 LOOP WHILE KEY$=""
320 END IF
330 LOOP UNTIL LCASE$(KEY$)<>"i" OR DB=N
340 CLEAR SCREEN
350 PRINT "Vallalati statisztika";CHR$(241)
360 LET FIATAL,MINFIZ=INF
370 LET FFI,IDOS,ATLEL,MAXFIZ,ATLELF,ATLELN,SUM,SUMF=0
380 FOR I=1 TO DB
390 IF ADAT(1,I)=1 THEN LET FFI=FFI+1
400 LET IDOS=MAX(IDOS,EV-ADAT(2,I))
410 LET FIATAL=MIN(FIATAL,EV-ADAT(2,I))
420 LET MAXFIZ=MAX(MAXFIZ,ADAT(3,I))
430 LET MINFIZ=MIN(MINFIZ,ADAT(3,I))
440 LET ATLEL=ATLEL+EV-ADAT(2,I)
450 LET SUM=SUM+ADAT(3,I)
460 IF ADAT(1,I)=1 THEN
470 LET ATLELF=ATLELF+EV-ADAT(2,I)
480 LET SUMF=SUMF+ADAT(3,I)
490 ELSE
500 LET ATLELN=ATLELN+EV-ADAT(2,I)
510 END IF
520 NEXT
530 PRINT :PRINT "Dolgozok szama:";TAB(32);DB;"fo."
540 PRINT "Ferfi dolgozok:";TAB(32);FFI;"fo."
550 PRINT "No dolgozok:";TAB(32);DB-FFI;"fo."
560 PRINT "Dolgozok atlag eletkora:";TAB(32);ROUND(ATLEL/DB,2);"ev."
570 IF FFI<>0 THEN PRINT "Ferfi dolgozok atlageletkora: ";ROUND(ATLELF/FFI,2);"ev."
580 IF DB-FFI<>0 THEN PRINT "Noi dolgozok atlageletkora:";TAB(32);ROUND(ATLELN/(DB-FFI),2);"ev."
590 PRINT "Legnagyobb fizetes:";TAB(32);MAXFIZ;"Ft."
600 PRINT "Legkisebb fizetes:";TAB(32);MINFIZ;"Ft."
610 PRINT "Atlagfizetes:";TAB(32);ROUND(SUM/DB,2);"Ft."
620 IF FFI<>0 THEN PRINT "Ferfi dolgozok atlagfizetese: ";ROUND(SUMF/FFI,2);"Ft."
630 IF DB-FFI<>0 THEN PRINT "Noi dolgozok atlagfizetese:";TAB(32);ROUND((SUM-SUMF)/(DB-FFI),2);"Ft."
640 PRINT "Havi berek:";TAB(32);SUM;"Ft."
650 CALL WAITKEY
660 PRINT "A legtobbet keresok:"
670 PRINT "Nev";TAB(28);"eletkor";TAB(40);"fizetes"
680 FOR I=1 TO DB
690 IF ADAT(3,I)=MAXFIZ THEN PRINT NEV$(I);TAB(29);EV-ADAT(2,I);TAB(38);ADAT(3,I);"Ft"
700 NEXT
710 CALL WAITKEY
720 PRINT "A legidosebb dolgozok:"
730 PRINT "Nev";TAB(28);"eletkor";TAB(40);"fizetes"
740 FOR I=1 TO DB
750 IF EV-ADAT(2,I)=IDOS THEN PRINT NEV$(I);TAB(29);EV-ADAT(2,I);TAB(38);ADAT(3,I);"Ft"
760 NEXT
770 CALL WAITKEY
780 PRINT "A legfiatalabb dolgozok:"
790 PRINT "Nev";TAB(28);"eletkor";TAB(40);"fizetes"
800 FOR I=1 TO DB
810 IF EV-ADAT(2,I)=FIATAL THEN PRINT NEV$(I);TAB(29);EV-ADAT(2,I);TAB(38);ADAT(3,I);"Ft"
820 NEXT
830 DEF WAITKEY
840 PRINT :PRINT TAB(50);"Nyomj meg egy billentyut!"
850 DO
860 LOOP WHILE INKEY$=""
870 PRINT
880 END DEF
3.7. Vektor elemeinek rendezése I.
Töltsünk fel véletlenszerű értékekkel egy n elemű tömböt, majd rendezzük a számokat minimumkiválasztásos rendezéssel növekvő sorrendbe! Jelenítsük meg a tömb elemeit rendezés előtt és rendezés után!
100 PROGRAM "Rendez1.bas"
110 RANDOMIZE
120 DO
130 INPUT PROMPT "Elemek szama (max. 300) ":BE$
140 LET N=INT(VAL(BE$))
150 LOOP UNTIL N>1 AND N<301
160 NUMERIC TOMB(1 TO N)
170 CALL INIT(TOMB)
180 CALL WRITE(TOMB)
190 CALL SELECTIONSORT(TOMB)
200 CALL WRITE(TOMB)
210 DEF INIT(REF A)
220 FOR I=LBOUND(A) TO UBOUND(A)
230 LET A(I)=RND(98)+1
240 NEXT
250 END DEF
260 DEF WRITE(REF A)
270 FOR I=LBOUND(A) TO UBOUND(A)
280 PRINT A(I);
290 NEXT
300 PRINT
310 END DEF
320 DEF SELECTIONSORT(REF A)
330 FOR I=LBOUND(A) TO UBOUND(A)-1
340 LET MN=A(I):LET INDEX=I
350 FOR J=I+1 TO UBOUND(A)
360 IF MN>A(J) THEN LET MN=A(J):LET INDEX=J
370 NEXT
380 LET A(INDEX)=A(I):LET A(I)=MN
390 NEXT
400 END DEF
3.8. Vektor elemeinek rendezése II.
a) Az előző (3.7.) feladatot oldjuk meg fésűs rendezéssel!
100 PROGRAM "Rendez2.bas"
...
190 CALL COMBSORT(TOMB)
...
320 DEF COMBSORT(REF A)
330 LET N,GAP=UBOUND(A):LET SW=1
340 DO WHILE GAP>1 OR SW
350 LET GAP=MAX(INT(GAP/1.3),1)
360 LET SW=0
370 FOR I=LBOUND(A) TO N-GAP
380 IF A(I)>A(I+GAP) THEN
390 LET T=A(I):LET A(I)=A(I+GAP):LET A(I+GAP)=T
400 LET SW=1
410 END IF
420 NEXT
430 LOOP
440 END DEF
b) Az előző (3.7.) feladatot oldjuk meg buborék rendezéssel!
320 DEF BUBBLESORT(REF A)
330 DO
340 LET CH=0
350 FOR I=LBOUND(A) TO UBOUND(A)-1
360 IF A(I)>A(I+1) THEN LET T=A(I):LET A(I)=A(I+1):LET A(I+1)=T:LET CH=1
370 NEXT
380 LOOP WHILE CH
390 END DEF
c) Az előző (3.7.) feladatot oldjuk meg kétirányú buborék rendezéssel!
320 DEF COCKTAILSORT(REF A)
330 LET ST=LBOUND(A)+1:LET EN=UBOUND(A):LET D,CH=1
340 DO
350 FOR J=ST TO EN STEP D
360 IF A(J-1)>A(J) THEN LET T=A(J-1):LET A(J-1)=A(J):LET A(J)=T:LET CH=J
370 NEXT
380 LET EN=ST:LET ST=CH-D:LET D=-1*D
390 LOOP UNTIL EN*D<ST*D
400 END DEF
d) Az előző (3.7.) feladatot oldjuk meg beillesztéses rendezéssel!
320 DEF INSERTSORT(REF A)
330 FOR J=LBOUND(A)+1 TO UBOUND(A)
340 LET I=J-1:LET SW=A(J)
350 DO WHILE I>=LBOUND(A) AND SW<A(I)
360 LET A(I+1)=A(I):LET I=I-1
370 LOOP
380 LET A(I+1)=SW
390 NEXT
400 END DEF
3.9. Vektor elemeinek rendezése III.
Töltsünk fel véletlenszerű értékekkel egy n elemű tömböt, majd rendezzük a számokat gyorsrendezéssel!
100 PROGRAM "Rendez3.bas"
110 RANDOMIZE
120 DO
130 INPUT PROMPT "Elemek szama (max. 1000) ":BE$
140 LET N=INT(VAL(BE$))
150 LOOP UNTIL N>0 AND N<1001
160 NUMERIC A(1 TO N)
170 CALL TOLT
180 CALL KI
190 CALL QUICK(1,N)
200 CALL KI
210 DEF KI
220 FOR Z=1 TO N
230 PRINT A(Z);
240 NEXT
250 PRINT :PRINT
260 END DEF
270 DEF TOLT
280 FOR I=1 TO N
290 LET A(I)=RND(N)+1
300 NEXT
310 END DEF
320 DEF QUICK(AH,FH)
330 NUMERIC E
340 LET E=AH:LET U=FH:LET K=A(E)
350 DO UNTIL E=U
360 FOR U=U TO E+1 STEP-1
370 IF K>A(U) THEN
380 LET A(E)=A(U)
390 FOR E=E+1 TO U-1
400 IF K<A(E) THEN LET A(U)=A(E):LET U=U-1:EXIT FOR
410 NEXT
420 EXIT FOR
430 END IF
440 NEXT
450 LOOP
460 LET A(E)=K
470 IF AH<E-1 THEN CALL QUICK(AH,E-1)
480 IF E+1<FH THEN CALL QUICK(E+1,FH)
490 END DEF
3.10. Indexvektoros rendezés
Készítsünk programot, amely beolvas neveket és a hozzá tartozó e-mail címet és telefonszámot! A neveket a NEV, az e-mail címeket az EMAIL, a telefonszámokat a TEL nevű tömbben tároljuk, a programot készítsük fel n adathármas fogadására. A beolvasott adatokat rendezzük név szerint növekvő sorba, úgy, hogy a vektorok elemeinek felcserélése helyett a rendezett sorrendjüket egy IDX nevű tömbben tárolja. Jelenítsük meg a rendezett listát!
Az indexvektoros rendezés lényege, hogy a rendezendő tömb elemeit nem mozgatjuk, hanem a tömbhöz egy indexvektort rendelünk, melyben a tömb elemeire mutató indexek a tömb rendezettségének megfelelően követik egymást. A indexvektor minden indexéhez pontosan egy adat tartozik az eredeti tömbben, az index erre az adatra mutat.
A BASIC nyelvű reláció csak azonos string-hosszak esetén ad helyes eredményt. Eltérő karakterszámú szövegfüzéreknél gondoskodni kell, hogy az összehasonlítás azonos hosszúságnál jöjjön létre.
100 PROGRAM "Rendez4.bas"
110 LET N=200
120 STRING NEV$(1 TO N)*26,EMAIL$(1 TO N)*32,TEL$(1 TO N)*14,S$*32
130 NUMERIC IDX(1 TO N)
140 TEXT 80
150 LET DB=0
160 CALL INIC
170 CALL BEVITEL
180 CALL RENDEZ
190 CALL LISTAZ
200 DEF INIC
210 LET S$=" "
220 FOR I=1 TO N
230 LET IDX(I)=I
240 NEXT
250 END DEF
260 DEF BEVITEL
270 DO
280 LET DB=DB+1
290 PRINT DB;:INPUT PROMPT ". Nev: ":BE$
300 LET NEV$(DB)=BE$(1:26)
310 DO
320 INPUT PROMPT " e-mail: ":BE$
330 LOOP WHILE POS(BE$,"@")=0 OR POS(BE$,".")=0 OR POS(BE$," ")<>0 OR LEN(BE$)>32
340 LET EMAIL$(DB)=BE$
350 INPUT PROMPT " tel: ":BE$
360 LET TEL$(DB)=BE$(1:(MIN(14,LEN(BE$))))
370 IF DB<>N THEN
380 PRINT "Uj felvitel?"
390 DO
400 LET KEY$=INKEY$
410 LOOP WHILE KEY$=""
420 END IF
430 LOOP UNTIL LCASE$(KEY$)<>"i" OR DB=N
440 END DEF
450 DEF LISTAZ
460 PRINT "Nev";TAB(29);"e-mail";TAB(66);"Telefon"
470 FOR I=1 TO DB
480 PRINT NEV$(IDX(I));TAB(29);EMAIL$(IDX(I));TAB(63);TEL$(IDX(I))
490 NEXT
500 END DEF
510 DEF RENDEZ
520 FOR I=1 TO DB-1
530 LET MN=I
540 FOR J=I+1 TO DB
550 IF NEV$(IDX(J))&S$(LEN(NEV$(IDX(J)))+1:)<NEV$(IDX(MN))&S$(LEN(NEV$(IDX(MN)))+1:) THEN LET MN=J
560 NEXT
570 IF I<>MN THEN LET S=IDX(I):LET IDX(I)=IDX(MN):LET IDX(MN)=S
580 NEXT
590 END DEF
3.11. Rendezett tábla létrehozása
Az előbbi, 3.10-es feladatra készített Rendez4.bas programot alakítsuk át úgy, hogy minden adathármas beírása után a tábla megfelelő helyére szúrja be az új nevet és hozzá tartozó adatokat! A rendezett táblát minden adatbevitel után jelenítsük meg újra.
100 PROGRAM "Rendez5.bas"
110 LET N=200
120 STRING NEV$(1 TO N)*26,EMAIL$(1 TO N)*32,TEL$(1 TO N)*14,S$*32
130 NUMERIC IDX(1 TO N)
140 TEXT 80
150 LET DB=0
160 CALL INIC
170 CALL BEVITEL
180 DEF INIC
190 LET S$=" "
200 FOR I=1 TO N
210 LET IDX(I)=I
220 NEXT
230 END DEF
240 DEF BEVITEL
250 STRING NEVBE$*26,EMAILBE$*32,TELBE$*14
260 DO
270 LET DB=DB+1
280 PRINT DB;:INPUT PROMPT ". Nev: ":BE$
290 LET NEVBE$=BE$(1:26)
300 DO
310 INPUT PROMPT " e-mail: ":BE$
320 LOOP WHILE POS(BE$,"@")=0 OR POS(BE$,".")=0 OR POS(BE$," ")<>0 OR LEN(BE$)>32
330 LET EMAILBE$=BE$
340 INPUT PROMPT " tel: ":BE$
350 LET TELBE$=BE$(1:(MIN(14,LEN(BE$))))
360 CALL BESZUR(NEVBE$,EMAILBE$,TELBE$)
370 CALL LISTAZ
380 IF DB<>N THEN
390 PRINT "Uj felvitel?":PRINT
400 DO
410 LET KEY$=INKEY$
420 LOOP WHILE KEY$=""
430 END IF
440 LOOP UNTIL LCASE$(KEY$)<>"i" OR DB=N
450 END DEF
460 DEF BESZUR(N$,E$,T$)
470 FOR I=DB TO 2 STEP-1
480 IF NEV$(I-1)&S$(LEN(NEV$(I-1))+1:)>N$&S$(LEN(N$)+1:) THEN
490 LET NEV$(I)=NEV$(I-1):LET EMAIL$(I)=EMAIL$(I-1):LET TEL$(I)=TEL$(I-1)
500 ELSE
510 EXIT FOR
520 END IF
530 NEXT
540 LET NEV$(I)=N$:LET EMAIL$(I)=E$:LET TEL$(I)=T$
550 END DEF
560 DEF LISTAZ
570 PRINT :PRINT "Nev";TAB(29);"e-mail";TAB(66);"Telefon"
580 FOR I=1 TO DB
590 PRINT NEV$(I);TAB(29);EMAIL$(I);TAB(63);TEL$(I)
600 NEXT
610 END DEF
3.12. Szöveg rendezése ékezetes karakterekkel
Olvassunk be maximum N nevet, a beolvasást üres string beviteléig végezzük. A beolvasott neveket rendezzük ABC sorrendbe az ékezetes karakterek figyelembevételével, majd jelenítsük meg a rendezett listát!
Bármilyen rendezési elvet is (a példában Fésűs rendezést) használunk, ASCII kód alapján nem lehet összehasonlítani a szövegfüzérek tartalmát. A megoldás alapja egy átkódolás, amely a karakterek kódjának olyan átrendezését jelenti, melynek során az ékezetes karakterek kódjai az angol ABC karakterei közé sorakoznak be. A megoldás lényege a NAGYOBB(string1,string2) függvény, amely string1 szövegfüzérről eldönti, nagyobb-e, mint string szövegfüzér.
100 PROGRAM "Rendez7.bas"
105 EXT "HFONT"
110 LET N=100:LET DB=0
120 STRING NEV$(1 TO N)*32,ABC$*68
130 LET ABC$="AaÁáBbCcDdEeÉéFfGgHhIiÍíJjKkLlMmNnOoÓóÖöŐőPpQqRrSsTtUuÚúÜüŰűVvXxYyZz"
140 CALL BEOLVAS
160 CALL RENDEZ
170 CALL KIIR
180 DEF BEOLVAS
190 DO
200 LET DB=DB+1
210 PRINT DB;:INPUT PROMPT ". név: ":NEV$(DB)
220 LOOP UNTIL NEV$(DB)="" OR DB=N
230 IF NEV$(DB)="" THEN LET DB=DB-1
240 END DEF
250 DEF KIIR
260 FOR I=1 TO DB
270 PRINT I,NEV$(I)
280 NEXT
300 END DEF
310 DEF RENDEZ
320 LET GAP=DB:LET SW=1
330 DO WHILE GAP>1 OR SW
340 LET GAP=MAX(INT(GAP/1.3),1)
350 LET SW=0
360 FOR I=1 TO DB-GAP
370 IF NAGYOBB(NEV$(I),NEV$(I+GAP)) THEN
380 LET T$=NEV$(I):LET NEV$(I)=NEV$(I+GAP):LET NEV$(I+GAP)=T$
390 LET SW=1
400 END IF
410 NEXT
420 LOOP
430 END DEF
440 DEF NAGYOBB(A$,B$)
450 IF A$=B$ THEN LET NAGYOBB=0:EXIT DEF
460 LET NR=MAX(LEN(A$),LEN(B$))
470 FOR J=1 TO NR
475 LET A=POS(ABC$,A$(J)):LET B=POS(ABC$,B$(J))
480 IF A>B THEN LET NAGYOBB=-1:EXIT FOR
490 IF A<B THEN LET NAGYOBB=0:EXIT FOR
510 NEXT
520 END DEF
3.13. Rendezés két szempont szerint
Bemeneti adatok: az alábbi adathármasokat olvassuk be: név (NEV), születési év (SZEV), fizetés (FIZU). A programot maximum N adathármas kezelésére készítsük fel. A beolvasás N-ig tartson, vagy ameddig névnek üres stringet adunk meg.
Feladat: rendezzük az adathármasokat születési év szerint növekvő, azon belül fizetések szerint csökkenő sorrendbe (fésűs rendezéssel)!
A kimeneti adatokat a következőképen tagoljuk:
100 PROGRAM "Rendez6.bas"
110 LET N=100:LET DB=0
120 STRING NEV$(1 TO N)*30
130 NUMERIC SZEV(1 TO N),FIZU(1 TO N)
140 TEXT 80
150 CALL BEOLVAS
160 CALL RENDEZ
170 IF DB>0 THEN CALL LISTAZ
180 DEF BEOLVAS
190 DO
200 PRINT DB+1;:INPUT PROMPT ". Nev: ":NEV$(DB+1)
210 IF NEV$(DB+1)="" THEN EXIT DO
220 LET DB=DB+1
230 INPUT PROMPT "Szuletesi ev: ":SZEV(DB)
240 INPUT PROMPT "Fizetes: ":FIZU(DB)
250 PRINT
260 LOOP UNTIL DB=N
270 END DEF
280 DEF LISTAZ
290 CALL FEJLEC
300 PRINT NEV$(1);TAB(33);SZEV(1);TAB(42);FIZU(1);"Ft":LET SOR=1
310 FOR I=2 TO DB
320 IF SZEV(I)<>SZEV(I-1) THEN PRINT :LET SOR=SOR+1
330 PRINT NEV$(I);TAB(33);SZEV(I);TAB(42);FIZU(I);"Ft":LET SOR=SOR+1
340 IF SOR>=22 THEN
350 LET SOR=1
360 DO
370 LOOP WHILE INKEY$=""
380 CALL FEJLEC
390 END IF
400 NEXT
410 END DEF
420 DEF FEJLEC
430 CLEAR SCREEN
440 PRINT "Nev";TAB(32);"Szul. ev Fizetes"
450 END DEF
460 DEF RENDEZ
470 LET GAP=DB:LET SW=1
480 DO WHILE GAP>1 OR SW
490 LET GAP=MAX(INT(GAP/1.3),1)
500 LET SW=0
510 FOR I=1 TO DB-GAP
520 IF SZEV(I)>SZEV(I+GAP) OR SZEV(I)=SZEV(I+GAP) AND FIZU(I)<FIZU(I+GAP) THEN
530 LET T$=NEV$(I):LET NEV$(I)=NEV$(I+GAP):LET NEV$(I+GAP)=T$
540 LET T=SZEV(I):LET SZEV(I)=SZEV(I+GAP):LET SZEV(I+GAP)=T
550 LET T=FIZU(I):LET FIZU(I)=FIZU(I+GAP):LET FIZU(I+GAP)=T
560 LET SW=1
570 END IF
580 NEXT
590 LOOP
600 END DEF
3.14. Rendezett tömbök összefuttatása
Töltsünk fel egy M és egy N elemszámú tömböt véletlenszerű elemekkel úgy, hogy mindkettő növekvően rendezett legyen! Állítsunk elő belőlük egy sorozatot (egy harmadik tömbben) úgy, hogy az eredeti sorozatok minden eleme szerepeljen benne, és ez a sorozat is rendezett legyen! A feladat tulajdonképpen az unió tétel speciális esete: uniót kell előállítani úgy, hogy a rendezettség megmaradjon.
100 PROGRAM "Valogat.bas"
110 RANDOMIZE
120 LET M=8:LET N=6
130 NUMERIC A(1 TO M),B(1 TO N)
140 NUMERIC C(1 TO UBOUND(A)+UBOUND(B))
150 CALL TOLT(A):CALL TOLT(B)
160 PRINT "A tomb:";:CALL KI(A)
170 PRINT "B tomb:";:CALL KI(B)
180 CALL VALOGAT
190 PRINT "Unio: ";:CALL KI(C)
200 END
210 DEF TOLT(REF T)
220 LET T(1)=RND(10)+1
230 FOR I=2 TO UBOUND(T)
240 LET T(I)=T(I-1)+RND(5)+1
250 NEXT
260 END DEF
270 DEF KI(REF T)
280 FOR I=1 TO UBOUND(T)
290 PRINT T(I);" ";
300 NEXT
310 PRINT
320 END DEF
330 DEF VALOGAT
340 LET J,K=1
350 FOR I=1 TO M
360 DO WHILE J<=N AND A(I)>B(J)
370 LET C(K)=B(J):LET J=J+1:LET K=K+1
380 LOOP
390 LET C(K)=A(I):LET K=K+1
400 NEXT
410 FOR I=J TO N
420 LET C(K)=B(I):LET K=K+1
430 NEXT
440 END DEF
3.15. Rendezett tömbök összefuttatása II.
Töltsünk fel egy M és egy N elemszámú tömböt véletlenszerű elemekkel úgy, hogy most az egyik növekvő a másik csökkenő sorrendben legyen! Állítsunk elő belőlük egy sorozatot (egy harmadik tömbben) úgy, hogy az eredeti sorozatok minden eleme szerepeljen benne, és ez a sorozat növekvő sorrendben rendezett legyen!
100 PROGRAM "Valogat2.bas"
110 RANDOMIZE
120 LET M=8:LET N=6
130 NUMERIC A(1 TO M),B(1 TO N)
140 NUMERIC C(1 TO UBOUND(A)+UBOUND(B))
150 CALL TOLT(A,1):CALL TOLT(B,-1)
160 PRINT "A tomb:";:CALL KI(A)
170 PRINT "B tomb:";:CALL KI(B)
180 CALL VALOGAT
190 PRINT "C tomb:";:CALL KI(C)
200 END
210 DEF TOLT(REF T,E)
220 LET T(1)=RND(10)+10
230 IF E=-1 THEN LET T(1)=T(1)+UBOUND(T)*2
240 FOR I=2 TO UBOUND(T)
250 LET T(I)=T(I-1)+((RND(4)+1)*E)
255 NEXT
260 END DEF
270 DEF KI(REF T)
280 FOR I=1 TO UBOUND(T)
290 PRINT T(I);" ";
300 NEXT
310 PRINT
320 END DEF
330 DEF VALOGAT
340 LET J=N:LET K=1
350 FOR I=1 TO M
360 DO WHILE J>=1 AND A(I)>B(J)
370 LET C(K)=B(J):LET J=J-1:LET K=K+1
380 LOOP
390 LET C(K)=A(I):LET K=K+1
400 NEXT
410 FOR I=J TO 1 STEP-1
420 LET C(K)=B(I):LET K=K+1
430 NEXT
440 END DEF
3.16. Metszetképzés
Töltsünk fel egy M és egy N elemszámú tömböt véletlenszerű elemekkel úgy, hogy mindkettő növekvően rendezett legyen (mint a 3.14. feladatban)! Állítsunk elő egy harmadik tömbben a két tömb metszetét! (Két halmaz metszetébe azok az elemek tartoznak, amelyek mindkettőben szerepelnek.
100 PROGRAM "Metszet.bas"
110 RANDOMIZE
120 LET M=10:LET N=10
130 NUMERIC A(1 TO M),B(1 TO N)
140 NUMERIC C(0 TO MIN(M,N))
150 CALL TOLT(A):CALL TOLT(B)
160 PRINT "A tomb: ";:CALL KI(A)
170 PRINT "B tomb: ";:CALL KI(B)
180 CALL METSZET
190 PRINT "Metszet:";
200 FOR I=1 TO C(0)
210 PRINT C(I);" ";
220 NEXT
230 END
240 DEF TOLT(REF T)
250 LET T(1)=RND(10)+1
260 FOR I=2 TO UBOUND(T)
270 LET T(I)=T(I-1)+RND(5)+1
280 NEXT
290 END DEF
300 DEF KI(REF T)
310 FOR I=1 TO UBOUND(T)
320 PRINT T(I);" ";
330 NEXT
340 PRINT
350 END DEF
360 DEF METSZET
370 LET CN=0
380 FOR I=1 TO N
390 LET J=1
400 DO WHILE J<=M AND A(J)<>B(I)
410 LET J=J+1
420 LOOP
430 IF J<=M THEN LET CN=CN+1:LET C(CN)=A(J)
440 NEXT
450 LET C(0)=CN
460 END DEF
3.17. Lineáris keresés vektorban
A 3.11-es feladatra készített Rendez5.bas programot egészítsük ki keresés funkcióval: Az adatbevitel után listázzuk ki az összes olyan nevet, amelyben szerepel a megadott névtöredék! A kisbetű-nagybetű eltérést hagyja figyelmen kívül!
100 PROGRAM "Keres.bas"
...
175 CALL KERESES
...
620 DEF KERESES
630 INPUT PROMPT "Keresett nevtoredek: ":BE$
640 LET BE$=LCASE$(BE$(1:26)):LET VAN=0
650 PRINT :PRINT "Nev";TAB(29);"e-mail";TAB(66);"Telefon"
660 FOR I=1 TO DB
670 IF POS(LCASE$(NEV$(I)),BE$)>0 THEN PRINT NEV$(I);TAB(29);EMAIL$(I);TAB(63);TEL$(I):LET VAN=-1
680 NEXT
690 IF NOT VAN THEN PRINT "Nincs talalat!"
700 END DEF
3.18. Logaritmikus keresés
Írjunk függvényt, amely egy rendezett n elemű A tömbben, a lehető leggyorsabban megadja a keresett elem sorszámát. Ha a keresett elem nem található a tömbben, 0 (hamis) értéket adjon vissza a függvény.
100 PROGRAM "Keres3.bas"
110 LET N=10
120 NUMERIC A(1 TO N)
130 FOR I=1 TO N
140 LET A(I)=I*2
150 PRINT A(I);
160 NEXT
170 PRINT :INPUT PROMPT "Keresett ertek: ":X
180 PRINT KERESES(X)
190 DEF KERESES(X)
200 LET AH=1:LET FH=N:LET KERESES=0
210 DO
220 LET K=INT((AH+FH)/2)
230 SELECT CASE A(K)
240 CASE IS<X
250 LET AH=K+1
260 CASE IS>X
270 LET FH=K-1
280 CASE ELSE
290 LET KERESES=K
300 END SELECT
310 LOOP UNTIL AH>FH OR A(K)=X
320 END DEF
3.19. Betűstatisztika
Olvassunk be egy maximális hosszúságú szöveges változóba egy tetszőleges szöveget. Készítsünk statisztikát a benne előforduló betűk (az egyszerűség kedvéért csak az angol ABC betűi) előfordulási számára vonatkozóan!
100 PROGRAM "Betustat.bas"
110 STRING S$*254
120 NUMERIC BETU(65 TO 90)
130 FOR I=65 TO 90
140 LET BETU(I)=0
150 NEXT
160 INPUT PROMPT "Szoveg: ":S$
170 FOR I=1 TO LEN(S$)
180 LET N=ORD(UCASE$(S$(I)))
190 IF N>64 AND N<91 THEN LET BETU(N)=BETU(N)+1
200 NEXT
210 FOR I=65 TO 89 STEP 2
220 PRINT CHR$(I);" betu =";BETU(I);"db";TAB(26);CHR$(I+1);" betu =";BETU(I+1);"db"
230 NEXT
3.20. Logaritmikus keresés alkalmazása karakterfüzérre
A 3.11-es feladatra készített Rendez5.bas programot egészítsük ki úgy, hogy ne fogadja el két azonos nevű személyek felvételét (hogy később meg tudjuk különböztetni őket).
Mivel a lista nevek szerint rendezett, használhatjuk a logaritmikus keresést.
100 PROGRAM "Keres2.bas"
...
275 DO
280 PRINT DB;:INPUT PROMPT ". Nev: ":BE$
285 LOOP WHILE VANILYEN(BE$(1:26))
...
710 DEF VANILYEN(N2$)
720 LET VANILYEN=0:LET AH=1:LET FH=DB-1:LET N2$=N2$&S$(LEN(N2$)+1:)
730 IF DB>1 THEN
740 DO
750 LET K=INT((AH+FH)/2):LET N1$=NEV$(K)&S$(LEN(NEV$(K))+1:)
760 IF N1$<N2$ THEN LET AH=K+1
770 IF N1$>N2$ THEN LET FH=FH-1
780 LOOP WHILE AH<=FH AND N1$<>N2$
790 IF AH<=FH THEN LET VANILYEN=K:PRINT "Van mar ilyen nev!"
800 END IF
810 END DEF
4. Adatfeldolgozási algoritmusok
Adatfeldolgozási alapalgoritmusok
4.1. Szöveges állomány megjelenítése
Írjunk programot, amely a megadott nevű, soronként max. 78 megjeleníthető karaktert tartalmazó szöveges állományt megjeleníti a képernyőn!
100 PROGRAM "txtlist.bas"
110 TEXT 80
120 INPUT PROMPT "File-nev (kiterjesztes nelkul): ":FNEV$
130 LET FNEV$=FNEV$&".txt"
140 OPEN £1:FNEV$ ACCESS INPUT
150 WHEN EXCEPTION USE IOERROR
160 DO
170 LINE INPUT £1:SOR$
180 PRINT SOR$
190 LOOP
200 END WHEN
210 HANDLER IOERROR
220 IF EXTYPE<>8001 THEN PRINT EXSTRING$(EXTYPE)
230 CLOSE £1
240 END HANDLER
Egyszerűbb megoldás az operációs rendszer funkcióit felhasználva:
100 OPEN £1:FNEV$ ACCESS INPUT
110 COPY FROM £1 TO £0
120 CLOSE £1
4.2. Szekvenciális állomány létrehozása
A rendszer bemenetéről a következő adathármasokat olvassuk be:
A bevitt adatokat a KONYVEK.DAT szekvenciális állományba mentsük. Az adatbevitel "bolondbiztos" legyen, és nemleges válaszig tart.
100 PROGRAM "Konyv1.bas"
110 LET N=300:LET DB=0
120 STRING CIM$*40,SZERZO$*30
130 OPEN £1:"KONYVEK.DAT" ACCESS OUTPUT
140 CALL BEOLVAS
150 DEF BEOLVAS
160 WHEN EXCEPTION USE IOERROR
170 DO
180 LET DB=DB+1
190 DO
200 PRINT :PRINT DB;:INPUT PROMPT ". kony cime: ":BE$
210 LET CIM$=BE$(1:40)
220 INPUT PROMPT " szerzo: ":BE$
230 LET SZERZO$=BE$(1:30)
240 DO
250 INPUT PROMPT " Kiadas eve: ":BE$
260 LET KIAD=VAL(BE$)
270 LOOP UNTIL KIAD>1600 AND KIAD<2060
280 PRINT "Helyesek az adatok?"
290 LOOP UNTIL KERDES
300 PRINT £1:CIM$
301 PRINT £1:SZERZO$
302 PRINT £1:KIAD
310 IF DB<N THEN PRINT "Uj felvitel?":LET UJ=KERDES
320 LOOP WHILE DB<N AND UJ
330 CLOSE £1
340 END WHEN
350 HANDLER IOERROR
360 CLOSE £1
370 PRINT :PRINT EXSTRING$(EXTYPE)
380 END
390 END HANDLER
400 END DEF
410 DEF KERDES
420 LET KERDES=0
430 DO
440 LET KEY$=INKEY$:LET KEY$=LCASE$(KEY$)
450 LOOP UNTIL KEY$="i" OR KEY$="n"
460 IF KEY$="i" THEN LET KERDES=-1
470 END DEF
4.3. Szekvenciális állomány visszaolvasása, listázása
Olvassuk vissza a 4.2. feladatban létrehozott KONYVEK.DAT állományt, és jelenítsük meg a képernyőn táblázatos formában! A listázás oldalanként történjen, minden oldal végén várakozzon a program billentyű lenyomására. A lista fejlécet is tartalmazzon.
100 PROGRAM "Konyv2.bas"
110 LET N=300:LET DB=0
120 TEXT 80
130 CALL LISTAZ
140 DEF LISTAZ
150 OPEN £1:"KONYVEK.DAT" ACCESS INPUT
160 WHEN EXCEPTION USE IOERROR
170 DO
180 PRINT "Cim";TAB(43);"Szerzo";TAB(73);"Kiadas"
190 LET P=1
200 DO
210 INPUT £1:CIM$,SZERZO$,KIAD
220 PRINT CIM$;TAB(43);SZERZO$;TAB(74);KIAD
230 LET P=P+1
240 LOOP UNTIL P=22
250 DO
260 LOOP UNTIL INKEY$<>""
270 LET P=1
280 CLEAR SCREEN
290 LOOP
300 END WHEN
310 HANDLER IOERROR
320 IF EXTYPE<>8001 THEN PRINT :PRINT EXSTRING$(EXTYPE)
330 CLOSE £1
340 END HANDLER
350 END DEF
4.4. Telefonkönyv kimentése, visszatöltése
A 3.9. feladatra megoldására adott Rendez5.bas programot egészítsük ki az adatok kimentésével (az adatok rögzítésének befejeztével) és visszatöltésével (a program indítása után)! Mindkét lehetőségre várjon megerősítést a program és a művelet hibabiztos legyen.
100 PROGRAM "Telefon1.bas"
110 LET N=200
120 STRING NEV$(1 TO N)*26,EMAIL$(1 TO N)*32,TEL$(1 TO N)*14,S$*32,KEY$*1
130 NUMERIC IDX(1 TO N)
140 TEXT 80
150 LET DB=0
160 CALL INIC
170 DO
180 PRINT "Adat-file betoltese?"
190 LET KEY$=CHR$(READKEY)
200 LOOP UNTIL LCASE$(KEY$)<>"i" OR BETOLT
210 IF DB<>0 THEN CALL LISTAZ
220 CALL BEVITEL
230 DO
240 PRINT "Adatfile kimentese?"
245 LET KEY$=CHR$(READKEY)
250 LOOP UNTIL LCASE$(KEY$)<>"i" OR KIMENT
260 DEF INIC
270 LET S$=" "
280 FOR I=1 TO N
290 LET IDX(I)=I
300 NEXT
310 END DEF
320 DEF BEVITEL
330 STRING NEVBE$*26,EMAILBE$*32,TELBE$*14
340 DO
350 LET DB=DB+1
360 PRINT DB;:INPUT PROMPT ". Nev: ":BE$
370 LET NEVBE$=BE$(1:26)
380 DO
390 INPUT PROMPT " e-mail: ":BE$
400 LOOP WHILE POS(BE$,"@")=0 OR POS(BE$,".")=0 OR POS(BE$," ")<>0 OR LEN(BE$)>32
410 LET EMAILBE$=BE$
420 INPUT PROMPT " tel: ":BE$
430 LET TELBE$=BE$(1:(MIN(14,LEN(BE$))))
440 CALL BESZUR(NEVBE$,EMAILBE$,TELBE$)
450 CALL LISTAZ
460 IF DB<>N THEN
470 PRINT "Uj felvitel?":PRINT
480 END IF
490 LOOP UNTIL LCASE$(CHR$(READKEY))<>CHR$(105) OR DB=N
500 END DEF
510 DEF BESZUR(N$,E$,T$)
520 FOR I=DB TO 2 STEP-1
530 IF NEV$(I-1)&S$(LEN(NEV$(I-1))+1:)>N$&S$(LEN(N$)+1:) THEN
540 LET NEV$(I)=NEV$(I-1):LET EMAIL$(I)=EMAIL$(I-1):LET TEL$(I)=TEL$(I-1)
550 ELSE
560 EXIT FOR
570 END IF
580 NEXT
590 LET NEV$(I)=N$:LET EMAIL$(I)=E$:LET TEL$(I)=T$
600 END DEF
610 DEF LISTAZ
620 PRINT :PRINT "Nev";TAB(29);"e-mail";TAB(66);"Telefon"
630 FOR I=1 TO DB
640 PRINT NEV$(I);TAB(29);EMAIL$(I);TAB(63);TEL$(I)
650 NEXT
660 END DEF
670 DEF READKEY
680 STRING KY$*1
690 DO
700 LET KY$=INKEY$
710 LOOP WHILE KY$=""
720 LET READKEY=ORD(KY$)
730 END DEF
740 DEF BETOLT
750 LET BETOLT,RDY=-1
760 WHEN EXCEPTION USE IOERROR
770 OPEN £1:"TELEFON.DAT" ACCESS INPUT
780 IF RDY THEN
790 INPUT £1:DB
800 IF RDY THEN
810 FOR I=1 TO DB
820 INPUT £1:NEV$(I),EMAIL$(I),TEL$(I)
830 IF NOT RDY THEN LET DB=0:EXIT FOR
840 NEXT
850 END IF
860 CLOSE £1
870 END IF
880 END WHEN
890 LET BETOLT=RDY
900 END DEF
910 DEF KIMENT
920 LET KIMENT,RDY=-1
930 WHEN EXCEPTION USE IOERROR
940 OPEN £1:"TELEFON.DAT" ACCESS OUTPUT
950 IF RDY THEN
960 PRINT £1:DB
970 IF RDY THEN
980 FOR I=1 TO DB
990 PRINT £1:NEV$(I):PRINT £1:EMAIL$(I):PRINT £1:TEL$(I)
1000 IF NOT RDY THEN LET KIMENT=0:EXIT FOR
1010 NEXT
1020 END IF
1030 CLOSE £1
1040 END IF
1050 END WHEN
1060 LET KIMENT=RDY
1070 END DEF
1080 HANDLER IOERROR
1090 PRINT "Hiba: ";EXSTRING$(EXTYPE)
1100 LET RDY=0
1110 CONTINUE
1120 END HANDLER
Kivételes esetben megfontolandó, hogy a - BASIC-től annyira nem idegen - GOTO utasítással egyszerűsítsük az algoritmust:
740 DEF BETOLT
750 LET BETOLT,RDY=-1
760 WHEN EXCEPTION USE IOERROR
770 OPEN £1:"TELEFON.DAT" ACCESS INPUT
780 IF NOT RDY THEN 860
790 INPUT £1:DB
800 IF NOT RDY THEN 850
810 FOR I=1 TO DB
820 INPUT £1:NEV$(I),EMAIL$(I),TEL$(I)
830 IF NOT RDY THEN LET DB=0:EXIT FOR
840 NEXT
850 CLOSE £1
860 END WHEN
865 LET BETOLT=RDY
870 END DEF
Személyi nyilvántartási rendszer
4.5. Csoportos adatbevitel
Egy vállalat dolgozóiról - különböző statisztikák készítése céljából - a következő információkat tartják nyilván:
A dolgozók adatai egy azonosító szerint növekvően rendezett (SZNY.DAT nevű) szekvenciális állományban tárolandók. Hozzunk létre egy új állományt és végezzük el az állomány feltöltését.
100 PROGRAM "Szemny1.bas"
110 LET N=99999:LET I=1
120 STRING NEV$*32,TEL$*14
130 NUMERIC ADAT(1 TO 9)
140 TEXT 80
150 OPEN £1:"SZNY.DAT" ACCESS OUTPUT
160 CALL BEOLVAS
170 CLOSE £1
180 DEF BEOLVAS
190 DO
200 CLEAR SCREEN
210 DO
220 PRINT AT 1,1:"Kod: ";I:LET ADAT(1)=I
230 INPUT AT 2,1,PROMPT "Nev: ":BE$
240 LET NEV$=BE$(1:32)
250 PRINT AT 23,1:"(1 - ferfi, 2 - no)":PRINT AT 4,6:"Neme: ";TAB(20);
260 LET ADAT(9)=READKEY(2):PRINT ADAT(9):PRINT AT 23,1:CHR$(161)
270 INPUT AT 5,6,PROMPT "Osztaly kod: ":BE$
280 LET ADAT(2)=VAL(BE$)
290 PRINT AT 23,1:"(1 - igaz., 2 - fooszt. vez., 3 - osz. vez., 4 - csop. vez., 5 - beoszt.)"
300 PRINT AT 6,6:"Beosztas: ";TAB(20);
310 LET ADAT(3)=READKEY(5):PRINT ADAT(3)
320 PRINT AT 23,1:CHR$(161);"(1 - altalanos isk., 2 - kozepfok., 3 - felsofok.)"
330 PRINT AT 7,6:"Vegzettseg: ";TAB(20);
340 LET ADAT(4)=READKEY(3):PRINT ADAT(4):PRINT AT 23,1:CHR$(161)
350 DO
360 INPUT AT 8,6,PROMPT "Belepes eve: ":BE$
370 LET ADAT(5)=INT(VAL(BE$))
380 LOOP UNTIL ADAT(5)>1979 AND ADAT(5)<2080
390 DO
400 INPUT AT 9,6,PROMPT "Szuletes eve: ":BE$
410 LET ADAT(6)=INT(VAL(BE$))
420 LOOP UNTIL ADAT(6)>1940 AND ADAT(6)<ADAT(5)
430 DO
440 INPUT AT 11,6,PROMPT "Fizetes: ":BE$
450 LET ADAT(7)=INT(VAL(BE$))
460 LOOP UNTIL ADAT(7)>0
470 DO
480 INPUT AT 12,6,PROMPT "Potlek: ":BE$
490 LET ADAT(8)=INT(VAL(BE$))
500 LOOP UNTIL ADAT(8)>=0
510 INPUT AT 14,6,PROMPT "Telefon: ":BE$
520 LET TEL$=BE$(1:14)
530 PRINT AT 16,36:"Minden adat megfelelo?";
540 LET BE$=LCASE$(KEY$):PRINT CHR$(165)
550 LOOP UNTIL BE$="i"
560 CALL KIMENT
570 LET I=I+1
580 IF I<=N THEN
590 PRINT AT 17,36:"Uj rekord felvitele?";
600 LET BE$=LCASE$(KEY$)
610 END IF
620 LOOP UNTIL I>N OR BE$<>"i"
630 END DEF
640 DEF KEY$
650 DO
660 LET K$=INKEY$
670 LOOP WHILE K$=""
680 LET KEY$=K$
690 END DEF
700 DEF READKEY(I)
710 DO
720 LET K=VAL(KEY$)
730 LOOP UNTIL K>0 AND K<=I
740 LET READKEY=K
750 END DEF
760 DEF KIMENT
770 WHEN EXCEPTION USE IOERROR
780 PRINT £1:NEV$
790 FOR K=1 TO 9
800 PRINT £1:ADAT(K)
810 NEXT
820 PRINT £1:TEL$:PRINT £1:"A"
830 END WHEN
840 HANDLER IOERROR
850 PRINT AT 22,1:EXSTRING$(EXTYPE)
860 CLOSE £1
870 END
880 END HANDLER
890 END DEF
4.6. Személyi adatállomány nemek szerinti szétválogatása
A 4.5. feladat megoldása során elkészült SZNY.DAT nevű állomány felhasználásával készítsünk két szöveges állományt, melyben az aktív dolgozókat nemük szerint szétválogatjuk. Az SZNY_F.DAT állományban a féfi-, az SZNY_N.TXT állományban a női dolgozókról készítsünk listát a következő formátumban:
Tothkomlosfalussi Aladar
Kod: 1
Osztaly: 4
Beosztas: 5
Vegzettseg: 2
Belepes eve: 1984
Szuletesi ev: 1952
Fizetes: 5400
Potlek: 600
Telefon: (1) 112 486
<üres sor>100 PROGRAM "szemny2.bas"
110 STRING NEV$*32,TEL$*14,ALL$*1
120 NUMERIC ADAT(1 TO 9)
130 STRING M$(1 TO 8)*13
140 LET M$(1)="Kod: ":LET M$(2)="Osztaly: ":LET M$(3)="Beosztas: ":LET M$(4)="Vegzettseg: ":LET M$(5)="Belepes eve: ":LET M$(6)="Szuletesi ev:":LET M$(7)="Fizetes: ":LET M$(8)="Potlek: "
150 OPEN £3:"SZNY.DAT"
160 OPEN £1:"SZNY_F.TXT" ACCESS OUTPUT
170 OPEN £2:"SZNY_N.TXT" ACCESS OUTPUT
180 PRINT "Feldolgozott rekordok:"
190 WHEN EXCEPTION USE IOERROR
200 DO
210 INPUT £3:NEV$
220 FOR K=1 TO 9
230 INPUT £3:ADAT(K)
240 NEXT
250 INPUT £3:TEL$
260 INPUT £3:ALL$
270 IF ALL$="A" THEN CALL KIMENT(ADAT(9))
280 PRINT ADAT(1)
290 LOOP
300 DEF KIMENT(NEM)
310 PRINT £NEM:NEV$
320 FOR I=1 TO 8
330 PRINT £NEM:" ";M$(I);" ";ADAT(I)
340 NEXT
350 PRINT £NEM:" Telefon: ";TEL$:PRINT £NEM:
360 END DEF
370 END WHEN
380 HANDLER IOERROR
390 IF EXTYPE<>8001 THEN
400 PRINT EXSTRING$(EXTYPE):PRINT "A muvelet megszakadt az";ADAT(1);"rekord feldolgozasa kozben!"
410 ELSE
420 PRINT "A muvelet rendben lezajlott!"
430 END IF
440 CLOSE £1:CLOSE £2:CLOSE £3
450 END
460 END HANDLER
4.7. Törzsgárdajutalom
Az SZNY.DAT állományból válasszuk ki a jubiláló dolgozókat, azaz a vállalatnál 5, 10, 15, 20, 25, stb. évet dolgozókat, és számítsuk ki a törzsgárdajutalmukat, amely
A program készítsen listát a jubiláló dolgozókról a JUTALOM.TXT szöveges állományba, az alábbi formában:
Fedák Sári
Kod: 00028
Belepes eve: 2010
Munkaviszony: 5 ev.
Torzsgarda jutalom: 840 Ft
<üres sor>100 PROGRAM "Szemny3.bas"
110 STRING NEV$*32,TEL$*14,AKT$*1
120 NUMERIC ADAT(1 TO 9)
130 EXT "date"
140 LET EV=VAL(DATE$(1:4))
150 OPEN £1:"SZNY.DAT"
160 OPEN £2:"JUTALOM.TXT" ACCESS OUTPUT
170 PRINT "Feldolgozott rekordok:"
180 WHEN EXCEPTION USE IOERROR
190 DO
200 INPUT £1:NEV$
210 FOR I=1 TO 9
220 INPUT £1:ADAT(I)
230 NEXT
240 INPUT £1:TEL$
250 INPUT £1:AKT$
260 LET JUB=(EV-ADAT(5))/5
270 IF FP(JUB)=0 AND AKT$="A" THEN
280 PRINT £2:NEV$
290 PRINT £2:"Kod: ";:PRINT £2,USING "%%%%%":ADAT(1)
300 PRINT £2:"Belepes eve: ";ADAT(5)
310 PRINT £2:"Munkaviszony:";EV-ADAT(5);"ev."
320 PRINT £2:"Torzsgarda jutalom:";ADAT(7)*(JUB*2)/10;"Ft":PRINT £2:
330 END IF
340 PRINT ADAT(1)
350 LOOP
360 END WHEN
370 HANDLER IOERROR
380 IF EXTYPE<>8001 THEN
390 PRINT EXSTRING$(EXTYPE):PRINT "A muvelet megszakadt az";ADAT(1);"rekord feldolgozasa kozben!"
400 ELSE
410 PRINT "A muvelet rendben lezajlott!"
420 END IF
430 CLOSE £1:CLOSE £2
440 END
450 END HANDLER
4.8. Fizetésemelés
A vállalat aktív állományban lévő dolgozói beosztásonként egységes béremelésben részesülnek. Olvassunk be, hogy beosztásnak megfelelően hány százalékkal kívánjuk módosítani a fizetéseket. Az SZNY.DAT állományt módosítsuk ennek megfelelően. Az állomány korábbi verziója kapjon .BAK kiterjesztést.
100 PROGRAM "Szemny4.bas"
110 STRING NEV$*32,TEL$*14,BEO$(1 TO 5)*12,AKT$*1
120 NUMERIC ADAT(1 TO 9)
130 NUMERIC EMEL(1 TO 5)
131 LET BEO$(1)="Igazgato ":LET BEO$(2)="Fooszt. vez.":LET BEO$(3)="Oszt. vez. ":LET BEO$(4)="Csop. vez. ":LET BEO$(5)="Beosztott "
140 CLEAR SCREEN
150 DO
155 FOR I=1 TO 5
160 PRINT AT I+1,3:BEO$(I);:INPUT PROMPT " fizetesemeles (%): ":BE$
170 LET EMEL(I)=(VAL(BE$)+100)/100
255 NEXT
260 PRINT AT 8,5:"Megfelelo?";
270 DO
280 LET BE$=INKEY$
290 LOOP UNTIL BE$="i" OR BE$="I" OR BE$="n" OR BE$="N"
300 PRINT CHR$(165)
310 LOOP UNTIL BE$="i" OR BE$="I"
320 EXT "REN SZNY.DAT SZNY.BAK"
330 OPEN £1:"SZNY.BAK" ACCESS INPUT
340 OPEN £2:"SZNY.DAT" ACCESS OUTPUT
350 PRINT "Feldolgozott rekordok:"
360 WHEN EXCEPTION USE IOERROR
370 DO
380 INPUT £1:NEV$
390 FOR K=1 TO 9
400 INPUT £1:ADAT(K)
410 NEXT
420 INPUT £1:TEL$
430 INPUT £1:AKT$
440 IF AKT$="A" AND EMEL(ADAT(3))<>0 THEN LET ADAT(7)=ADAT(7)*EMEL(ADAT(3))
450 PRINT £2:NEV$
460 FOR K=1 TO 9
470 PRINT £2:ADAT(K)
480 NEXT
490 PRINT £2:TEL$:PRINT £2:AKT$
500 PRINT ADAT(1)
510 LOOP
520 END WHEN
530 HANDLER IOERROR
540 IF EXTYPE<>8001 THEN
550 PRINT EXSTRING$(EXTYPE):PRINT "A muvelet megszakadt az";ADAT(1);"rekord feldolgozasa kozben!"
560 ELSE
570 PRINT "A muvelet rendben lezajlott!"
580 END IF
590 CLOSE £1:CLOSE £2
600 END
610 END HANDLER
4.9. Kimutatás a beosztás és a kor összefüggéséről, valamint a beosztás szerinti átlagfizetésről
A 4.5. feladatban létrehozott adatállomány felhasználásával készítsünk listát a dolgozók kor és beosztás szerinti megoszlásáról, valamint az átlagfizetésről, beosztás szerinti bontásban! A táblázat így nézzen ki:
100 PROGRAM "Szemny5.bas"
110 STRING NEV$*32,TEL$*14,AKT$*1,BEO$(1 TO 5)*12
120 NUMERIC ADAT(1 TO 9),KOR(1 TO 5,1 TO 6),ATLF(1 TO 5)
130 LET BEO$(1)="Igazgato":LET BEO$(2)="Fooszt. vez.":LET BEO$(3)="Oszt. vez.":LET BEO$(4)="Csop. vez.":LET BEO$(5)="Beosztott"
140 EXT "date"
150 LET EV=VAL(DATE$(1:4)):LET EOF=0
160 FOR I=1 TO 5
170 FOR J=1 TO 6
180 LET KOR(I,J)=0
190 NEXT
200 LET ATLF(I)=0
210 NEXT
220 OPEN £1:"SZNY.DAT" ACCESS INPUT
230 PRINT "Feldolgozott rekordok:"
240 WHEN EXCEPTION USE IOERROR
250 DO
260 INPUT £1:NEV$
270 IF EOF THEN EXIT DO
280 FOR I=1 TO 9
290 INPUT £1:ADAT(I)
300 NEXT
310 INPUT £1:TEL$
320 INPUT £1:AKT$
330 IF AKT$="A" THEN
340 SELECT CASE EV-ADAT(6)
350 CASE 0 TO 25
360 LET KOR(ADAT(3),1)=KOR(ADAT(3),1)+1
370 CASE 25 TO 40
380 LET KOR(ADAT(3),2)=KOR(ADAT(3),2)+1
390 CASE 41 TO 55
400 LET KOR(ADAT(3),3)=KOR(ADAT(3),3)+1
410 CASE 56 TO 120
420 LET KOR(ADAT(3),4)=KOR(ADAT(3),4)+1
430 END SELECT
440 END IF
450 LET ATLF(ADAT(3))=ATLF(ADAT(3))+ADAT(7)
460 PRINT ADAT(1)
470 LOOP
480 END WHEN
490 TEXT 80
500 SET £102:PALETTE 0,YELLOW,0,188
510 CALL TABL_KOR
520 CALL TABL_ATLF
530 DEF TABL_KOR
540 PRINT "Szemelyi allomany eletkor szerinti megoszlasa";CHR$(241)
550 SET £102:INK 3:PRINT "Beosztas 26 ev alatt 26-40 ev 41-55 ev 55 ev felett Osszesen":SET £102:INK 1
560 FOR I=1 TO 5
570 SET £102:INK 3:PRINT BEO$(I);:SET £102:INK 1
580 FOR J=1 TO 4
590 PRINT TAB(J*13+3);:PRINT USING "£££££":KOR(I,J);:LET KOR(I,5)=KOR(I,5)+KOR(I,J)
600 NEXT
610 PRINT TAB(68);:PRINT USING "£££££":KOR(I,5)
620 NEXT
630 SET £102:INK 3:PRINT "Osszesen";:SET £102:INK 1
640 FOR I=1 TO 5
650 FOR J=1 TO 5
660 LET KOR(I,6)=KOR(I,6)+KOR(J,I)
670 NEXT
680 PRINT TAB(I*13+3);:PRINT USING "£££££":KOR(I,6),
690 NEXT
700 END DEF
710 DEF TABL_ATLF
720 PRINT :PRINT :PRINT :PRINT "Atlagfizetes beosztas szerint";CHR$(241)
730 FOR I=1 TO 5
740 IF KOR(I,5)<>0 THEN SET £102:INK 3:PRINT BEO$(I),:SET £102:INK 1:PRINT ROUND(ATLF(I)/KOR(I,5));"Ft"
750 NEXT
760 END DEF
770 HANDLER IOERROR
780 IF EXTYPE<>8001 THEN PRINT "A muvelet megszakadt az";ADAT(1);"rekord feldolgozasa kozben!":PRINT EXSTRING$(EXTYPE)
790 LET EOF=-1
800 CLOSE £1
810 CONTINUE
820 END HANDLER
4.10. Személyi állomány aktualizálása
A vállalat dolgozóinak adatairól készült SZNY állományt (amelynek a rekordfelépítése a 4.5. sz. feladatban megtalálható) aktualizálni kell. Új dolgozók belépését, dolgozók kilépését, passzív állományba kerülését, illetve egyes dolgozók adatainak (pl. fizetés, végzettség) megváltozását kell figyelembe venni.
Végezzük el a kívánt változásokat az állományon és hozzuk létre az aktualizált állományt!
4.11. Személyzeti statisztika fiatal nőkről
Adva van egy szekvenciális állomány az alábbi rekordfelépítéssel:
Olvassuk be a rendszer bemenetéről az aktuális évet! Készítsünk listát, amely a 30 év alatti nők nevét, születési évét és fizetését tartalmazza. Minden lap tetejére írjunk fejlécet. A feldolgozás végén írjuk ki, mennyi a 30 év alatti nők átlagbére.
4.12. Összeválogatás
Készítsünk programot az alábbi specifikáció szerint!
Bemeneti adatok: Két cikkszám szerint rendezett F1 és F2 jelű állomány. Az állományvégjel: cikkszám=-1
A rekordképek: cikkszám, árumegnevezés (20 karakter)
Kimeneti adatok: Egy F3 jelű állomány, amely F1 és F2 rekordjait tartalmazza azonos rendezettséggel. Az állományvégjel: cikkszám=-1
4.13. Törzsállomány amortizációjának kiszámítása
Egy vállalat állóeszközeinek adatait egy szekvenciális törzsadatállomány tartalmazza A rekordkép:
Írjunk programot, amely kiszámítja az eszközök az évi amortizációjával csökkentett értékét, és a megfelelő mezőt felülírja az új értékkel!
Az amortizáció mértéke minden évben a következő:
eredeti ár/teljes amortizációs idő
A naprakészítéssel párhuzamosan nyomtassuk ki a teljesen amortizálódott eszközök adatait leíró rekordokat; számítsuk ki és nyomtassuk ki a teljesen amortizálódott eszközök eredeti árának összegét; számítsuk ki és nyomtassuk ki az állóeszközállomány pillanatnyi értékét!
4.14. Leltározási kimutatás
Egy könyvesboltban leltározáskor kimutatást kell készíteni a könyvek műfajok szerinti megoszlásáról. Az adatok egy szekvenciális adatállományon vannak. A rekordkép:
Az állomány katalógusszám szerint rendezett. A katalógusszám első karaktere mutatja meg, hogy az illető mű milyen kategóriájú:
Készítsünk egy olyan listát, amely műfajok szerint csoportosítva tartalmazza minden könyv katalógusszámát, szerzőjét és címét! Műfajváltáskor készítsünk egy összegfokozatot, amely a kategóriába tartozó könyvek számát tartalmazza! A zárósorban írjuk ki az összes könyv számát! Lapot váltani elég műfajváltozáskor.
4.15. Könyvtári állomány selejtezése
A katalógusszám szerint rendezett könyvtári törzsállomány rekordleírása:
A selejtezendő könyvek rendezett katalógusszámai a rendszer bemenetéről érkeznek a '*' végjeiig.
A könyvtári állományt nyilvántartó állományból ki kell törölni a kiselejtezett könyvek rekordjait, és elő kell állítani az új könyvtári állományt. A kiselejtezett könyvekről jegyzéket kell készíteni, amely tartalmazza a könyv katalógusszámát, a szerző nevét és a könyv címét. Minden lap tetejére írjunk fejlécet.
5.1. 3 elem permutációja
Írjuk ki 3 elem (pl. 1, 2, 3) összes permutációját!
Ötlet egy egyszerű megoldáshoz: használjunk három egymásba ágyazott ciklust. A legbelső ciklusban egy feltétel döntse el, hogy a három elem különböző-e, és csak akkor írjuk ki az adott elrendezést, ha igen.
100 PROGRAM "Permut1.bas"
110 FOR A=1 TO 3
120 FOR B=1 TO 3
130 FOR C=1 TO 3
140 IF A<>B AND A<>C AND B<>C THEN PRINT A,B,C
150 NEXT
160 NEXT
170 NEXT
5.2. Permutációk generálása
Állítsuk elő n elem összes permutációját!
Mivel n nem konstans, a feladat már nem oldható meg n-szeresen egymásba ágyazott ciklusok segítségével.
100 PROGRAM "Permut.bas"
110 DO
120 INPUT PROMPT "Elemek szama (2-8) ":N
130 IF N>8 AND N<50 THEN PRINT "Ez";FACT(N);"sorozat lenne!"
140 IF N>=50 THEN PRINT "Ez megszamlalhatatlanul sok sorozat lenne!"
150 LOOP UNTIL N>1 AND N<9
160 NUMERIC T(1 TO N)
170 LET S=0
180 CALL TOLT
190 CALL PERM(N)
200 PRINT S;" sorozat"
210 END
220 DEF TOLT
230 FOR I=1 TO N
240 LET T(I)=I
250 NEXT
260 END DEF
270 DEF PERM(I)
280 NUMERIC J,X
290 IF I=1 THEN
300 FOR X=1 TO N
310 PRINT T(X);
320 NEXT
330 PRINT :LET S=S+1
340 ELSE
350 CALL PERM(I-1)
360 FOR J=1 TO I-1
370 LET C=T(J):LET T(J)=T(I):LET T(I)=C
380 CALL PERM(I-1)
390 LET C=T(J):LET T(J)=T(I):LET T(I)=C
400 NEXT
410 END IF
420 END DEF
430 DEF FACT(X)
440 FOR Y=2 TO X-1
450 LET X=X*Y
460 NEXT
470 LET FACT=X
480 END DEF
5.3. Euler-féle szám
Számítsuk ki az Euler-féle számot (e) az ábrázolható legnagyobb pontossággal!
100 PROGRAM "e.bas"
110 LET E1=0:LET E,N,N1=1
120 DO WHILE E<>E1
130 LET E1=E:LET E=E+1/N
140 LET N1=N1+1:LET N=N*N1
150 LOOP
160 PRINT "e =";E
5.4. Binomiális együtthatók
Írjunk eljárást tetszőleges n és k szám binomiális együtthatójának kiszámítására.
A matematikában, az "n alatt a k" binomiális együttható az (1 + x) n-edik hatványának többtagú kifejezésében az x^k együtthatója. A kombinatorikában egy n elemű halmaz k elemű részhalmazainak a száma, ami azt mutatja meg, hányféleképpen "választhatunk ki" k elemet n elem közül. A képlete:
100 DEF BINOMIAL(N,K)
110 LET R=1:LET D=N-K
120 IF D>K THEN LET K=D:LET D=N-K
130 DO WHILE N>K
140 LET R=R*N:LET N=N-1
150 DO WHILE D>1 AND MOD(R,D)=0
160 LET R=R/D:LET D=D-1
170 LOOP
180 LOOP
190 LET BINOMIAL=R
200 END DEF
5.5. Lottószámok generálása
Állítsunk elő (ötös)lottó nyerőszámokat!
100 PROGRAM "Lotto.bas"
110 RANDOMIZE
120 NUMERIC SZAM(1 TO 5)
130 FOR I=1 TO 5
140 DO
150 LET SZAM(I)=RND(90)+1:LET VAN=0
160 FOR J=1 TO I-1
170 IF SZAM(J)=SZAM(I) THEN LET VAN=-1
180 NEXT
190 LOOP WHILE VAN
200 PRINT SZAM(I),
210 NEXT
220 PRINT
5.6. Bűvös négyzet
Állítsunk elő páratlan rendszámú, n*n-es bűvös négyzetet! (A bűvös négyzetekről a 2.29. feladatban már volt szó.)
A sorok és oszlopok számát (az n-et) a bűvös négyzet rendszámának nevezzük. Háromtól kezdve minden rendszámhoz lehet bűvös számot szerkeszteni, 1*1-es és 2*2-es bűvös négyzetekről nem beszélhetünk.
A páratlan rendszámú bűvös négyzetek kitöltésére viszonylag egyszerű algoritmusok léteznek, ezek egyike az indus módszer: Az egyik (pl. a felső) középső mezőjébe írjuk az egyet, majd átlós irányba felfelé írjuk a következő számot, de minden kilépésnél (mikor kilépünk a táblázatból) ugyanabban a sorban vagy oszlopban a másik oldalon belépünk, majd továbbra is átlós irányban folytatjuk a kitöltést, mindaddig, amíg foglalt mezőhöz nem érünk. Ekkor a következő számot közvetlenül az utoljára beírt szám alá írjuk, és folytatjuk az átlós kitöltést.
A módszer hátránya, hogy csak egyféle megoldást tud előállítani (pedig például 5*5-ös bűvös négyzetből közel 600 000 négyzet lehetséges).
100 PROGRAM "Buvosn.bas"
110 LET MAXN=19
120 TEXT 80
130 DO
140 PRINT "Kerem a buvos negyzet rendszamat (3 ..";MAXN;:INPUT PROMPT "): ":N
150 LOOP UNTIL N=INT(N) AND MOD(N,2)<>0 AND N>2 AND N<=MAXN
160 NUMERIC BN(1 TO N,1 TO N)
170 CALL INIC
180 CALL INDUS
190 CALL KI
200 DEF INIC
210 FOR I=1 TO N
220 FOR J=1 TO N
230 LET BN(I,J)=0
240 NEXT
250 NEXT
260 END DEF
270 DEF KI
280 PRINT
290 FOR I=1 TO N
300 PRINT TAB(38-N*4/2);
310 FOR J=1 TO N
320 PRINT USING " £££":BN(I,J);
330 NEXT
340 PRINT
350 NEXT
360 END DEF
370 DEF INDUS
380 LET X=1:LET Y=ROUND(N/2,0)
390 FOR I=1 TO N^2
400 LET BN(X,Y)=I:LET X=X-1:LET Y=Y+1
410 IF X=0 AND Y>N THEN LET X=X+2:LET Y=Y-1
420 IF X>0 AND X<=N AND Y>0 AND Y<=N THEN
430 IF BN(X,Y)<>0 THEN LET X=X+2:LET Y=Y-1
440 END IF
450 IF X=0 THEN LET X=N
460 IF Y>N THEN LET Y=1
470 NEXT
480 END DEF
5.7. Galton-deszka
Az ábrán látható labirintusban felülről lefelé esik egy golyó; minden háromszögletű akadálynál 50%-50% valószínűséggel jobbra illetve balra halad tovább.
Készítsünk alkalmas modellt, és szimuláljuk 100 golyó esését! Az eredmény az alsó rekeszekbe jutott golyók száma.
100 PROGRAM "Galton.bas"
110 RANDOMIZE
120 NUMERIC A(1 TO 11)
130 FOR I=1 TO 11
140 LET A(I)=0
150 NEXT
160 FOR I=1 TO 100
170 LET P=6
180 FOR J=1 TO 10
190 LET P=P+(INT(RND(2))*2-1)/2
200 NEXT
210 LET A(P)=A(P)+1
220 NEXT
230 PRINT "Galton-deszka":PRINT "A rekeszbe jutott golyok szama:"
240 FOR I=1 TO 11
250 PRINT USING "£££":A(I),
260 NEXT
270 PRINT
5.8. Számkitaláló I.
Játszunk a géppel számkitaláló játékot! A gép gondoljon egy véletlen számra egy és száz között, a játékosnak ki kell találnia.
100 PROGRAM "Szamkit1.bas"
110 RANDOMIZE
120 TEXT 80
130 PRINT "Szamkitalalo":PRINT "Gondoltam egy szamot 1 es 100 kozott, talald ki!":PRINT
140 LET DB=0:LET SZAM=RND(100)+1
150 DO
160 LET DB=DB+1
170 PRINT DB;
180 INPUT PROMPT ". tipped: ":TIPP
190 SELECT CASE TIPP
200 CASE IS>SZAM
210 PRINT "Az en szamom kisebb!"
220 CASE IS<SZAM
230 PRINT "Az en szamom nagyobb!"
240 CASE ELSE
250 PRINT "Eltalaltad a(z)";DB;". probalkozasra."
260 END SELECT
270 LOOP UNTIL SZAM=TIPP
5.9. Számkitaláló II.
Játszunk a géppel számkitaláló játékot! Most a játékos gondoljon egy számra, a gép találja ki! A program jelezze, ha a játékos csal.
100 PROGRAM "Szamkit2.bas"
110 TEXT 80
120 PRINT "Szamkitalalo":PRINT "Gondolj egy szamot 1 es 100 kozott, kitalalom!":PRINT
130 LET AH=1:LET FH=100:LET DB=0
140 DO
150 LET TIPP=INT((AH+FH)/2):LET DB=DB+1
160 SET £102:INK 3:PRINT "A(z)";DB;". tippem: ";TIPP:SET £102:INK 1
170 LET VALASZ=KERDES
180 SELECT CASE VALASZ
190 CASE 1
200 LET FH=TIPP-1
210 CASE 2
220 LET AH=TIPP+1
230 CASE ELSE
240 END SELECT
250 IF AH>FH THEN PRINT "He! Te csalsz!":LET VALASZ=9
260 LOOP UNTIL VALASZ=0 OR VALASZ=9
270 DEF KERDES
280 PRINT "A te szamod: 1 - kisebb?; 2 - nagyobb?; 0 - eltalaltam?"
290 DO
300 LET BE$=INKEY$
310 LOOP UNTIL BE$>="0" AND BE$<="3"
320 LET KERDES=VAL(BE$)
330 END DEF
5.10. Gyufajáték
Játszunk a számítógép ellen gyufajátékot x szál gyufával! Aki az utolsó szálat húzza, veszít. A játékos akkor nyeri meg a játékot, ha arra törekszik, hogy az első húzása után a gyufaszálak a 4 többszöröse plusz 1 legyen (pl. 5, 9, 13, 17), majd a következő húzásoknál 4-re egészítse ki játékostársa húzását. Mivel 21, 25, stb. gyufaszál esetén az veszít, aki kezdi a húzást, a számítógép kezdjen...
100 PROGRAM "Gyufa.bas"
110 RANDOMIZE
120 CLEAR SCREEN
130 LET X=21
140 PRINT ,"**** GYUFAJATEK ***":PRINT
150 PRINT X;"gyufaszallal jatszunnk."
160 PRINT "Felvaltva 1-3 szalat vehetunk el."
170 PRINT "Aki az utolso szalat huzza, veszit!":PRINT
180 DO
190 LET L=MOD((X-1),4)
200 IF L=0 THEN LET L=MIN(RND(3)+1,X)
210 LET X=X-L:LET G=-1
220 PRINT L;"szalat huztam. Maradt";X:PRINT
230 IF X>0 THEN
240 PRINT "A huzasod:";
250 DO
260 LET K=VAL(INKEY$)
270 LOOP UNTIL K>0 AND K<4
280 PRINT K,
290 LET X=X-K:LET G=0
300 IF X<0 THEN PRINT "Nincs mar ennyi szal!":LET X=0
310 PRINT TAB(19);"Maradt";X:PRINT
320 END IF
330 LOOP WHILE X>0
340 IF G THEN
350 PRINT "Vesztettem..."
360 ELSE
370 PRINT "Az utolso szalat vetted el. Vesztettel!"
380 END IF
5.11. Kő-papír-olló
Játszunk kő-papír-olló játékot a gép ellen! A program tippeléskor vegye figyelembe a játékos eddigi választásait. Ha a játékos befejezi a játékot, jelenítsük meg az összesített eredményt.
100 PROGRAM "KoPapir.bas"
110 RANDOMIZE
120 STRING CH$(1 TO 3)*8,K$*1
130 NUMERIC PLWINS(1 TO 3),SCORE(1 TO 3),PLSTAT(1 TO 3),CMSTAT(1 TO 3),PLCHOICE,CMCHOICE
140 CALL INIC
150 DO
160 CALL TIPPEL
170 PRINT :PRINT "Ko, papir, vagy ollo (1 = ko, 2 = papir, 3 = ollo, ESC = kilepes)"
180 DO
190 LET K$=INKEY$
200 LOOP UNTIL K$>="1" AND K$<="3" OR K$=CHR$(27)
210 IF K$=CHR$(27) THEN EXIT DO
220 LET PLCHOICE=VAL(K$)
230 LET CMSTAT(CMCHOICE)=CMSTAT(CMCHOICE)+1
240 LET PLSTAT(PLCHOICE)=PLSTAT(PLCHOICE)+1
250 PRINT "A valasztasod: ";CH$(PLCHOICE);" az en valasztasom: ";CH$(CMCHOICE);"."
260 SET £102:INK 3
270 IF PLCHOICE=CMCHOICE THEN
280 PRINT "Dontetlen!"
290 LET SCORE(3)=SCORE(3)+1
300 ELSE IF CMCHOICE=PLWINS(PLCHOICE) THEN
310 PRINT "Nyertel!"
320 LET SCORE(1)=SCORE(1)+1
330 ELSE
340 PRINT "En nyertem!"
350 LET SCORE(2)=SCORE(2)+1
360 END IF
370 SET £102:INK 1
380 LOOP
390 SET £102:INK 5
400 PRINT :PRINT "Nehany haszontalan statisztikai adat:"
410 PRINT SCORE(1);"alkalommal nyertel, en";SCORE(2);"alkalommal nyertem; dontetlen:";SCORE(3);
420 SET £102:INK 7
430 PRINT :PRINT ,,,CH$(1),CH$(2),CH$(3)
440 PRINT "Valasztasaid:",,PLSTAT(1),PLSTAT(2),PLSTAT(3)
450 PRINT "Az en valasztasaim:",CMSTAT(1),CMSTAT(2),CMSTAT(3)
460 SET £102:INK 1
470 END
480 DEF INIC
490 LET CH$(1)="ko":LET CH$(2)="papir":LET CH$(3)="ollo"
500 LET PLWINS(1)=3:LET PLWINS(2)=1:LET PLWINS(3)=2
510 FOR I=1 TO 3
520 LET PLSTAT(I),CMSTAT(I),SCORE(I)=0
530 NEXT
540 TEXT 80
550 SET £102:PALETTE 0,145,0,251,0,255,0,249
560 END DEF
570 DEF TIPPEL
580 LET CMCHOICE=INT(RND*(PLSTAT(1)+PLSTAT(2)+PLSTAT(3)+3))
590 SELECT CASE CMCHOICE
600 CASE 0 TO PLSTAT(1)
610 LET CMCHOICE=2
620 CASE PLSTAT(1)+1 TO PLSTAT(1)+PLSTAT(2)+1
630 LET CMCHOICE=3
640 CASE ELSE
650 LET CMCHOICE=1
660 END SELECT
670 END DEF
5.12. A kombinett-játék megoldhatóságának eldöntése
Egy négyzet alapú dobozban 16 szintén négyzet alapú kis kő fér el négy sorban és négy oszlopban. Csak 15 kő van megjelölve 1-15-ig, a 16. hely üres. A köveket véletlenszerűen helyezzük el a dobozban. A feladat az, hogy a köveket vízszintes és függőleges irányú csúsztatásukkal sorszám szerint rendezzük úgy, hogy az üres hely a jobb alsó helyre kerüljön.
A feladat általános megoldására nincs algoritmus, viszont minden esetben eldönthető, hogy a feladat megoldható-e, vagy sem.
A program olvassa be - bolondbiztos módon - az egyes mezők értékét, majd írja ki, hogy a feladvány megoldható-e!
100 PROGRAM "Kombin1.bas"
110 CLEAR SCREEN
120 NUMERIC BN(1 TO 16)
130 CALL BEOLVAS
140 IF MEGOLDHATO THEN
150 PRINT "A feladvany megoldhato!"
160 ELSE
170 PRINT "A feladvany nem megoldhato!"
180 END IF
190 END
200 DEF BEOLVAS
210 FOR I=1 TO 4
220 FOR J=1 TO 4
230 PRINT AT I+4,8+J*4+2:"?";
240 LET S=(I-1)*4+J
250 DO
260 PRINT AT 22,1:I;". sor, ";J;". oszlop";CHR$(161);:INPUT BE$
270 LET BN(S)=INT(VAL(BE$))
280 LOOP UNTIL JOSZAM(S)
290 PRINT AT I+4,8+J*4,USING "£££":BN(S);
300 NEXT
310 NEXT
320 PRINT
330 END DEF
340 DEF JOSZAM(NR)
350 LET JOSZAM=-1
360 IF BN(NR)<1 OR BN(NR)>17 THEN LET JOSZAM=0:EXIT DEF
370 FOR M=1 TO NR-1
380 IF BN(NR)=BN(M) THEN LET JOSZAM=0:EXIT DEF
390 NEXT
400 END DEF
410 DEF MEGOLDHATO
420 LET SUM=0
430 FOR I=1 TO 15
440 FOR J=I+1 TO 16
450 IF BN(I)>BN(J) THEN LET SUM=SUM+1
460 NEXT
470 IF BN(I)=16 AND(I=2 OR I=4 OR I=5 OR I=7 OR I=10 OR I=12 OR I=13 OR I=15) THEN LET SUM=SUM+1
480 NEXT
490 IF MOD(SUM,2)=0 THEN
500 LET MEGOLDHATO=-1
510 ELSE
520 LET MEGOLDHATO=0
530 END IF
540 END DEF
5.13. Kombinett-játék
Játszunk kombinett-játékot (15-ös fejtörő) a számítógéppel! A programban az egyszerűség kedvéért A-O jelölést használjuk számok helyett. A köveket keverjük össze a dobozban (hogy mindíg megoldható feladványt kapjunk).
100 PROGRAM "KOMBINET.BAS"
110 RANDOMIZE
120 SET CHARACTER 0,255,255,255,255,255,255,255,255,255
130 DIM S(15)
140 LET KI=0
150 DO
160 GRAPHICS HIRES 256
170 SET £102:PALETTE 0,75,75,75
180 LET I,J=3
190 SET INK 77:PLOT 4,700;:PRINT £101:"Kombinett";
200 PRINT AT 3,14:"ESC - kilepes";
210 CALL TABLA
220 CALL KEVERES
230 IF KI THEN EXIT DO
240 DO
250 CALL MOVE(KEY)
260 LET C=0
270 FOR D=0 TO 15
280 IF S(D)<>D THEN LET C=1
290 NEXT
300 LOOP UNTIL C=0 OR KI
310 IF NOT KI THEN
320 PRINT AT 1,15:"Gratulalok!";
330 WAIT 3
340 PRINT AT 1,1:CHR$(25);
350 END IF
360 LOOP UNTIL KI
370 END
380 DEF MOVE(K)
390 LET II=I-(K=1)+(K=3)
400 LET JJ=J-(K=4)+(K=2)
410 IF II<0 OR II>3 OR JJ<0 OR JJ>3 THEN EXIT DEF
420 LET S(I+4*J)=S(II+4*JJ)
430 LET S(II+4*JJ)=15
440 CALL DRAW(I,J)
450 CALL DRAW(II,JJ)
460 LET I=II:LET J=JJ
470 END DEF
480 DEF DRAW(XX,YY)
490 SET INK 0
500 PLOT ,300+160*XX,500-100*YY;
510 LET P=S(XX+4*YY)
520 LET C$=CHR$(65+P)
530 IF P=15 THEN LET C$=CHR$(128)
540 SET INK P*5+21
550 PRINT £101:C$;
560 SET BEAM OFF
570 END DEF
580 DEF KEY
590 DO
600 DO
610 LET I$=INKEY$:LET IS=JOY(1)
620 LOOP UNTIL I$<>"" OR IS<>0
630 IF I$=CHR$(27) THEN LET KI=NOT 0
640 LET KEY1=0
650 IF I$=CHR$(176) OR IS=8 THEN LET KEY1=2
660 IF I$=CHR$(180) OR IS=4 THEN LET KEY1=4
670 IF I$=CHR$(184) OR IS=2 THEN LET KEY1=3
680 IF I$=CHR$(188) OR IS=1 THEN LET KEY1=1
690 LOOP UNTIL KEY1<>0 OR KI
700 LET KEY=KEY1
710 END DEF
720 DEF KEVERES
730 PRINT AT 1,15:"Keveres..."
740 FOR X=1 TO 75
750 CALL MOVE(RND(4)+1)
760 IF INKEY$=CHR$(27) THEN LET KI=NOT KI:EXIT FOR
770 NEXT
780 PRINT AT 1,1:CHR$(25);
790 END DEF
800 DEF TABLA
810 FOR X=0 TO 3
820 FOR Y=0 TO 3
830 LET S(X+4*Y)=15
840 CALL DRAW(X,Y)
850 LET S(X+4*Y)=X+4*Y
860 CALL DRAW(X,Y)
870 NEXT
880 NEXT
890 END DEF
