Spojitý zoznam v pascale
Delphi & Pascal (česká wiki)
Kategória: Programy v Pascale
Program: Banka.pas
Súbor exe: Banka.exe
Potrebné: Bank.in
Program: Banka.pas
Súbor exe: Banka.exe
Potrebné: Bank.in
Klienti si v bance BVS zakládají účty, ukládají na ně peníze a provádějí výběry. Kdy nejsou spokojeni, tak si účet zruí. Co banka potřebuje?
Klienti jsou identifikováni pomocí unikátních esticiferných čísel, která nezačínají 0.
V souboru bank.in jsou na kadém řádku transakce z jednoho dne provozu banky oddělené znakem středník (za poslední operací na řádku je taky). Kódování jedné transakce je následující:
CISLO_UCTU:KOD:CASTKA;
kde:
CISLO_UCTU je estimístné číslo, které jednoznačně identifikuje klienta.
nbsp;nbsp; KOD je velké písmeno, které určuje typ transakce. Monosti jsou:
nbsp;nbsp; N .... zaloit nový účet (New)
nbsp;nbsp; Q....zruit existující účet (Quit)
nbsp;nbsp; I .... zvýit uloenou částku na daném účtu (Increase)
nbsp;nbsp; D....sníit uloenou částku na daném účtu (Decrease)
Program má za úkol provést zadané transakce pro vechny dny (řádky souboru bank.in). Do souboru bank.out má potom vypsat pro kadý den hláení o průběhu transakcí a výpis aktuálního stavu vech účtů. Výpis kadého dne začíná řádkem:
Klienti jsou identifikováni pomocí unikátních esticiferných čísel, která nezačínají 0.
V souboru bank.in jsou na kadém řádku transakce z jednoho dne provozu banky oddělené znakem středník (za poslední operací na řádku je taky). Kódování jedné transakce je následující:
CISLO_UCTU:KOD:CASTKA;
kde:
CISLO_UCTU je estimístné číslo, které jednoznačně identifikuje klienta.
nbsp;nbsp; KOD je velké písmeno, které určuje typ transakce. Monosti jsou:
nbsp;nbsp; N .... zaloit nový účet (New)
nbsp;nbsp; Q....zruit existující účet (Quit)
nbsp;nbsp; I .... zvýit uloenou částku na daném účtu (Increase)
nbsp;nbsp; D....sníit uloenou částku na daném účtu (Decrease)
Program má za úkol provést zadané transakce pro vechny dny (řádky souboru bank.in). Do souboru bank.out má potom vypsat pro kadý den hláení o průběhu transakcí a výpis aktuálního stavu vech účtů. Výpis kadého dne začíná řádkem:
{ BANKA.PAS } { } { Program pracujici so spojitym zoznamom na uchovanie, editaciu a mazanie } { bankovych operacii. } { } { Poskytované služby } { Klienti si v bance BVS zakládají účty, ukládají na ně peníze a provádějí } { výběry. Když nejsou spokojeni, tak si účet zruší. } { } { Co banka potřebuje? } { Klienti jsou identifikováni pomocí unikátních šesticiferných čísel, } { která nezačínají 0. } { V souboru bank.in jsou na každém řádku transakce z jednoho dne provozu } { banky oddělené znakem středník (za poslední operací na řádku je taky). } { Kódování jedné transakce je následující: CISLO_UCTU:KOD:CASTKA; } { } { kde: } { CISLO_UCTU je šestimístné číslo, které jednoznačně identifikuje klienta. } { KOD je velké písmeno, které určuje typ transakce. Možnosti jsou: } { N .... založit nový účet (New) } { Q....zrušit existující účet (Quit) } { I .... zvýšit uloženou částku na daném účtu (Increase) } { D....snížit uloženou částku na daném účtu (Decrease) } { CASTKA je kladné celé číslo (v případě N jde o iniciální vloženou částku, } { v případě I/D jde o přírůstek/úbytek a v případě Q na hodnotě nezáleží) } { } { Program má za úkol provést zadané transakce pro všechny dny } { (řádky souboru bank.in). Do souboru bank.out má potom vypsat pro } { každý den hlášení o průběhu transakcí a výpis aktuálního stavu všech účtů.} { Výpis každého dne začíná řádkem: } { } { === DAY === } { kde DAY je číslo řádku vstupního souboru. } { Hlášení o průběhu obsahuje řádek pro každou provedenou transakci. } { Pokud je transakce úspěšná, příslušný řádek má být ve formátu: } { TRANSAKCE OK } { } { V případě neúspěšné transakce chceme vědět kde se stala chyba. } { Formát řádku, který přísluší k neúspěšné transakci, je: } { TRANSAKCE chyba: POPIS_CHYBY } { } { POPIS_CHYBY je řetězec: } { "ucet neexistuje!" v případě, že pro dané číslo účtu nemáme žádný záznam } { "ucet uz existuje!" v případě, že má být založen nový účet s číslem, } { které už je použité } { "nizky stav uctu!" pokud by někdo chtěl vybírat víc než na má na účtě uloženo} { } { TRANSAKCE znamená trojici: CISLO_UCTU:KOD:CASTKA (bez středníku). } { } { Po provedení všech transakcí z aktuálně zpracovávaného dne má být vypsán } { oddělovací řádek: Poté bude následovat výpis stavů všech účtů ve formátu: } { CISLO_UCTU:CASTKA } { Ve výpisu musí být čísla účtů seřazena podle velikosti. } { } { Datum : 08.01.2014 http://www.trsek.com } program banka_bvs; type Pbank_pohyb = ^bank_pohyb; bank_pohyb = record { obycejny spojity seznam } radek:word; { radek v suboru bank.in } cislo_uctu:longint; { cislo uctu s kterym se ma pracovat } kod:char; { kod operace N,Q,I,D } castka:longint; { financni castka } dalsi: Pbank_pohyb; { smernik na nasledujici strukturu pohyb } end; { podle http://cs.wikipedia.org/wiki/Bin%C3%A1rn%C3%AD_vyhled%C3%A1vac%C3%AD_strom } Pbank_ucet = ^bank_ucet; bank_ucet = record { struktura BinárnĂ vyhledávacĂ stromu (BVS) } cislo_uctu:longint; { cislo uctu } castka:longint; { castka na uctu } levy:Pbank_ucet; { smernik na levy list stromu } pravy:Pbank_ucet; { smernik na pravy list stromu } end; var pohyb: Pbank_pohyb; { zacatek spojiteho seznamu } ucet: Pbank_ucet; { hlavni uzel BVS } { udela novou polozku pro seznam pohyb a zinicializuje jeji hodnoty na nuly } function new_init_pohyb: Pbank_pohyb; var new_pohyb: Pbank_pohyb; begin GetMem(new_pohyb, sizeof(bank_pohyb)); new_pohyb^.radek:=0; new_pohyb^.cislo_uctu:=0; new_pohyb^.kod:=' '; new_pohyb^.castka:=0; new_pohyb^.dalsi:=nil; new_init_pohyb:=new_pohyb; end; { udela novou polozku (list BVS) a zinicializuje jeji hodnoty na nuly } function new_init_ucet: Pbank_ucet; var new_ucet: Pbank_ucet; begin GetMem(new_ucet, sizeof(bank_ucet)); new_ucet^.cislo_uctu:=0; new_ucet^.castka:=0; new_ucet^.levy:=nil; new_ucet^.pravy:=nil; new_init_ucet:=new_ucet; end; { vycisteni binary tree podle uzlu } procedure ucet_delete_tree(ucet_delete:Pbank_ucet); begin if(ucet_delete<>nil)then begin ucet_delete_tree(ucet_delete^.levy); ucet_delete_tree(ucet_delete^.pravy); FreeMem(ucet_delete, sizeof(bank_ucet)); end; end; { vycisti pamet od alokovanych uctu, pohybu } procedure vycisti_pamet; var pohyb_temp: Pbank_pohyb; begin while(pohyb <> nil) do begin pohyb_temp:=pohyb; pohyb:=pohyb^.dalsi; FreeMem(pohyb_temp, sizeof(bank_pohyb)); end; ucet_delete_tree(ucet); end; { prevede retezec na cislo } function NaLongint(cislo:string):longint; var value:longint; err:integer; begin Val(cislo, value, err); NaLongint:=value; end; { z vety ve formatu 2222:N:100 vrati prvni slovo, tedy 2222 } function DejSlovo(var veta:string):string; var slovo:string; pozice:integer; begin pozice:=pos(':',veta); if(pozice>0)then begin slovo:=copy(veta,1, pozice-1); veta:=copy(veta,pozice+1, length(veta)-pozice); DejSlovo:=slovo; end else begin slovo:=veta; veta:=''; DejSlovo:=slovo; end; end; { nacte vstupni soubor s bankovnimi pohyby } procedure nacti_soubor(sname:string); var f:text; radek:word; slovo:string; veta:string; znak:char; new_pohyb: Pbank_pohyb; last_pohyb: Pbank_pohyb; begin assign(f, sname); {$I-} reset(f); {$I+} if(IOResult<>0)then begin writeln('Chyba pri otevirani souboru.'); halt(1); end; radek:=1; veta:=''; last_pohyb:=nil; new_pohyb:=nil; while( not(eof(f))) do begin read(f,znak); { konec slova 0A - LF, 0D - CR } if(((znak=';') or (ord(znak)=$0A) or (ord(znak)=$0D)) and (veta<>''))then begin GetMem(new_pohyb, sizeof(bank_pohyb)); { jeste nemam prvni } if(pohyb=nil)then begin pohyb:=new_pohyb; end; { svazeme s predeslym } if(last_pohyb<>nil)then begin last_pohyb^.dalsi:=new_pohyb; end; { tohle je ted posledni } last_pohyb:=new_pohyb; new_pohyb^.radek:=radek; new_pohyb^.cislo_uctu:=NaLongint(DejSlovo(veta)); slovo:=DejSlovo(veta); new_pohyb^.kod:=slovo[1]; new_pohyb^.castka:=NaLongint(DejSlovo(veta)); new_pohyb^.dalsi:=nil; veta:=''; end; { konec radku, 0D - Carier Return } if(ord(znak)=$0D)then continue; { dalsi radek, 0A - Line Feed } if(ord(znak)=$0A)then begin radek:=radek+1; continue; end; { pridej k vete } if(znak <> ';')then veta:=veta+znak; end; { zavreme } close(f); end; { hleda ucet v binarnim strome } function ucet_hledej(ucet_tree:Pbank_ucet; cislo_uctu:longint):Pbank_ucet; var temp:Pbank_ucet; begin if(ucet_tree = nil)then begin ucet_hledej:=nil; exit; end; if(cislo_uctu = ucet_tree^.cislo_uctu)then ucet_hledej:=ucet_tree else if((cislo_uctu < ucet_tree^.cislo_uctu) and (ucet_tree^.levy <> nil))then ucet_hledej:=ucet_hledej(ucet_tree^.levy, cislo_uctu) else if((cislo_uctu > ucet_tree^.cislo_uctu) and (ucet_tree^.pravy <> nil))then ucet_hledej:=ucet_hledej(ucet_tree^.pravy, cislo_uctu) else ucet_hledej:=nil; end; { hleda rodice uctu v binarnim strome } function ucet_hledej_mem(ucet_tree:Pbank_ucet; ucet_find:Pbank_ucet):Pbank_ucet; var ucet_temp:Pbank_ucet; begin if(ucet_tree = nil)then begin ucet_hledej_mem:=nil; end { je to rodic } else if((ucet_tree^.levy = ucet_find) or (ucet_tree^.pravy = ucet_find))then begin ucet_hledej_mem:=ucet_tree; end else begin { zrus vlevo } ucet_temp := ucet_hledej_mem(ucet_tree^.levy, ucet_find); { tak vpravo } if(ucet_temp = nil)then ucet_temp:=ucet_hledej_mem(ucet_tree^.pravy, ucet_find); { vysledek } ucet_hledej_mem := ucet_temp; end; end; { vlozi do binary tree novy ucet } procedure ucet_zaloz(var tree_ucet:Pbank_ucet; novy_ucet:Pbank_ucet); begin if(tree_ucet = nil)then tree_ucet := novy_ucet else if (novy_ucet^.cislo_uctu < tree_ucet^.cislo_uctu)then ucet_zaloz(tree_ucet^.levy, novy_ucet) else if (novy_ucet^.cislo_uctu > tree_ucet^.cislo_uctu)then ucet_zaloz(tree_ucet^.pravy, novy_ucet); end; { zrusi ucet, a nasledne spoji binary strom } procedure ucet_zruz(find_ucet:Pbank_ucet); var temp_ucet:Pbank_ucet; rodic_ucet:Pbank_ucet; begin { ma jenom praveho potomka } if((find_ucet^.levy = nil) and (find_ucet^.pravy <> nil))then begin temp_ucet := find_ucet^.pravy; find_ucet^.cislo_uctu := temp_ucet^.cislo_uctu; find_ucet^.castka := temp_ucet^.castka; find_ucet^.levy := temp_ucet^.levy; find_ucet^.pravy := temp_ucet^.pravy; FreeMem(temp_ucet, sizeof(bank_ucet)); exit; end; { ma jenom leveho potomka } if((find_ucet^.levy <> nil) and (find_ucet^.pravy = nil))then begin temp_ucet := find_ucet^.levy; find_ucet^.cislo_uctu := temp_ucet^.cislo_uctu; find_ucet^.castka := temp_ucet^.castka; find_ucet^.levy := temp_ucet^.levy; find_ucet^.pravy := temp_ucet^.pravy; FreeMem(temp_ucet, sizeof(bank_ucet)); exit; end; { Uzel má dva potomky, hledej pĹTedchĹŻdce (nejpravÄ>jšà potomek levĂCho podstromu). } if((find_ucet^.levy <> nil) and (find_ucet^.pravy <> nil))then begin { zĂskej levĂCho potomka mazanĂCho uzlu } temp_ucet := find_ucet^.levy; { najdi nejpravÄ>jšĂho potomka podstromu levĂCho uzlu mazanĂCho uzlu (pĹTedchĹŻdce) } while (temp_ucet^.pravy <> nil) do temp_ucet := temp_ucet^.pravy; { zkopĂruj hodnotu pĹTedchĹŻdce do mazanĂCho uzlu } find_ucet^.cislo_uctu := temp_ucet^.cislo_uctu; find_ucet^.castka := temp_ucet^.castka; { pozor temp ma levy, presuneme ho misto temp } if(temp_ucet^.levy <> nil)then begin rodic_ucet:=temp_ucet^.levy; temp_ucet^.cislo_uctu := rodic_ucet^.cislo_uctu; temp_ucet^.castka := rodic_ucet^.castka; temp_ucet^.levy := rodic_ucet^.levy; temp_ucet^.pravy := rodic_ucet^.pravy; { tento zmaz } temp_ucet:=rodic_ucet; end else begin { list byl samotnej odstranime na nej odkaz z rodice } rodic_ucet:=ucet_hledej_mem(ucet, temp_ucet); if(rodic_ucet^.levy=temp_ucet)then rodic_ucet^.levy:=nil; if(rodic_ucet^.pravy=temp_ucet)then rodic_ucet^.pravy:=nil; end; { nynĂ smaĹľ pĹTedchĹŻdce - jeho hodnota byla pĹTesunuta do pĹŻvodnÄ> mazanĂCho uzlu } FreeMem(temp_ucet, sizeof(bank_ucet)); exit; end; { je to list - odstran ho a taky info na nej } { najdi rodice } temp_ucet:=ucet_hledej_mem(ucet, find_ucet); { posledni prvek } if(temp_ucet = nil)then ucet:=nil else begin if(temp_ucet^.levy=find_ucet)then temp_ucet^.levy:=nil; if(temp_ucet^.pravy=find_ucet)then temp_ucet^.pravy:=nil; end; FreeMem(find_ucet, sizeof(bank_ucet)); end; { vypise seznam uctu } procedure ucty_vypis(var f:text; ucet_vypis:Pbank_ucet); begin if(ucet_vypis<>nil)then begin ucty_vypis(f,ucet_vypis^.levy); writeln(f,ucet_vypis^.cislo_uctu, ':', ucet_vypis^.castka); ucty_vypis(f,ucet_vypis^.pravy); end; end; procedure WriteHexWord(w: Word); const hexChars: array [0..$F] of Char = '0123456789ABCDEF'; begin Write(hexChars[Hi(w) shr 4], hexChars[Hi(w) and $F], hexChars[Lo(w) shr 4], hexChars[Lo(w) and $F]); end; { vypise seznam uctu } procedure ucty_vypis_dsp(ucet_vypis:Pbank_ucet); begin if(ucet_vypis<>nil)then begin ucty_vypis_dsp(ucet_vypis^.levy); write(ucet_vypis^.cislo_uctu, ':', ucet_vypis^.castka:8); write(' Ptr='); WriteHexWord(Seg(ucet_vypis^)); write(' levy='); WriteHexWord(Seg(ucet_vypis^.levy^)); write(' pravy='); WriteHexWord(Seg(ucet_vypis^.pravy^)); writeln; ucty_vypis_dsp(ucet_vypis^.pravy); end; end; { vykona operace a zaroven zapise do souboru } procedure zpracuj_soubor(sname:string); var f:text; radek:word; iradek:word; pohyb_move: Pbank_pohyb; find_ucet: Pbank_ucet; new_ucet: Pbank_ucet; begin assign(f, sname); {$I-} rewrite(f); {$I+} if(IOResult<>0)then begin writeln('Chyba pri zapisu do souboru.'); halt(1); end; if(pohyb=nil)then begin writeln('Nemam zadne udaje k zpracovani.'); close(f); halt(1); end; pohyb_move:=pohyb; radek:=pohyb_move^.radek; writeln(f,'=== ', radek, ' ==='); while(pohyb_move<>nil) do begin { skoncil den zapis aktualni stav } if(pohyb_move^.radek <> radek)then begin for iradek:=radek+1 to pohyb_move^.radek do begin { rekapitulace uctu } writeln(f,'======'); ucty_vypis(f,ucet); { novy den } writeln(f,'=== ', iradek, ' ==='); end; radek:=pohyb_move^.radek; end; { vypis operace } write(f, pohyb_move^.cislo_uctu, ':', pohyb_move^.kod, ':', pohyb_move^.castka); { jaka operace? } case(UpCase(pohyb_move^.kod)) of 'N': begin { N .... zaloĹľit novĂ˝ účet (New) } if( ucet_hledej(ucet,pohyb_move^.cislo_uctu) <> nil)then writeln(f,' chyba: ucet uz existuje!') else { cislo uctu je 6-ti mistne cislo } if(( pohyb_move^.cislo_uctu >= 100000) and (pohyb_move^.cislo_uctu <= 999999))then begin new_ucet:=new_init_ucet; new_ucet^.cislo_uctu:=pohyb_move^.cislo_uctu; new_ucet^.castka:=pohyb_move^.castka; ucet_zaloz(ucet, new_ucet); writeln(f,' OK'); end else begin writeln(f,' chyba: ucet nema spravne cislo!') end; end; 'Q': begin { Q....zrušit existujĂcà účet (Quit) } find_ucet:=ucet_hledej(ucet,pohyb_move^.cislo_uctu); if( find_ucet = nil)then writeln(f,' chyba: ucet neexistuje!') else begin { writeln('Hledam chybu - pred odstranenim'); ucty_vypis_dsp(ucet); ucet_zruz(find_ucet); writeln('Hledam chybu - po odstraneni'); ucty_vypis_dsp(ucet); } ucet_zruz(find_ucet); writeln(f,' OK'); end; end; 'I': begin { I .... zvýšit uloĹľenou částku na danĂCm účtu (Increase) } find_ucet:=ucet_hledej(ucet,pohyb_move^.cislo_uctu); if( find_ucet = nil)then writeln(f,' chyba: ucet neexistuje!') else begin find_ucet^.castka := find_ucet^.castka + pohyb_move^.castka; writeln(f,' OK'); end; end; 'D': begin { D....snĂĹľit uloĹľenou částku na danĂCm účtu (Decrease) } find_ucet:=ucet_hledej(ucet,pohyb_move^.cislo_uctu); if( find_ucet = nil)then writeln(f,' chyba: ucet neexistuje!') else begin if( find_ucet^.castka < pohyb_move^.castka) then begin writeln(f,' chyba: nizky stav uctu!'); end else begin find_ucet^.castka := find_ucet^.castka - pohyb_move^.castka; writeln(f,' OK'); end; end; end; end; { dalsi udaj } pohyb_move:=pohyb_move^.dalsi; end; { rekapitulace uctu } writeln(f,'======'); ucty_vypis(f,ucet); { zatvor subor } close(f); end; begin writeln('Spracovani bankovnich operaci.'); writeln('Nacitam soubor bank.in'); pohyb:=nil; ucet:=nil; nacti_soubor('bank.in'); zpracuj_soubor('bank.out'); vycisti_pamet; writeln('Udaje zpracovany. Vysledek zapsan do souboru bank.out'); end.