Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

gas / UNITS / FKT

.PAS
Скачиваний:
15
Добавлен:
15.06.2014
Размер:
18.77 Кб
Скачать
UNIT FKT;
INTERFACE
USES GNK;
PROCEDURE FBL(var FF:text;REG:char;L,KBL:word;var WT);
PROCEDURE FPC(TF:char;KBL,L:word;var WT,WP,PC;var DIF:word);
PROCEDURE FTAB(DIF:word;var PC,TREE);
PROCEDURE FKOD(KBL,DIF,LEN:word;var PC,TREE,KOD);
PROCEDURE VIEW(TF,REG:char;KBL,DIF,L,LEN,INF:word;var WT,WP,PC,KOD,BIN);
PROCEDURE TVK(DIF,LEN:word;var PC,KOD;WPi:word;var LKOD:string);
PROCEDURE KAN(VP:byte;var LKOD:string;T0,T1,PK,S,M:real);
PROCEDURE DCT(REG:char;DIF,L,LEN,KBL,NZ:word;var LKOD:string;
var WT,KOD,WP,PC);
PROCEDURE STAT(KBL,L,LEN:word;REG:char;var KOD,PC,WP);
PROCEDURE FBIN(KBL,DIF,INF:word;var PC,BIN);
PROCEDURE BTK(KBL,DIF,L,INF:word;var WP,PC,BIN);
PROCEDURE SEG(REG:char;KBL,L:word;var UK,WT);
PROCEDURE DCF(REG:char;DIF,L,LEN,KBL,NZ:word;var LKOD:string;
Q,Ymin:real;var WT,KOD,WP,PC,YKout);

IMPLEMENTATION
USES CRT;
TYPE
VecW=array[1..32767] of word;
VecB=array[1..32767] of byte;
VecS=array[1..32767] of string[1];
VecC=array[1..65535] of char;
VecR=array[1..10922] of real ;

VAR FK,FT,FB:text;
Z1,Z2:word;
SKOD:string;

PROCEDURE UPR(DIF:word;var MAS);
VAR i,PR:word;
P:boolean;
BEGIN
REPEAT
P:=FALSE;
i:=1;
WHILE (i<DIF-1) and (VecW(MAS)[2*(i-1)+2]>=VecW(MAS)[2*i+2]) DO i:=i+1;
{-----------}
IF VecW(MAS)[2*(i-1)+2]<VecW(MAS)[2*i+2] THEN
BEGIN{1}
PR:=VecW(MAS)[2*(i-1)+2];
VecW(MAS)[2*(i-1)+2]:=VecW(MAS)[2*i+2];
VecW(MAS)[2*i+2]:=PR;
{-----------}
PR:=VecW(MAS)[2*(i-1)+1];
VecW(MAS)[2*(i-1)+1]:=VecW(MAS)[2*i+1];
VecW(MAS)[2*i+1]:=PR;
{-----------}
P:=TRUE
END{1}
UNTIL NOT P
END;

PROCEDURE FBL;
VAR i,j:word;
BEGIN
ASSIGN(FK,'KOD_OUT.PAS');REWRITE(FK);
ASSIGN(FT,'TEXT_OUT.PAS');REWRITE(FT);
i:=1;
j:=1;
WHILE (NOT EOF(FF))and(i<=KBL ) DO
BEGIN{1}
WHILE j<=L DO
BEGIN{2}
WHILE EOLN(FF) DO READLN(FF);
READ(FF,VecS(WT)[L*(i-1)+j]);
j:=j+1
END;{2}
i:=i+1;
CASE REG OF
'B','b':j:=1;
'L','l':BEGIN{3}
j:=1;
WHILE j<L DO
BEGIN{4}
VecS(WT)[L*(i-1)+j]:=VecS(WT)[L*(i-2)+j+1];
j:=j+1
END;{4}
END{3}
ELSE HALT
END{CASE}
END{1}
END;

PROCEDURE FPC;
PROCEDURE PLUS(var S:string;L,CH:word);
VAR m:word;
BEGIN
m:=1;
WHILE m<=L DO
BEGIN{0}
S:=S+VecS(WT)[L*(CH-1)+m];
m:=m+1
END{0}
END;
VAR i,j,k,m,SF,PSF:word;
ST,PST:string;
PR:boolean;
BEGIN
VecW(PC)[1]:=1;
VecW(PC)[2]:=1;
VecW(WP)[1]:=1;
DIF:=1;
FOR k:=2 TO KBL DO
BEGIN{1}
PR:=FALSE;
CASE TF OF
'T','t':BEGIN{-------’…Љ‘’-------}{2}
ST:='';
PLUS(ST,L,k);
PST:='';
j:=0;
WHILE (j<k-1) and (ST<>PST) DO
BEGIN{3}
j:=j+1;
PST:='';
PLUS(PST,L,j)
END;{3}
IF ST=PST THEN PR:=TRUE
END;{2}
{---------------------------------------------------}
'F','f':BEGIN{-------”“ЌЉ–€€-------}{4}
j:=1;
{-----------}
WHILE (j<k) and (not PR) DO
BEGIN{5}
{-----------}
m:=1;
SF:=VecW(WT)[L*(k-1)+m];
PSF:=VecW(WT)[L*(j-1)+m];
WHILE (m<L) and (SF=PSF) DO
BEGIN{6}
m:=m+1;
SF:=VecW(WT)[L*(k-1)+m];
PSF:=VecW(WT)[L*(j-1)+m]
END;{6}
{-----------}
IF SF=PSF THEN PR:=TRUE ELSE j:=j+1
END;{5}
END{4}
END;{CASE}
{-----------}
IF PR
THEN
BEGIN{7}
m:=1;
WHILE VecW(PC)[2*(m-1)+1]<>VecW(WP)[j] DO m:=m+1;
{------------}
VecW(PC)[2*(m-1)+2]:=VecW(PC)[2*(m-1)+2]+1;
VecW(WP)[k]:=VecW(WP)[j]
END{7}
ELSE
BEGIN{8}
DIF:=DIF+1;
VecW(PC)[2*(DIF-1)+1]:=DIF;
VecW(PC)[2*(DIF-1)+2]:=1;
VecW(WP)[k]:=DIF
END{8}

END;{1}
UPR(DIF,PC)
END;

PROCEDURE FTAB;
VAR i,j,PR2:word;
BEGIN
FOR i:=1 TO DIF-1 DO
BEGIN{1}
PR2:=VecW(PC)[2*(DIF-i)+2]+VecW(PC)[2*(DIF-i-1)+2];
{-----------}
VecW(TREE)[3*(i-1)+1]:=VecW(PC)[2*(DIF-i-1)+1];
VecW(TREE)[3*(i-1)+2]:=VecW(PC)[2*(DIF-i)+1];
VecW(TREE)[3*(i-1)+3]:=DIF+i;
{-----------}
VecW(PC)[2*(DIF-i-1)+1]:=DIF+i;
VecW(PC)[2*(DIF-i-1)+2]:=PR2;
{-----------}
VecW(PC)[2*(DIF-i)+1]:=0;
VecW(PC)[2*(DIF-i)+2]:=0;
{-----------}
UPR(DIF-i,PC)
END{1}
END;

PROCEDURE FKOD;
VAR i,j,k,SN:word;
STR:string;
BEGIN
FOR k:=1 TO KBL*LEN DO VecC(KOD)[k]:=' ';
{-----------}
FOR i:=DIF DOWNTO 1 DO
BEGIN{1}
SN:=VecW(PC)[2*(i-1)+1];
STR:='';
{-----------}
REPEAT{R1}
j:=0;
REPEAT
j:=j+1
UNTIL (VecW(TREE)[3*(j-1)+1]=SN) or (VecW(TREE)[3*(j-1)+2]=SN);
{-----------}
IF VecW(TREE)[3*(j-1)+1]=SN THEN STR:=STR+'1' ELSE STR:=STR+'0';
SN:=VecW(TREE)[3*(j-1)+3];
{-----------}
UNTIL{R1} SN=2*DIF-1;
{-----------}
k:=1;
FOR j:=LENGTH(STR) DOWNTO 1 DO
BEGIN{2}
VecC(KOD)[LEN*(i-1)+k]:=STR[j];
k:=k+1
END{2}
END{1}
END;

PROCEDURE VIEW;
VAR NB,i,j,k,s,s1,s2:word;
KL:char;
REGIM:string;
BEGIN
CASE REG OF
'L','l' :REGIM:='L-Ја ¬¬ ';
'B','b' :IF L=1 THEN
CASE TF OF
'T','t': REGIM:='‘Ё¬ў®«';
'F','f': REGIM:='“а®ўҐ­м';
END{CASE}
ELSE REGIM:='Ѓ«®Є';
END;{CASE}
{-----------}
CASE TF OF
'T','t': IF L<LENGTH(REGIM) THEN s2:=LENGTH(REGIM) ELSE s2:=L;
'F','f': IF L*3<LENGTH(REGIM) THEN s2:=LENGTH(REGIM) ELSE s2:=L*3;
END;{CASE}
s:=(80-37-s2) div 2;
gotoXY(s,3);WRITE(REGIM);
gotoXY(s+s2+2,3); WRITE('ўҐа®пв­®бвм');
gotoXY(s+s2+3,4); WRITE('Ї®пў«Ґ­Ёп');
gotoXY(s+s2+15,3);WRITE('нд䥪⨢­л©');
gotoXY(s+s2+19,4);WRITE('Є®¤');
gotoXY(s+s2+28,3);WRITE('Ї®§ЁжЁ®­­л©');
gotoXY(s+s2+32,4);WRITE('Є®¤');
{-----------}
s1:=5;
FOR i:=1 TO DIF DO
BEGIN{1}
NB:=VecW(PC)[2*(i-1)+1];
k:=1;
WHILE (NB<>VecW(WP)[k]) and (k<KBL) DO k:=k+1;
{-----------}
gotoXY(s,s1);
CASE TF OF
'T','t': FOR j:=1 TO L DO WRITE(VecS(WT)[L*(k-1)+j]);
'F','f': FOR j:=1 TO L DO WRITE(VecW(WT)[L*(k-1)+j],' ');
END{CASE};
{-----------}
gotoXY(s+s2+5,s1);
WRITELN(VecW(PC)[2*(i-1)+2]/KBL:5:3);
{-----------}
gotoXY(s+s2+16,s1);
FOR j:=1 TO LEN DO WRITE(VecC(KOD)[LEN*(i-1)+j]);
{-----------}
gotoXY(s+s2+29,s1);
FOR j:=1 TO INF DO WRITE(VecW(BIN)[INF*(i-1)+j]);
{-----------}
WRITELN;
IF WHEREY=23 THEN
BEGIN{2}
gotoXY(30,s1+2);
WRITELN('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг !');
WHILE KEYPRESSED DO KL:=READKEY;KL:=READKEY;
{-----------}
FOR j:=5 TO 25 DO
BEGIN{3}
gotoXY(1,j);
CLREOL
END{3};
{-----------}
s1:=5;
END{2}
ELSE s1:=s1+1
END{1};
{-----------}
gotoXY(30,s1+1);
WRITELN('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг !');
WHILE KEYPRESSED DO KL:=READKEY;KL:=READKEY;
{-----------}
IF (TF='T') or (TF='t') THEN
BEGIN
gotoXY(32,s1+3);
WRITELN('€¤Ґв § ЇЁбм! †¤ЁвҐ !')
END
END;

PROCEDURE TVK;
VAR j,k:word;
BEGIN
LKOD:='';
j:=1;
WHILE (j<=DIF) and (VecW(PC)[2*(j-1)+1]<>WPi) DO j:=j+1;
{-----------}
k:=1;
WHILE (k<=LEN) and (VecC(KOD)[LEN*(j-1)+k]<>' ') DO
BEGIN{1}
LKOD:=LKOD+VecC(KOD)[LEN*(j-1)+k];
k:=k+1
END;{1}
END;

PROCEDURE DCT;
LABEL 1,2,3;
VAR i,j,k,q,NI:word;
RKOD,LT:string;
BEGIN
IF NZ=1 THEN
BEGIN{1}
SKOD:=LKOD;
Z1:=1;
Z2:=1
END{1}
ELSE
BEGIN{2}
SKOD:=SKOD+LKOD;
APPEND(FK);
APPEND(FT)
END{2};
{-----------}
FOR i:=1 TO DIF DO
BEGIN{3}
RKOD:='';
LT:='';
j:=1;
WHILE (j<=LEN) and (VecC(KOD)[LEN*(i-1)+j]<>' ') DO
BEGIN{4}
RKOD:=RKOD+VecC(KOD)[LEN*(i-1)+j];
j:=j+1
END;{4}
{-----------}
q:=1;
WHILE (q<=LENGTH(SKOD)) and (q<=LENGTH(RKOD)) DO
BEGIN{5}
LT:=LT+SKOD[q];
q:=q+1
END;{5}
{-----------}
IF RKOD=LT THEN
BEGIN
NI:=VecW(PC)[2*(i-1)+1];
BREAK
END
END;{3}
{-----------}
IF RKOD<>LT THEN
BEGIN{6}
RKOD:='';
j:=1;
WHILE (j<=LEN) and (VecC(KOD)[j]<>' ') DO
BEGIN{4}
RKOD:=RKOD+VecC(KOD)[j];
j:=j+1
END;{4}
NI:=VecW(PC)[1]
END{6};
{-----------}
IF Z1+LENGTH(RKOD)<=80 THEN
BEGIN{7}
1:FOR j:=1 TO LENGTH(RKOD) DO WRITE(FK,RKOD[j]);
Z1:=Z1+LENGTH(RKOD)
END{7}
ELSE
BEGIN{8}
WRITELN(FK);
Z1:=1;
GOTO 1
END{8};
{-----------}
i:=1;
WHILE (NI<>VecW(WP)[i]) and (i<KBL) DO i:=i+1;
NI:=i;
{-----------}
CASE REG OF
'B','b':
BEGIN{11}
IF Z2+L<=80 THEN
BEGIN{12}
2:FOR q:=1 TO L DO WRITE(FT,VecS(WT)[L*(NI-1)+q]);
Z2:=Z2+L
END{12}
ELSE
BEGIN{13}
WRITELN(FT);
Z2:=1;
GOTO 2
END{13}
END;{11}
'L','l':
BEGIN{14}
IF NZ<>1 THEN
IF Z2+1<=80 THEN
BEGIN{15}
3:WRITE(FT,VecS(WT)[L*(NI-1)+L]);
Z2:=Z2+1
END{15}
ELSE
BEGIN{16}
WRITELN(FT);
Z2:=1;
GOTO 3
END{16}
ELSE
BEGIN{17}
FOR j:=1 TO L DO WRITE(FT,VecS(WT)[L*(NI-1)+j]);
Z2:=Z2+L
END{17}
END{14}
END;{CASE}
DELETE(SKOD,1,LENGTH(RKOD));
{-----------}
CLOSE(FK);CLOSE(FT)
END;

PROCEDURE STAT;
VAR i,j,k,NI:word;
TS:real;
ST:string;
KL:char;
BEGIN
TS:=0;
FOR i:=1 TO KBL DO
BEGIN{1}
NI:=VecW(WP)[i];
k:=1;
WHILE (VecW(PC)[2*(k-1)+1]<>NI) DO k:=k+1;
{-----------}
ST:='';
j:=1;
{-----------}
WHILE (VecC(KOD)[LEN*(k-1)+j]<>' ') and (j<=LEN) DO
BEGIN{2}
ST:=ST+VecC(KOD)[LEN*(k-1)+j];
j:=j+1
END;{2}
TS:=TS+LENGTH(ST)
END;{1}
{-----------}
clrscr;
WRITELN('‘।­пп ¤«Ё­  Є®¤®ў®Ј® б«®ў  :',TS/KBL:6:4);
IF REG='B' THEN
WRITELN('Љ®«ЁзҐбвў® ¤ў®Ёз­ле бЁ¬ў®«®ў ­  ®¤­® б®®ЎйҐ­ЁҐ :',TS/KBL/L:6:4);
{-----------}
gotoXY(30,5);
WRITELN('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг !');
WHILE KEYPRESSED DO KL:=READKEY;KL:=READKEY
END;

PROCEDURE FBIN;
VAR DIG,i,j:word;
BEGIN
FOR i:=1 TO DIF DO
BEGIN{1}
DIG:=VecW(PC)[2*(i-1)+1];
j:=INF;
{-----------}
WHILE (DIG>1) and (j>1) DO
BEGIN{2}
VecW(BIN)[INF*(i-1)+j]:=DIG mod 2;
DIG:=DIG div 2;
j:=j-1
END;{2}
{-----------}
VecW(BIN)[INF*(i-1)+j]:=DIG
END{1}
END;

PROCEDURE BTK;
LABEL 1;
VAR NB,i,j,k,z:word;
BEGIN
ASSIGN(FB,'BIN_OUT.PAS');REWRITE(FB);
z:=1;
{-----------}
FOR i:=1 TO KBL DO
BEGIN{1}
NB:=VecW(WP)[i];
j:=1;
WHILE (j<=DIF) and (VecW(PC)[2*(j-1)+1]<>NB) DO j:=j+1;
{-----------}
1:IF z+INF<=78 THEN
BEGIN{2}
FOR k:=1 TO INF DO WRITE(FB,VecW(BIN)[INF*(j-1)+k]);
z:=z+INF;
END{2}
ELSE
BEGIN{3}
WRITELN(FB);
z:=1;
GOTO 1;
END{3}
END;{1}
CLOSE(FB)
END;

PROCEDURE KAN;
VAR j,N:byte;
R,US:real;
BEGIN
CASE VP OF
0:BEGIN{1}
N:=random(length(LKOD)-1)+1;
R:=GAUSS(S,M);
IF LKOD[N]='1' THEN US:=T1 ELSE US:=T0;
US:=US+R;
{----------}
IF US>PK THEN
IF LKOD[N]='0' THEN LKOD[N]:='1';
{----------}
IF US<PK THEN
IF LKOD[N]='1' THEN LKOD[N]:='0';
END{1};
{--------}
1:BEGIN{2}
FOR j:=1 TO LENGTH(LKOD) DO
BEGIN{3}
R:=GAUSS(S,M);
IF LKOD[j]='1' THEN US:=T1 ELSE US:=T0;
US:=US+R;
{----------}
IF US>PK THEN
IF LKOD[j]='0' THEN LKOD[j]:='1';
{----------}
IF US<PK THEN
IF LKOD[j]='1' THEN LKOD[j]:='0';
END{3}
END{2};
END{CASE}
END;

{---------------------------------------------------------------------}

PROCEDURE DCF;
LABEL 1;
VAR i,j,k,NI:word;
RKOD,LT:string;
BEGIN
IF NZ=1 THEN SKOD:=LKOD ELSE SKOD:=SKOD+LKOD;
{-----------}
FOR i:=1 TO DIF DO
BEGIN{1}
RKOD:='';
LT:='';
j:=1;
WHILE (j<=LEN) and (VecC(KOD)[LEN*(i-1)+j]<>' ') DO
BEGIN{2}
RKOD:=RKOD+VecC(KOD)[LEN*(i-1)+j];
j:=j+1
END;{2}
{-----------}
k:=1;
WHILE (k<=LENGTH(SKOD)) and (k<=LENGTH(RKOD)) DO
BEGIN{3}
LT:=LT+SKOD[k];
k:=k+1
END;{3}
{-----------}
IF RKOD=LT THEN
BEGIN{4}
NI:=VecW(PC)[2*(i-1)+1];
BREAK
END{4}
END;{1}
{-----------}
IF RKOD<>LT THEN
BEGIN
RKOD:='';
j:=1;
WHILE (j<=LEN) and (VecC(KOD)[j]<>' ') DO
BEGIN{4}
RKOD:=RKOD+VecC(KOD)[j];
j:=j+1
END;{4}
{-----------}
NI:=VecW(PC)[1]
END;
{-----------}
i:=1;
WHILE (NI<>VecW(WP)[i]) and (i<KBL) DO i:=i+1;
{-----------}
FOR k:=1 TO L DO VecW(WT)[L*(NZ-1)+k]:=VecW(WT)[L*(i-1)+k];
{-----------}
DELETE(SKOD,1,LENGTH(RKOD));
{-----------}
CASE REG OF
'B','b':
BEGIN{6}
1:FOR k:=1 TO L
DO VecR(YKout)[L*(NZ-1)+k]:=Ymin+Q+2*Q*VecW(WT)[L*(NZ-1)+k]
END{6};
'L','l':
BEGIN{7}
IF NZ=1 THEN GOTO 1
ELSE VecR(YKout)[L+NZ-1]:=Ymin+Q+2*Q*VecW(WT)[L*(NZ-1)+L]
END{7}
END{CASE}
END;

PROCEDURE SEG;
VAR i,j,k:word;
BEGIN
i:=1;
j:=1;
k:=1;
WHILE i<=KBL DO
BEGIN{1}
WHILE j<=L DO
BEGIN{2}
VecW(WT)[L*(i-1)+j]:=VecW(UK)[k];
k:=k+1;
j:=j+1
END;{2}
i:=i+1;
CASE REG OF
'B','b':j:=1;
'L','l':
BEGIN{3}
j:=1;
WHILE j<L DO
BEGIN{4}
VecW(WT)[L*(i-1)+j]:=VecW(WT)[L*(i-2)+j+1];
j:=j+1
END;{4}
END{3}
ELSE HALT
END{CASE}
END{1}
END;

BEGIN
RANDOMIZE;
CLRSCR
END.
Соседние файлы в папке UNITS