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]* 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.
|