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

Előszó

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. Elemi algoritmusok

Soros algoritmusok

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, és ha a két szám pozitív, a mértani közepüket is!

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)

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.20. 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. Ciklusok

Léptetéses Ciklusok

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

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. 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.10. 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.11. 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.12. 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.13. 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 eve, i ivi, o ovo, u uvu

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.14. É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)
300   LET SZOKOEV=0
310   IF MOD(E,4)=0 AND MOD(E,100)<>0 OR MOD(E,400)=0 THEN LET SZOKOEV=-1
320 END DEF
330 DEF NAPOS(H)
340   SELECT CASE H
350   CASE 4,6,9,11
360     LET NAPOS=30
370   CASE 2
380     IF SZOKOEV(EV) THEN
390       LET NAPOS=29
400     ELSE
410       LET NAPOS=28
420     END IF
430   CASE ELSE
440     LET NAPOS=31
450   END SELECT
460 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.15. 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

Feltételes ciklusok

2.16. 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.17. 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.18. 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.19. 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

Összetett ciklusok (Tömbkezelés)

2.20. 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.21. 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.22. 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.23. 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.24. 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.25. 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.26. 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.27. 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ő:

  1. Írjuk fel a számokat egymás alá 2-től ameddig a prímtesztet elvégezni kívánjuk.
  2. Keressük meg az első olyan 1-től nagyobbat, amelyik még nincs sem kihúzva, sem megjelölve. Elsőként ez a 2.
  3. Az így megtalált számot jelöljük meg, ezután húzzuk ki ennek többszöröseit.
  4. Ismételd meg a második lépéstől újra az eljárást. Természetesen egy összetett szám többször is kihúzásra kerülhet.
  5. Az algoritmus akkor álljon le, ha a második lépésnél talált szám négyzete már nagyobb, mint n.

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.28. 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.

2.29. 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.30 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

Tablókészítés

2.31. 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.32. 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=0:LET FERFI=0:LET 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. Alapalgoritmusok

Maximum-minimum feladatok

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

Rendezés

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>0 AND N<301
160 NUMERIC A(1 TO N)
170 CALL TOLT
180 CALL KI
190 CALL RENDEZ
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 RENDEZ
330   FOR I=1 TO N-1
340     LET MIN=A(I):LET INDEX=I
350     FOR J=I+1 TO N
360       IF MIN>A(J) THEN LET MIN=A(J):LET INDEX=J
370     NEXT
380     LET A(INDEX)=A(I):LET A(I)=MIN
390   NEXT
400 END DEF

3.8. Vektor elemeinek rendezése II.
Az előző (3.7.) feladatot oldjuk meg fésűs rendezéssel!

100 PROGRAM "Rendez2.bas"
...
320 DEF RENDEZ
330   LET GAP=N: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=1 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

3.9. Vektor elemeinek rendezése III.
A 3.7. feladatot oldjuk meg 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
...
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

Tömbök összeválogatása

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

Keresési eljárások

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

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áron 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

Kidolgozandó feladatok

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. Vegyes feladatok

Kombinatorika

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. 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.4. 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.22. 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.5. 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

Játékok

5.6. 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.7. 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.8. 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. Mivel 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
310       PRINT "Nincs mar ennyi szal!"
320       LET X=0
330     END IF
340     PRINT TAB(19);"Maradt";X:PRINT
350   END IF
360 LOOP WHILE X>0
370 IF G THEN
380   PRINT "Vesztettem..."
390 ELSE
400   PRINT "Az utolso szalat vetted el. Vesztettel!"
410 END IF

5.9. 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.10. 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.11. 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

Vissza