Programozás‎ > ‎Feladatok‎ > ‎Telefonszámok‎ > ‎Megoldás‎ > ‎

lb_telefon.pas

Letöltés: lb_telefon.pas

PROGRAM telefon;
USES crt,sysutils;
VAR
    n: LONGINT; //szavak szama
    sz: ARRAY[1..50000] OF STRING; //szavak tombben
    tsz: STRING; //telefonszam
    cod: ARRAY[1..50000,1..100] OF STRING; //szavak lekodolva 
    h: ARRAY[0..50000] OF INTEGER; //szavak hossza
CONST
    szam: ARRAY[0..9] OF STRING = ('OQZ','IJ ','ABC','DEF','GH ','KL ','MN ','PRS','TUV','WXY');
     
PROCEDURE beolvas(hol:STRING);
    VAR
        i: LONGINT;
        f: TEXT; //fajl
    BEGIN
        ASSIGN(f,hol);
        RESET(f);
        READLN(f,tsz);
        h[0]:=LENGTH(tsz);
        READLN(f,n);
        FOR i:=1 TO n DO
            BEGIN
                READLN(f,sz[i]);
            END;
    END;
 
(* -- Visszalepeses kereses --
keres(0,'') -- kezdoallapot
keres(i,eddig(STRING))
    ha i=teljeshossz THEN kiir(eddig)
    ELSE minden lehetseges (s,h) kezdoszeletre meghiv keres(i+h,eddig+' '+s)
*)
 
PROCEDURE feldolg;
    VAR
        i: LONGINT;
        j,k,l: INTEGER;
        tmp: STRING; //tempstring
    BEGIN
        FOR i:=1 TO n DO
            BEGIN
                tmp:=sz[i];
                h[i]:=LENGTH(tmp);
                FOR l:=1 TO h[i] DO
                    BEGIN
                        FOR j:=0 TO 9 DO
                            BEGIN
                                FOR k:=1 TO 3 DO
                                    BEGIN
                                        IF UPPERCASE(COPY(tmp,l,1))=szam[j,k]
                                        THEN cod[i,l]:=INTTOSTR(j);
                                    END;
                            END;
                    END;
            END;
    END;
 
PROCEDURE keres(hol: INTEGER; edd: STRING); //hol tartunk, eddigi kesz string 
    VAR
        i: LONGINT;
        tmp: STRING; //tempstring
        j: INTEGER;
    BEGIN
//        WRITELN('hol tart: ',hol,' eddigi szo: ', edd);
        IF hol=h[0] THEN
            BEGIN
                WRITELN(edd);
            END
            ELSE BEGIN
// ---------------
                tmp:=COPY(tsz,hol+1,h[0]-hol);
        //        WRITELN('tmp: ', tmp);
                FOR i:=1 TO n DO
                    BEGIN
                        //--------------
    //                    WRITELN(cod[i,3]);
                        IF cod[i,1]=tmp[1] THEN
                            BEGIN
                                j:=2;
                                WHILE ((j<=h[i]) AND (cod[i,j]=tmp[j])) DO
                                    j:=j+1;
                                IF j>h[i] THEN
                                    BEGIN
                                        keres(hol+j-1,edd+' '+sz[i])
                                    END;
                            END;
                    END;
            END;
    END;
 
BEGIN
    beolvas('ph2.txt');
    feldolg;
    keres(0,'');
END.