Добавил:
Yanus
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:
UNIT GNK2;
INTERFACE
USES GNK;
type IntArray = array [0..18] of integer;
Binarray= array [1..16,1..10] of byte;
Masarray = array [1..19,1..15] of byte;
BinArray1 = array [1..15] of byte;
BinArray2 = array [1..19] of byte;
const
flag : array [1..4,1..4] of byte = ((3,5,6,7),(6,8,10,11),(9,11,13,14),(12,14,17,19));
flag1: array [1..4,1..4] of byte = ((2,3,3,3),(5,6,7,7),(8,9,10,10), (11,12,14,15));
var jmax:integer;
Procedure OPD4(var mas:Masarray;var MOP:Intarray;var NRS,NPR:word;Param:byte;inf:word;Key1:Byte);
Procedure MTAB4(mas:masarray;inf:word;MOP:INTARRAY;var MAT:binarray;param,key2:byte);
Procedure ISP4(KP, KI:BinArray2;MAT:Binarray;MJ,KJ, NRS:integer;MOP:IntArray;var Kk:BinArray2; var KRIP, KRI:word);
PROCEDURE OPD(NRS,N1:word;var NPS:word;var MT1,MT2,MOP);
PROCEDURE MTAB(NRS,NPS,MJ,KJ:word;var MOP,MAT);
PROCEDURE RPT(T0,V,M,S:real;var PK,T1:real);
PROCEDURE DVK(NUK,INF:word;var MDV);
PROCEDURE KDR(var MAT,MDV,KP; MJ,KJ,NRS,INF:word);
PROCEDURE KAN(var KP,KI,MVO;NRS,MKO:word;T0,T1,PK,S,M:real;var IR:word);
PROCEDURE ISP(var MAT,MOP,OPZ,KI,TOP;MJ,KJ,NRS,NPR,NPS:word;var KC1:word);
PROCEDURE PVB(var MAT,KI,MVO,MDV;KJ:word; var KC1:word;nrs:word);
PROCEDURE BVUK(var MDV,YKout;INF,k:word;Q,Ymin:real);
PROCEDURE DEMO(N,KC1:word);
IMPLEMENTATION
USES crt;
TYPE
VecB=array[1..65535] of byte;
VecS=array[1..10922] of real;
Ba= array [1..16,1..10] of byte;
Procedure OPD4;
var
number,temp: byte;
i,j,chislo : integer;
Function check_one(digit : integer; number : byte) : byte;
var i : byte;
begin
check_one := 0;
for i := 0 to number do
if MOP[i] = digit then
begin
check_one := 1;
exit;
end;
end;
Function check_two(digit : integer; number : byte) : byte;
var i,j : byte;
begin
check_two := 0;
if Param = 1 then exit;
for i := 0 to number - 2 do
for j := i+1 to number - 1 do
if (MOP[i] xor MOP[j]) = digit then
begin
check_two := 1;
exit;
end;
end;
Function check_three(digit : integer; number : byte) : byte;
var i,j,k : byte;
begin
check_three := 0;
if Param < 3 then exit;
for i := 0 to number - 3 do
for j := i+1 to number - 2 do
for k := j+1 to number - 1 do
if (MOP[i] xor MOP[j] xor MOP[k]) = digit then
begin
check_three := 1;
exit;
end;
end;
Function check_four(digit : integer; number : byte) : byte;
var i,j,k,n : byte;
begin
check_four := 0;
if Param < 4 then exit;
for i := 0 to number - 4 do
for j := i+1 to number - 3 do
for k := j+1 to number - 2 do
for n := k+1 to number - 1 do
if (MOP[i] xor MOP[j] xor MOP[k] xor MOP[n]) = digit then
begin
check_four := 1;
exit;
end;
end;
Function verify( digit : integer;number : byte) : byte;
var tmp,i,j,k : integer;
begin
verify := 0;
if Param =1 then exit;
for i := 0 to number-1 do
begin
tmp := MOP[i] xor digit;
if (check_one(tmp, number)=1) or (check_two(tmp,number)=1) or
(check_three(tmp,number)=1) or (check_four(tmp,number)=1) then
begin
verify := 1;
exit;
end;
end;
if Param < 3 then exit;
for i := 0 to number - 2 do
for j := i + 1 to number-1 do
begin
tmp := MOP[i] xor MOP[j] xor digit;
if (check_one(tmp, number)=1) or (check_two(tmp,number)=1) or
(check_three(tmp,number)=1) or (check_four(tmp,number)=1) then
begin
verify := 1;
exit;
end;
end;
if Param < 4 then exit;
for i := 0 to number - 3 do
for j := i + 1 to number - 2 do
for k := j + 1 to number-1 do
begin
tmp := MOP[i] xor MOP[j] xor MOP[k] xor digit;
if(check_one(tmp, number)=1) or (check_two(tmp,number)=1) or
(check_three(tmp,number)=1) or (check_four(tmp,number)=1) then
begin
verify := 1;
exit;
end;
end;
end;
begin
{ KJ:=5;
MJ:=flag1[Param]+1;
}
NRS:=flag1[Param,inf]+inf; { зЁб«® а §а冷ў Ї®¬Ґе®гбв®©зЁў®Ј® Є®¤®ў®Ј® б«®ў }
NPR:=flag1[Param,inf]; { зЁб«® Ё§Ўлв®зле а §а冷ў}
{
N1 - Є®«ЁзҐбвў® ®Ї®§ ў ⥫Ґ© ¤ўгЄа вле ®иЁЎ®Є;
MJ - Є®«ЁзҐбвў® бва®Є ў Є®¤Ёаго饩 в Ў«ЁжҐ;
KJ - Є®«ЁзҐбвў® бв®«Ўж®ў ў Є®¤Ёаго饩 в Ў«ЁжҐ;
}
number := 2;
for i:=0 to 18 do MOP[i] :=0;
MOP[0] := 1;
MOP[1] := 2;
if Param >2 then
begin
MOP[2] := 4;
number:=3;
end;
if Param >3 then
begin
MOP[3] := 8;
number:=4;
end;
if Param=4 then
begin
MOP[4]:=16;
MOP[5]:=32;
MOP[6]:=64;
MOP[7]:=128;
MOP[8]:=255;
MOP[9]:=256;
MOP[10]:=512;
MOP[11]:=1024;
MOP[12]:=2048;
MOP[13]:=3855;
MOP[14]:=4096;
MOP[15]:=8192;
MOP[16]:=13107;
MOP[17]:=16384;
MOP[18]:=21845;
end
else
begin
for i := 3 to 32767 do
begin
if not ((check_one(i,number)=1) or (check_two(i,number)=1) or
(check_three(i,number)=1) or (check_four(i,number)=1)) then
if not (verify(i,number)=1) then
begin
MOP[number] := i;
inc(number);
if key1=1 then write('*');
end;
if number = nrs then break;
end;
end;
writeln;
for i:=1 to flag[Param,inf] do
for j:=1 to inf+1 do mas[i,j]:=0;
jmax:=0;
for i:=1 to flag[Param,inf] do
begin
j:=1;
chislo:=MOP[i-1];
if chislo > 1 then
repeat
mas[i,j]:=chislo mod 2;
chislo:=chislo div 2;
j:=j+1;
if j>jmax then jmax:=j;
until (chislo < 2);
mas[i,j]:=1;
end;
for i:=1 to flag[Param,inf] do
begin
if key1=1 then begin
for j:=jmax downto 1 do write(mas[i,j]);
writeln;
end;
end;
end;
Function Divm(m:integer):boolean;
var i:integer;
begin
Divm:=false;
for i:=0 to 16 do
if m-round(exp(ln(2)*i))=0 then begin Divm:=true;break;end;
end;
PROCEDURE MTAB4;
var i,j,j2 : integer;
tmp, x, y : byte;
begin
for i:=1 to flag[param,inf] do for j:=1 to 5 do MAT[i,j]:=0;
j:=2;j2:=2;
for i:=1 to flag[param,inf] do
if divm(mop[i-1]) then begin MAT[j,1]:=i;inc(j);end else
begin mat[1,j2]:=i;inc(j2);end;
for i:=2 to flag1[param,inf]+1 do
for j:=2 to inf+1 do
if mas[mat[1,j],i-1]=1 then mat[i,j]:=1;
x:=40; y:=4;
if key2=1 then begin
gotoxy(42,2);write('Љ®¤Ёагой п в Ў«Ёж ');
for i:=1 to flag1[param,inf]+1 do
begin
for j:=1 to inf+1 do begin
gotoxy(x,y);write(MAT[i,j]:4);x:=x+4;end;
x:=40;inc(y);
end;
gotoxy(1, flag[Param,inf]+3);
end;
end;
PROCEDURE ISP4;
var
i,j,k,n : integer;
temp : word;
tmp : byte;
opz:binarray1;
begin
krip:=0;kri:=0;
for i:=1 to nrs do
if ki[i]<>kp[i] then inc(krip);
for i:=1 to (nrs div 2) do begin
k:=ki[i];ki[i]:=ki[nrs-i+1];ki[nrs-i+1]:=k;
end;
for i := 2 to MJ do
begin
tmp:=0;
for j := 2 to KJ do
if MAT[i,j]=1 then tmp:=tmp xor KI[MAT[1,j]];
OPZ[i-1]:=tmp xor KI[MAT[i,1]];
end;
temp:=0;
for i := MJ-1 downto 1 do
if OPZ[i]=1 then temp:=temp + trunc( exp((i-1)*ln(2)) );
tmp:=0;
for i := 0 to NRS-1 do
begin
if MOP[i] = temp then
begin
KI[i+1]:=1-KI[i+1];
tmp:=1;
end;
end;
if MJ>5 then
for i := 0 to MJ+KJ-4 do
for j := i+1 to MJ+KJ-3 do
if (MOP[i] xor MOP[j]) = temp then
begin
tmp:=1;
KI[i+1]:=1-KI[i+1];
KI[j+1]:=1-KI[j+1];
end;
if MJ > 8 then
for i := 0 to MJ+KJ-5 do
for j := i+1 to MJ+KJ-4 do
for k := j+1 to MJ+KJ-3 do
if (MOP[i] xor MOP[j] xor MOP[k]) = temp then
begin
tmp:=1;
KI[i+1]:=1-KI[i+1];
KI[j+1]:=1-KI[j+1];
KI[k+1]:=1-KI[k+1];
end;
if MJ > 11 then
for i := 0 to MJ+KJ-6 do
for j := i+1 to MJ+KJ-5 do
for k := j+1 to MJ+KJ-4 do
for n := k+1 to MJ+KJ-3 do
if (MOP[i] xor MOP[j] xor MOP[k] xor MOP[n]) = temp then
begin
tmp:=1;
KI[i+1]:=1-KI[i+1];
KI[j+1]:=1-KI[j+1];
KI[k+1]:=1-KI[k+1];
KI[n+1]:=1-KI[n+1];
end;
for i:=1 to (nrs div 2) do begin
k:=ki[i];ki[i]:=ki[nrs-i+1];ki[nrs-i+1]:=k;
end;
for i:=1 to nrs do kk[i]:=ki[i];
for i:=1 to nrs do
if kp[i]<>kk[i] then inc(kri);
end;
PROCEDURE OPD;
LABEL 0,1,2;
VAR
I,J,K,M,NB:word;
P,Z:byte;
BEGIN
FOR k:=1 TO NRS-1 DO VecB(MT1)[k]:=0;
VecB(MT1)[NRS]:=1;
NB:=0;
FOR i:=2 TO NRS DO
BEGIN
FOR k:=1 TO NRS DO VecB(MT1)[NRS*(i-1)+k]:=VecB(MT1)[NRS*(i-2)+k];
0: P:=0;
FOR k:=NRS DOWNTO 1 DO
BEGIN
Z:=VecB(MT1)[NRS*(i-1)+k]+P;
IF k=NRS THEN Z:=Z+1;
VecB(MT1)[NRS*(i-1)+k]:=Z mod 2;
P:=Z div 2
END;
FOR j:=1 TO NB DO
BEGIN
FOR k:=1 TO NRS DO
IF VecB(MT2)[NRS*(j-1)+k]<>VecB(MT1)[NRS*(i-1)+k] THEN goto 1;
goto 0;
1: ;
END;
FOR j:=1 TO NB DO FOR m:=1 TO i-1 DO
BEGIN
FOR k:=1 TO NRS DO
IF VecB(MT2)[NRS*(j-1)+k]<>
byte(VecB(MT1)[NRS*(m-1)+k]<>VecB(MT1)[NRS*(i-1)+k])
THEN goto 2;
goto 0;
2: ;
END;
FOR m:=1 TO i-1 DO
BEGIN
NB:=NB+1;
FOR k:=1 TO NRS DO
VecB(MT2)[NRS*(nb-1)+k]:=
byte(VecB(MT1)[NRS*(m-1)+k]<>VecB(MT1)[NRS*(i-1)+k])
END;
END;
k:=1;
WHILE (k<NRS) and (VecB(MT1)[NRS*(NRS-1)+k]=0) DO k:=k+1;
NPS:=NRS-k+2;
FOR i:=1 TO NRS*NRS DO VecB(MOP)[i]:=0;
FOR i:=1 TO NRS DO
BEGIN
VecB(MOP)[NRS*(i-1)+1]:=i;
j:=NPS;
FOR m:=k TO NRS DO
BEGIN
VecB(MOP)[NRS*(i-1)+j]:=VecB(MT1)[NRS*(i-1)+m];
j:=j-1
END
END
END;
PROCEDURE MTAB;
VAR
I,J,K,M,N1:word;
BEGIN
FOR i:=1 TO MJ*KJ DO VecB(MAT)[i]:=0;
m:=2;k:=KJ;
FOR i:=1 TO NRS DO
BEGIN
n1:=0;
FOR j:=2 TO NPS DO IF VecB(MOP)[NRS*(i-1)+j]=1 THEN inc(n1);
IF n1=1
THEN
BEGIN VecB(MAT)[KJ*(m-1)+1]:=VecB(MOP)[NRS*(i-1)+1];
inc(m)
END
ELSE
BEGIN
VecB(MAT)[k]:=VecB(MOP)[NRS*(i-1)+1];
FOR j:=2 TO NPS DO VecB(MAT)[KJ*(j-1)+k]:=VecB(MOP)[NRS*(i-1)+j];
dec(k)
END
END
END;
PROCEDURE RPT;
BEGIN
PK:=AVER(V,M,S);
T1:=2*PK+T0;
PK:=PK+T0
END;
PROCEDURE DVK;
VAR
I:word;
BEGIN
FOR i:=1 TO INF DO VecB(MDV)[i]:=0;
i:=INF;
WHILE (NUK>1) and (i>1) DO
BEGIN
VecB(MDV)[i]:=NUK mod 2;
NUK:=NUK div 2;
i:=i-1
END;
VecB(MDV)[i]:=NUK
END;
procedure KDR;
var I,J:word;
begin
for i:=1 to NRS do VecB(KP)[i]:=0;
for i:=1 to inf do VecB(KP)[Nrs-Ba(mat)[1,i+1]+1]:=VecB(mdv)[inf-i+1];
for i:=2 to mj do
for j:=2 to kj do
if Ba(mat)[i,j]=1 then Vecb(KP)[nrs-Ba(mat)[i,1]+1]:=Vecb(KP)[nrs-Ba(mat)[i,1]+1] xor Vecb(KP)[nrs-Ba(mat)[1,j]+1];
end;
PROCEDURE KAN;
VAR
R,US:real;
J:word;
BEGIN
IR:=0;
FOR j:=1 TO NRS DO
BEGIN
R:=GAUSS(M,S);
IF VecB(KP)[j]=1 THEN US:=T1 ELSE US:=T0;
US:=US+R;
{-----------}
IF US>PK THEN VecB(KI)[j]:=1;
{----------}
IF US<PK THEN VecB(KI)[j]:=0;
{----------}
IF VecB(KI)[j]=VecB(KP)[j] THEN VecB(MVO)[j]:=0
ELSE
IF IR<MKO THEN
BEGIN
IR:=IR+1;
VecB(MVO)[j]:=1
END
ELSE VecB(KI)[j]:=VecB(KP)[j]
END
END;
PROCEDURE ISP;
VAR N1,N2,S,I,J,K:word;
BEGIN
FOR i:=1 TO MJ DO
BEGIN
S:=0;
FOR j:=2 TO KJ DO
IF VecB(MAT)[KJ*(i-1)+j]=1
THEN BEGIN N1:=VecB(MAT)[j]; S:=S xor VecB(KI)[N1] END;
N2:=VecB(MAT)[KJ*(i-1)+1];
VecB(OPZ)[i-1]:=S xor VecB(KI)[N2]
END;
{------------- €бЇа ў«ҐЁҐ ®¤®Єа вле ®иЁЎ®Є ----------------------}
FOR i:=1 TO NRS DO
BEGIN
S:=0;
FOR j:=2 TO NPS DO
IF VecB(OPZ)[j-1]=VecB(MOP)[NRS*(i-1)+j] THEN S:=S+1;
IF S=NPR THEN
BEGIN
VecB(KI)[i]:=1-VecB(KI)[i];
EXIT
END
END;
{------------- €бЇа ў«ҐЁҐ ¤ўгеЄа вле ®иЁЎ®Є ----------------------}
N1:=1; N2:=0;
WHILE N1<=NRS DO
BEGIN
IF N2<NRS THEN N2:=N2+1
ELSE
BEGIN N1:=N1+1; N2:=N1+1 END;
{-----------}
FOR j:=2 TO NPS DO VecB(TOP)[j-1]:=VecB(MOP)[NRS*(N1-1)+j];
FOR j:=2 TO NPS
DO VecB(TOP)[j-1]:=VecB(TOP)[j-1] xor VecB(MOP)[NRS*(N2-1)+j];
{-----------}
k:=1;
WHILE (VecB(OPZ)[k]=VecB(TOP)[k]) and (k<NPR) DO k:=k+1;
IF VecB(OPZ)[k]=VecB(TOP)[k] THEN
BEGIN
VecB(KI)[N1]:=1-VecB(KI)[N1];
VecB(KI)[N2]:=1-VecB(KI)[N2];
EXIT
END
{-----------}
END;
{--------------- €ЄаҐ¬Ґв бзҐвзЁЄ Ї®вҐапле б®®ЎйҐЁ© -----------}
KC1:=KC1+1
END;
PROCEDURE PVB;
VAR J,IL:word;
BEGIN
FOR j:=2 TO KJ DO
BEGIN
IL:=VecB(MAT)[j];
VecB(MVO)[kj-j+1]:=VecB(KI)[nrs-IL+1]
END;
FOR j:=1 to kj-1 do
if VecB(MVO)[j]<>VecB(MdV)[j] then begin KC1:=KC1+1;exit;end;
END;
PROCEDURE BVUK;
VAR I,J,NUKV:word;
BEGIN
NUKV:=0;
j:=INF;
FOR i:=1 TO INF DO
BEGIN
NUKV:=NUKV+VecB(MDV)[j]*TRUNC(EXP((i-1)*LN(2)));
j:=j-1
END;
VecS(YKout)[k]:=Ymin+Q+2*Q*NUKV;
END;
PROCEDURE DEMO;
VAR tx:char;
BEGIN
WRITELN('‚ᥣ® в®зҐЄ :',N,' €бЄ ¦Ґ® :',KC1);
WRITELN('— бв®в Ї®вҐаЁ б®®ЎйҐЁ© :',KC1/N:5:3);
WRITELN('— бв®в Їа ўЁ«м®© ЇҐаҐ¤ зЁ б®®ЎйҐЁ© :',1-KC1/N:5:3);
WRITELN;
WRITELN;
WRITELN('„«п Їа®¤®«¦ҐЁп а Ў®вл ¦¬ЁвҐ «оЎго Є« ўЁиг');
while keypressed do tx:=readkey;tx:=readkey
END;
BEGIN
CLRSCR
END.
Соседние файлы в папке UNITS