Programozás‎ > ‎Feladatok‎ > ‎Mastermind‎ > ‎Megoldás‎ > ‎

lb_master.pas

Letöltés: lb_master.pas

PROGRAM mastermind;
USES crt;
VAR
    be: ARRAY[1..1296,1..6] OF INTEGER;
    mego: ARRAY[1..1296] OF INTEGER;
    n,m,sz1,sz2,jo: INTEGER;
 
PROCEDURE beolvas(ut:STRING);
    VAR
        f: TEXT;
        i,j: INTEGER;
    BEGIN
        ASSIGN(f,ut);
        RESET(f);
        n:=0;
        READLN(f,n);
        i:=0;
        WHILE NOT(EOF(f)) DO
            BEGIN
                i:=i+1;
                j:=1;
                WHILE j<>7 DO
                    BEGIN
                        READ(f,be[i,j]);
                        j:=j+1;
                    END;
            END;
        CLOSE(f);
    END;
 
PROCEDURE fv(inp,titok: INTEGER);
    VAR
        a1,b1,c1,d1,a2,b2,c2,d2,tmp: INTEGER;
    BEGIN
        sz1:=0;
        sz2:=0;
        a1:=inp DIV 1000;
        tmp:=inp MOD 1000;
        b1:=tmp DIV 100;
        tmp:=tmp MOD 100;
        c1:=tmp DIV 10;
        d1:=tmp MOD 10;
        //----------
        a2:=titok DIV 1000;
        tmp:=titok MOD 1000;
        b2:=tmp DIV 100;
        tmp:=tmp MOD 100;
        c2:=tmp DIV 10;
        d2:=tmp MOD 10;
        //----------
        IF a1=a2 THEN
            sz1:=sz1+1;
        IF b1=b2 THEN
            sz1:=sz1+1;
        IF c1=c2 THEN
            sz1:=sz1+1;
        IF d1=d2 THEN
            sz1:=sz1+1;
        //----------- Ami stimmel beallitva, ami rossz helyen van:
        IF ((a1=b2) OR ((a1=c2) OR (a1=d2))) THEN
            sz2:=sz2+1;
        IF ((b1=a2) OR ((b1=c2) OR (b1=d2))) THEN
            sz2:=sz2+1;
        IF ((c1=a2) OR ((c1=b2) OR (c1=d2))) THEN
            sz2:=sz2+1;
        IF ((d1=a2) OR ((d1=b2) OR (d1=c2))) THEN
            sz2:=sz2+1;
    END;
 
PROCEDURE hasonl;
    VAR
        a,b,c,d,j,tmp1,tmp2,tm1,tm2: INTEGER; //tmp1-nezett szam, tmp2 bemeneti szamokon vegigfut;
    BEGIN
        tmp1:=0;
        m:=0;
        FOR a:=1 TO 6 DO
            BEGIN
                FOR b:=1 TO 6 DO
                    BEGIN
                        FOR c:=1 TO 6 DO
                            BEGIN
                                FOR d:=1 TO 6 DO
                                    BEGIN
                                        IF NOT((((((a=b)OR(a=c))OR(a=d))OR(b=c))OR(b=d))OR(c=d))                                            THEN
                                            BEGIN
                                                tmp1:=a*1000+b*100+c*10+d;
                                                jo:=0;
                                                FOR j:=1 TO n DO
                                                    BEGIN
                                                        tmp2:=be[j,1]*1000+be[j,2]*
                                                              100+be[j,3]*10+be[j,4];
                                                        tm1:=be[j,5];
                                                        tm2:=be[j,6];
                                                        fv(tmp1,tmp2);
                                                        IF ((tm1=sz1)AND(tm2=sz2))THEN
                                                            BEGIN
                                                                jo:=jo+1;
                                                            END;
                                                    END;
                                                IF jo=n THEN
                                                    BEGIN
                                                        m:=m+1;
                                                        mego[m]:=tmp1;
                                                    END;
                                            END;
                                    END;
                            END;
                    END;
            END;
    END;
 
PROCEDURE output(ut:STRING);
    VAR
        i: INTEGER;
        f: TEXT;
    BEGIN
        ASSIGN(f,ut);
        REWRITE(f);
        WRITELN(f,m);
        WRITELN(m);
        FOR i:= 1 TO m DO
            BEGIN
                WRITELN(f,mego[i]);
                WRITELN(mego[i]);
            END;
        CLOSE(f);
        WRITELN('A lehetseges megoldasok ki vannak irva a fajlba.');
    END;
 
BEGIN
    beolvas('m01.be');
    hasonl;
    output('m01.ki');
END.