2020-01-15
83
Uses Crt;
Const
R = 4;
SR = 16;
Type
Diz = string[R];
Var
S:array[1..SR*2] of Diz;
Rez:array[1..SR*2] of Diz;
Flag:array[1..SR*2] of byte;
Y:array[1..SR] of byte;
IndexS: byte;
IndexRez: byte;
i, j, k: byte;
FData: Text;
FRez: Text;
FDSNF: file of Diz;
FSImp: file of Diz;
{Функция формирования дизъюнкта}
Function MakeDiz(Number: byte): Diz;
Var
i: byte;
S: Diz;
C: char;
Begin
S:='';
for i:=0 to R-1 do
begin
C:=chr(((Number shr i) and $01) + 48);
Insert(C, S, 1);
end;
MakeDiz:=S;
End;
{Функция склеивания}
Procedure Stuck(S1, S2: Diz; IndexS1, IndexS2: byte);
Var
i, k, n: byte;
Begin
k:=0; {кол-во разных}
for i:=1 to R do
if S1[i] <> S2[i] then
begin
k:=k+1;
n:=i;
end;
case k of
0: begin
Inc(IndexRez);
Rez[IndexRez]:=S1;
Flag[IndexS1]:=1;
Flag[IndexS2]:=1;
end;
1: if (S1[n]<>'*') and (S2[n]<>'*') then
begin
S1[n]:='*';
Inc(IndexRez);
Rez[IndexRez]:=S1;
Flag[IndexS1]:=1;
Flag[IndexS2]:=1;
end;
end;
End;
{Функция проверки на удаление пустого дизъюнкта}
Function Del(S: Diz): Boolean;
Var
i, k: byte;
Begin
Del:=False;
k:=0;
for i:=1 to R do
if S[i]='*' then
k:=k+1;
if k=R then
Del:=True;
End;
Procedure Clear;
Var
i, j: byte;
Begin
IndexS:=0;
for i:=1 to SR*2 do
begin
Flag[i]:=0;
S[i]:='';
end;
for i:=1 to IndexRez-1 do
if Flag[i]=0 then
for j:=i+1 to IndexRez do
if Rez[i]=Rez[j] then
|
|
|
Flag[j]:=1;
for i:=1 to IndexRez do
if Flag[i]=0 then
begin
Inc(IndexS);
S[IndexS]:=Rez[i];
end;
End;
{Вывод на экран массива Rez}
Procedure PrintRezult(Step: Byte);
Var
i: byte;
Begin
WriteLn('{------------------------------------------------}');
WriteLn(FRez, '{-----------------------------------------}');
if Step=0 then
begin
Write('Исходная ДНФ.');
Write(FRez, 'Исходная ДНФ.');
end
else
begin
Write('Шаг номер:', Step:2, '.');
Write(FRez, 'Шаг номер:', Step:2, '.');
end;
WriteLn(' Количество дизъюнктов:', IndexS:2);
WriteLn(FRez, ' Количество дизъюнктов:', IndexS:2);
for i:=1 to IndexS do
begin
WriteLn(S[i]);
WriteLn(FRez, S[i]);
end;
ReadKey;
End;
{Основная программа}
Begin
ClrScr;
Assign(FDSNF, 'dsnf.dat');
Rewrite(FDSNF);
Assign(FSImp, 'simplimp.dat');
Rewrite(FSImp);
Assign(FRez, 'rezult.dat');
ReWrite(FRez);
{Считать массив Y из файла}
Assign(FData, 'func.dat');
Reset(FData);
for i:=1 to SR do
Read(FData, Y[i]);
Close(FData);
{Получить массив S}
for i:=1 to SR do
S[i]:=MakeDiz(i-1);
{Преоразовать S: оставив только те элементы, для которых Y=1. Результата в Rez}
IndexRez:=0;
for i:=1 to SR do
if Y[i]=1 then
begin
Inc(IndexRez);
Rez[IndexRez]:=S[i];
end;
for i:=1 to SR*2 do
S[i]:=Rez[i];
IndexS:=IndexRez;
for i:=1 to IndexS do
Write(FDSNF, S[i]);
PrintRezult(0);
{склеивание}
for i:=1 to R do
begin
IndexRez:=0;
{------------------------------------------------------------}
for j:=1 to SR*2 do {подготовка массива Flag под склеивание}
Flag[j]:=0;
{------------------------------------------------------------}
for j:=1 to SR*2 do {склеивание}
Rez[j]:='';
for j:=1 to IndexS-1 do
for k:=j+1 to IndexS do
Stuck(S[j], S[k], j, k);
{------------------------------------------------------------}
for j:=1 to IndexS do {копирование несклеившихся компонент}
if Flag[j]=0 then
begin
Inc(IndexRez);
Rez[IndexRez]:=S[j];
end;
{------------------------------------------------------------}
Clear; {удаление одинаковых дизъюнктов}
{------------------------------------------------------------}
PrintRezult(i); {вывод результата на экран}
end;
{Удалить все дизъюнкты вида '****'}
IndexRez:=0;
for i:=1 to IndexS do
|
|
|
if not Del(S[i]) then
begin
Inc(IndexRez);
Rez[IndexRez]:=S[i];
end;
for i:=1 to IndexS do
Write(FSImp, S[i]);
PrintRezult(R+1);
Close(FSImp);
Close(FDSNF);
Close(FRez);
End.
Результаты работы программы (файл rezult.dat).
{----------------------------------------------------------------}
Исходная ДНФ. Количество дизъюнктов: 9
0000
0010
0011
0101
0110
0111
1010
1011
1111
{----------------------------------------------------------------}
Шаг номер: 1. Количество дизъюнктов:11
00*0
001*
0*10
*010
0*11
*011
01*1
011*
*111
101*
1*11
{----------------------------------------------------------------}
Шаг номер: 2. Количество дизъюнктов: 5
0*1*
*01*
**11
00*0
01*1
{----------------------------------------------------------------}
Шаг номер: 3. Количество дизъюнктов: 5
0*1*
*01*
**11
00*0
01*1
{----------------------------------------------------------------}
Шаг номер: 4. Количество дизъюнктов: 5
0*1*
*01*
**11
00*0
01*1
{----------------------------------------------------------------}
Шаг номер: 5. Количество дизъюнктов: 5
0*1*
*01*
**11
00*0
01*1
Программа для метода Петрика.
Uses Crt;
Type
string4 = String[4];
string16 = String[16];
TImpArray = array[1..16] of string4;
Var
DSNF: TImpArray; {ДСНФ}
SimpleImp: TImpArray; {Простые импликанты}
IndexDSNF: Integer;
IndexSImp: Integer;
QM: array[1..16, 1..16] of integer; {матрица покрытия}
S16Min: string16;
Procedure Input;
Var
FData: file of string4;
i: integer;
Begin
{ввод матрицы ДСНФ}
Assign(FData, 'dsnf.dat');
Reset(FData);
i:=0;
while not eof(FData) do
begin
Inc(i);
Read(FData, DSNF[i]);
end;
IndexDSNF:=i;
Close(FData);
{ввод простых импликант}
Assign(FData, 'simplimp.dat');
Reset(FData);
i:=0;
while not eof(FData) do
begin
Inc(i);
Read(FData, SimpleImp[i]);
end;
IndexSImp:=i;
Close(FData);
{конец ввода}
End;
Function Metka(n, m: integer): boolean;
Var
i, S: integer;
Begin
Metka:=False;
S:=0;
for i:=1 to 4 do
if SimpleImp[n, i]='*' then
S:=S+1
else
if SimpleImp[n, i]=DSNF[m, i] then
S:=S+1;
if S=4 then
Metka:=True;
End;
Procedure FormMatrix;
Var
i, j: integer;
Begin
for i:=1 to IndexSImp do
for j:=1 to IndexDSNF do
if Metka(i, j) then
QM[i, j]:=1
else
QM[i, j]:=0;
End;
Procedure PrintMatrix;
Var
i, j: integer;
Begin
TextColor(LIGHTGREEN);
Write(' ');
for i:=1 to IndexDSNF do
Write(DSNF[i]:6);
WriteLn;
for i:=1 to IndexSImp do
begin
TextColor(LIGHTGREEN);
Write(SimpleImp[i]:6);
for j:=1 to IndexDSNF do
case QM[i, j] of
1: begin TextColor(LIGHTRED); Write(' 1'); end;
0: begin TextColor(RED); Write(' -'); end;
end;
WriteLn;
end;
End;
Function Bin(N:integer): string16;
Var
i: integer;
S: string16;
Begin
S:='0000000000000000';
i:=0;
while N>0 do
begin
Inc(i);
Insert(Chr((N mod 2)+48), S, i);
N:=N div 2;
end;
Bin:=S;
End;
Function Pokritie(var S: string16): boolean;
Var
V: array[1..16] of integer;
i, j, Sum: integer;
Begin
Pokritie:=False;
for i:=1 to 16 do
V[i]:=0;
for i:=1 to IndexSImp do
if S[i]='1' then
for j:=1 to IndexDSNF do
if QM[i, j]=1 then
V[j]:=1;
Sum:=0;
for i:=1 to IndexDSNF do
if V[i]=1 then
Sum:=Sum+1;
if Sum=IndexDSNF then
Pokritie:=True;
End;
Function Count(S: string16): integer;
Var
i, j, C: integer;
Begin
C:=0;
for i:=1 to IndexSImp do
if S[i]='1' then
for j:=1 to 4 do
if SimpleImp[i, j]<>'*' then
C:=C+1;
Count:=C;
End;
Procedure ActionsPetrik;
Var
i, j, Index: integer;
S16: string16;
Begin
Index:=(1 shl IndexSImp)-1;
S16Min:='1111111111111111';
for i:=1 to Index do
begin
S16:=Bin(i);
if Pokritie(S16) then
if Count(S16)<Count(S16Min) then
S16Min:=S16;
end;
End;
Procedure PrintRezult;
Var
i: integer;
Begin
WriteLn;
WriteLn;
TextColor(LIGHTGREEN);
WriteLn('Минимальная дизъюнктивная нормальная форма.');
WriteLn;
TextColor(LIGHTRED);
for i:=1 to IndexSImp do
if S16Min[i]='1' then
WriteLn(SimpleImp[i]:8);
End;
Begin
ClrScr;
Input; {ввод данных}
FormMatrix; {формирование матрицы покрытия для ее дальнейшей обработки}
PrintMatrix; {вывод матрицы}
ActionsPetrik; {формирование конъюнкции дизъюнкций
по методу Петрика и выбор минимальной из них}
PrintRezult; {печать МДНФ}
ReadKey;
End.
Результаты работы программы.
0000 0010 0011 0101 0110 0111 1010 1011 1111
0*1* - 1 1 - 1 1 - - -
*01* - 1 1 - - - 1 1 -
**11 - - 1 - - 1 - 1 1
00*0 1 1 - - - - - - -
01*1 - - - 1 - 1 - - -
Минимальная дизъюнктивная нормальная форма.
0*1*
*01*
**11
00*0
01*1
