Отчеты по лабораторным работам
1 1 1 1 1 1 1 1 1 1 Рейтинг 0.00 (0 Голоса)

ОТЧЕТ по лабораторной работе дисциплины: «ОАПСВТ» на тему: «Построение максимальных интервалов для ДНФ»

Цель работы:

Построить максимальные интервалы для дизъюнктивной нормальной формы.

Постановка задачи.

Задано: число переменных (размерность), число функций, единичные наборы, в виде матрицы смежности, с числом вершин, задаваемым в процессе диалога (не более 8). Требуется разработать программу для ввода, хранения и обработки графа, которая находила бы все исходы вершины N. В памяти для хранения одного элемента матрицы использовать один бит. Программа должна быть построена по блочно-модульному принципу.

Описание входных и выходных данных.

Входными данными является граф, представленный в виде матрицы смежности, которая находится в файле 1.ini, но также он может быть создан, либо сгенерирован случайным образом. Также переменные int col- размер матрицы; он либо берётся из файла, либо в процессе генерации создаётся. Выходные данные - это поле M[] компонента TMemo1, содержащее все исходы вершины N.

Текст программы .

type

s=array[1..120,1..16]of byte;

var

Form1: TForm1;

but: array[1..2] of byte;

dat, res, ed, edr: byte;

f: file of word;

sbf: array[1..256, 1..32] of byte;

cf, cp, ci, n1,nx: word;

MM: array[1..512] of word;

Inter: array[1..100,1..16] of byte;

procedure TForm1.N6Click(Sender: TObject);

begin

Close;

Application. Terminate;

end;

var

k, p,e, r,v, d,k1,k2,op, ol:word;

t:integer;

h, h1,h3:boolean;

b, b2,b3:s;

c, c2,c3,c4:s;

a, a1,amy:array[1..256, 1..18]of byte;

procedure Max(n1m, nxm:word);

var i, j,y, l: word;

procedure prout(b1:s;c1:s); {t-kol. intervalov}

var i, j:word;

begin

end;

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

procedure kk1; {udalenie odinakov. intervalov}

var io:array[1..16]of word;h:boolean;

var i, j,k, l:word;

begin

p:=0;h:=false;

for i:=1 to t-1 do

begin

procedure kos(b, c,b1,c1:s{;t:word}); {dobavlenie ne rasshqrennqx intervalov}

var i, j,k, l,v:word;

begin {b, c-novqe, b1,c1-starqe}

p:=0; {t-kol. intervalov v b, c}

for i:=1 to 16 do

for j:=1 to 16 do

begin

for k:=1 to 16 do

for l:=1 to 16 do

begin

if c1[i, j]=c[k, l] then p:=p+1;

end;

if p>0 then begin p:=0; continue; end

else begin

for v:=1 to 16 do

begin

b[t, v]:=b1[i, v];

c[t, v]:=c1[i, v];

end;

t:=t+1;p:=0;

end;

end;

for i:=1 to 100 do

for j:=1 to 16 do

begin

b2[i, j]:=b[i, j];c2[i, j]:=c[i, j];

end;

end;

{______________________________________________________}

procedure upgrade(b1,c1:s{;d:word;e:word});

var pl, t1:word;

i, j,l, y,k:word;

begin

pl:=t-1;{t:=1;}p:=0;k1:=1;h:=false;op:=d;ol:=t;t1:=1;

t:=0;

for i:=1 to 100 do if c[i,1]<>0 then t:=t+1;

for i:=1 to 100 do for j:=1 to 16 do begin b[i, j]:=0;c[i, j]:=0;end;

if t=0 then exit;

for i:=1 to t-1 do

begin

for j:=i+1 to t do

begin

p:=0;k1:=1;d:=0;

for l:=1 to 16 do

begin

if b1[i, l]<>b1[j, l] then begin p:=p+1;r:=l;end;

end;

if (p>1){or(p2(j)=0)} then begin p:=0;continue;end else

begin

for y:=1 to 16 do b[t1,y]:=b1[i, y];

b[t1,r]:=2;

for k:=1 to 16 do

begin

c[t1,k]:=c1[i, k];

if c1[i, k]<>0 then inc(d);

end;

for k:=d+1 to 16 do

begin

c[t1,k]:=c1[j, k1];

inc(k1);

end;

t1:=t1+1;

h:=true;

end;

end;

p:=0;k1:=1;d:=0;

end;

t:=t1;

kk1;

if h then kos(b, c,b1,c1);

for i:=1 to 100 do

for j:=1 to 16 do

begin

b[i, j]:=b2[i, j];c[i, j]:=c2[i, j];

end;

if h then upgrade(b, c) else

begin

for i:=1 to 100 do for j:=1 to 16 do begin b[i, j]:=b1[i, j];c[i, j]:=c1[i, j];end;

end;

end;

{_______________________________________________________}

BEGIN

h:=false;

t:=1;r:=0;

//assign(f1,'c:\data1.dat');reset(f1);

{for k:=1 to n do{while not(eof(f)) do}

{ begin }

for i:=1 to n1m do

begin

//-----------------

for j:=1 to cp do

a[i, j]:=amy[i, j];

//-----------------}

a[i,17]:=i;

c4[i,1]:=i;

end;

{ end;

{___________________________________________________________}

for i:=1 to n1m-1 do

begin

if i=n1m then k:=1 else k:=i+1;

for j:=k to n1m do

begin

for l:=1 to cp do

begin

if a[i, l]<>a[j, l] then begin p:=p+1;e:=l; end;

end;

if p>1 then begin p:=0;continue;end else

begin

for y:=1 to cp do b[t, y]:=a[i, y];

b[t, e]:=2;

c[t,1]:=i;

c[t,2]:=j;

t:=t+1;

end;

p:=0;

end;

end;

e:=t-1;{kol. intervalov po 2 tochki}

kk1;

upgrade(b, c);

t:=ol;

for i:=1 to 16 do for j:=1 to 16 do b3[i, j]:=a[i, j];

kos(b, c,b3,c4);

{if h1=false then}

prout(b2,c2);

END;

procedure prout1(b1:s;c1:s); {t-kol. intervalov}

var i, j: word;

begin

if (c[1,1]=0) or (c[2,1]=0) then exit;

{ writeln;

writeln;}

for i:=1 to t-1 do

begin

for j:=1 to cp do

begin //write(b1[i, j],' ');

inter[ci, j]:=b1[i, j];

end;

// writeln;

inc(ci);

end;

{ writeln;

for i:=1 to t-1 do

begin

for j:=1 to 16 do

write(c1[i, j],' ');

writeln;

end;}

end;

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

procedure p2; {ubivayu intervalq bez X-ov}

var h{,h1}:boolean;

i, j,l, tt, tx: word;

begin

if (c[1,1]=0) or (c[2,1]=0) then exit;

tt:=t-1; tx:=0;

h:=false;{h1:=true;}

for i:=1 to tt do

begin

if c[i,1]=0 then continue;

p:=0; for j:=1 to 16 do begin if c[i, j]=0 then begin {h1:=false;} break; end; if a[c[i, j],18]<>0 then

begin inc(tx); if tx<i then for l:=1 to 16 do begin b[tx, l]:=b[i, l];b[i, l]:=0; c[tx, l]:=c[i, l];c[i, l]:=0;

end; p:=1; break; end; end;

if (p=0) {and (h1)} then

begin end; end;if h then p2;

end;

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

procedure p3; {ubivayu intervalq iz odnih X-ov}

var h:boolean;

i, j,l: word;

begin

if (c[1,1]=0) or (c[2,1]=0) then exit;

h:=false;

for i:=1 to t-1 do

begin if c[i,1]=0 then continue; p:=0; for j:=1 to 16 do begin if c[i, j]=0 then continue;

if a[c[i, j],18]=0 then p:=1; end; if p=0 then begin for l:=1 to 16 do begin b[i, l]:=b[t-1,l];b[t-1,l]:=0;

c[i, l]:=c[t-1,l];c[t-1,l]:=0; end; t:=t-1;p:=0;h:=true; end;

end; if h then p3;end;

procedure kk2; {udalenie odinakov. intervalov}

var io:array[1..16]of word;h:boolean;

i, j,k, l: word;

begin

p:=0;h:=false;

for i:=1 to t-1 do

begin

for j:=i+1 to t do

begin

p:=0;

for k:=1 to 16 do

begin

if (b[i, k]<>b[j, k] ) then continue else p:=p+1;

end;

if p=16 then begin for l:=1 to 16 do b[i, l]:=0; for l:=1 to 16 do io[l]:=b[t-1,l]; for l:=1 to 16 do b[i, l]:=io[l];

for l:=1 to 16 do b[t-1,l]:=0; for l:=1 to 16 do c[i, l]:=0; for l:=1 to 16 do io[l]:=c[t-1,l]; for l:=1 to 16 do [i, l]:=io[l]; for l:=1 to 16 do c[t-1,l]:=0; t:=t-1;h:=true;k2:=k2-1; end; end; end; if h then kk2;end;

procedure p4(b1,c1:s;d:word); {rasshqryayu untervalq}

var {pl,}t1,i, j,l, k,y :word;

begin

{pl:=t-1;{t:=1;}p:=0;k1:=1;h:=false;op:=d;ol:=t;t:=0;{iiiiiiiiiiiiiiiiiii}

{t:=0;}

for i:=1 to 100 do if c[i,1]<>0 then t:=t+1;

if t=0 then exit;

t1:=t+1;

if h3=false then t:=d; {ppppppppppppppppppppppppppppppppppppppppppppppp}

if h3 then begin d:=k2;k2:=0;end;{pppppppppppppppppppppppppppppppppppppp}

h3:=true; {ppppppppppppppppppppppppppppppppppppppppppppppppp}

if (c[1,1]=0) or (c[2,1]=0) then exit;

{for i:=1 to 100 do for j:=1 to 16 do begin b[i, j]:=0;c[i, j]:=0;end;}

for i:=t+1-d to t-1 do

begin for j:=i+1 to t do begin p:=0;k1:=1;d:=0; for l:=1 to 16 do begin

if b1[i, l]<>b1[j, l] then begin p:=p+1;r:=l;end; end; if (p>1){or(p2(j)=0)} then begin p:=0;continue;end else

begin for y:=1 to 16 do b[t1,y]:=b1[i, y]; b[t1,r]:=2; for k:=1 to 16 do begin

c[t1,k]:=c1[i, k]; if c1[i, k]<>0 then inc(d); end; for k:=d+1 to 16 do begin

c[t1,k]:=c1[j, k1]; inc(k1); end; t1:=t1+1;k2:=k2+1; h:=true; end; end;

p:=0;k1:=1;d:=0; end; t:=t1;{prout1(b, c);} { kk1;} {if h then kos(b, c,b1,c1);}{ for i:=1 to 100 do for j:=1 to 16 do

begin b[i, j]:=b2[i, j];c[i, j]:=c2[i, j]; end;} d:=d-op; if h then begin

kk2; p4(b, c,d{k2}); end;{43333333333333333333333333}end;Begin

h3:=false; if n1m<1 then exit;for k:=1 to 120 do for l:=1 to 16 do begin c3[k, l]:=0; c[k, l]:=0; b[k, l]:=0; c2[k, l]:=0; 2[k, l]:=0; b3[k, l]:=0; c4[k, l]:=0; end; for k:=1 to 120 do for l:=1 to 18 do begin a[k, l]:=0;a1[k, l]:=0;end;t:=0; d:=0; k:=0; :=0; e:=0;r:=0; v:=0; k1:=0; k2:=0; op:=0; ol:=0;h:=false;h1:=false;p1;

h1:=true;n1m:=n1m+nxm; l:=1;for i:=1 to 16 do for j:=1 to 17 do a1[i, j]:=a[i, j];

for i:=n1m-nxm+1 to n1m do

begin for j:=1 to 17 do begin a1[l, j]:=a[i, j]; end; a1[l,18]:=l; inc(l); end;

l:=0; for i:=1 to n1m do begin {//-------------------} for j:=1 to cp do

a[i, j]:=amy[i, j]; //-------------------} a[i,17]:=i;

c3[i,1]:=i; if i>n1m-nxm then

begin inc(l); a[i,18]:=l; end; end;v:=1;p:=0;t:=1;for i:=1 to 100 do for j:=1 to 16 do begin b[i, j]:=0;c[i, j]:=0;end;

begin sr:=false; kt:=1; kx:=n1; for k:=1 to 2 do begin if k=2 then begin kt:=n1+1; kx:=n1+nx; end; for i:=kt to kx-1 do

begin for ii:=i+1 to kx do begin ff:=1; for j:=1 to cp do if sbf[i, j]<>sbf[ii, j] then begin ff:=0;

break; end; if ff=1 then begin sr:=true; exit; end; end; end; end; //************************** for i:=kt to kx do begin for ii:=1 to n1 do begin ff:=1; for j:=1 to cp do if sbf[i, j]<>sbf[ii, j] then

begin ff:=0; break; end; if ff=1 then begin for j:=cp+1 to cp+cf do if sbf[i, j]=sbf[ii, j] then begin { sr:=true; exit;} end; end; end; end; end;

procedure Trans10_2(a, b,c, d:word); //Перевод 10 - 2

for j:=cp+1 to cp+cf do

s:=s+IntToStr(sbf[i, j]);

memo1.Lines. Add(s);

s:='';

begin

w:=0;

for j:=1 to cp do

w:=w+Pow(cp-j)*sbf[i, j];

write(f, w);

end;

for i:=1 to n1+nx do

begin

w:=0;

for j:=cp+1 to cp+cf do

w:=w+Pow(cp+cf-j)*sbf[i, j];

write(f, w);

end;

CloseFile(f);

dat:=1;

ed:=0;

Memo1.ReadOnly:=True;

end;

procedure TForm1.Memo1Change(Sender: TObject);

begin

if ed<2 then

ed:=ed+2;

dat:=1;

end;

procedure TForm1.N8Click(Sender: TObject)

;var i, j,w, x: word; kod: array[1..2,1..16] of byte;begin

if edr>0 then if savedialog2.Execute then begin AssignFile(f, savedialog2.FileName);

Rewrite(f); write(f, cp); // --- Запись в файл *.max --- write(f, ci);

for i:=1 to ci do begin for j:=1 to cp do

begin case inter[i, j] of 0: begin

kod[1,j]:=0; kod[2,j]:=1; end;

1: begin kod[1,j]:=1; kod[2,j]:=0;

end; 2: begin kod[1,j]:=1;

kod[2,j]:=1; end; end;

end; for x:=1 to 2 do begin

w:=0; for j:=1 to cp do w:=w+Pow(cp-j)*kod[x, j]; write(f, w);

end; end; CloseFile(f); edr:=0; end;end;

procedure TForm1.N9Click(Sender: TObject);

begin N7Click(Self); N8Click(Self);end; end.

Тестовой пример.

1.Файл 1.ini

8

00101001

10011101

10010011

11000011

11100000

00011001

10001001

01110110

РЕЗУДЬТАТ

5 Дуга----> 0

5 Дуга----> 1

5 Дуга----> 2

5 Дуга----> 3

Выводы.

В процессе выполнения лабораторной работы были изучены способы представления графа в компьютере. Была разработана программа для обработки графа, представленного в виде битовой матрицы смежности. Тестирование программы подтвердило правильность ее работы.

Добавить комментарий


Защитный код
Обновить

По темам:

История Украины

Культурология

Высшая математика

Информатика

Охотоведение

Статистика

География

Военная наука

Английский язык

Генетика

Разное

Технологиеские темы

Украинский язык

Филология

Философия

Химия

Экология

Социология

Физическое воспитание

Растениевосдство

Педагогика

История

Психология

Религиоведение

Плодоводство

Экономические темы

Бухгалтерские темы

Маркетинг

Иностранные языки

Ветеринарная медицина

Технические темы

Землеустройство

Медицинские темы

Творчество

Лесное и парковое хозяйство

Агрономия

Преподавателям

Юридические темы

Google