Исследование программ для работы с фотографиями

Поставленная  цель и текущие задачи работы выполнены.

 

 

 

 

 

 

 

 

Список литературы

1. Алексеев В.Е., Таланов В.А. Графы. Модели вычислений структуры графов. – Н.Новгород: «Нижегородский университет», 2005.- 307 с.
2. Епашников А.М., Епашников В.А. Программирование в среде Turbo Pascal 7.0. –3-е изд., стер. – М.: «ДИАЛОГ-МИФИ», 1998. –288 с.
3. Hечепуpенко М.И. Алгоpитмы и пpогpаммы pешения задач на гpафах и сетях. - Hовосибиpск: Hаука, 1990.
4. Окулов С.М.Программирование в алгоритмах.-М.:«Бином»,2002.-341 с.
5. Смольяков Э.Р. Введение в теоpию гpафов. М.: МГТУ, 1992.
6. Википедия [Электронный ресурс] URL http://ru.wikipedia.org - режим доступа свободный.
7. Интернет университет информационных технологий. Лекции: графы и алгоритмы [Электронный ресурс] URL http://www.intuit.ru/department/algorithms - режим доступа через регистрацию.
8. Форум программистов и сисадминов [Электронный ресурс] URL http://www.cyberforum.ru – режим доступа свободный.

 

 

 

 

 

 

 

 

 

 

 

 

Приложение

uses crt;

const C=100;

inf=999999;

var graf:array[1..C,1..C] of integer;

ww,w,n:integer; 

visited:array[1..C] of boolean;

D:array[1..C] of integer;

// процедуры

procedure simetria;

    var i,j:integer;

begin

for i:=1 to n do

   for j:=1 to n do begin

   if graf[i,j]<>graf[j,i] then

      graf[j,i]:=graf[i,j];

end;

end;

 

procedure petli; {убираем петли из графа}

var

i,j:integer;

begin

for i:=1 to n do

 for j:=1 to n do begin

   if ((i=j) and (graf[i,j]<>0)) then

   graf[i,j]:=0;

end;

end;

 

procedure CheckGraph; {проверка матрицы смежности графа }

var i,j:integer;

begin

for i:=1 to n do

 for j:=1 to n do begin

 if graf[i,j]>1 then

    graf[i,j]:=1;

 if graf[i,j]<0 then

    graf[i,j]:=0; end;

petli;

simetria;

end;

 

procedure ShowGraph;

var i,j:integer;

begin

Clrscr;

Writeln('Матрица составлена(Скорректирована)');

for i:=1 to n do begin

Writeln;

Write(i,' | ');

for j:=1 to n do

Write (graf[i,j]:2,' '); {вывод }

end;

ReadKey;

end;

 

procedure InputD;

var

i,j:integer;

label m; 

begin

Clrscr;    

Writeln('укажите целое кол-во вершин в графе');

Readln(n);

while ((n<0) or (n>C)) do

begin

 if n<0 then

Writeln('Число вершин должно быть положительным');

 if n>C then

Writeln('Выберите меньшее число');

Readln(n);

end;           

writeln('Заполните матрицу смежности');

for i:=1 to n do 

for j:=1 to n do begin             

Writeln(i,'-',j,': ');

Readln(graf[i,j]);

end;              

petli;

simetria;

ShowGraph;          

end;

 

procedure Input;

var

i,j:integer;

begin

Clrscr;    

Writeln('Укажите целое кол-во вершин в графе');

Readln(n);

while ((n<0) or (n>C)) do

begin

 if n<0 then

Writeln('Число вершин должно быть положительным');

 if n>C then

Writeln('Выберите меньшее число');

Readln(n);

end;           

writeln('Заполните матрицу смежности');

for i:=1 to n do

for j:=1 to n do begin

Writeln(i,'-',j,': ');

Readln(graf[i,j]);

end;

CheckGraph;

ShowGraph;     

end;                

 

procedure Pgn(v:integer); {поиск в глубину }

var yk,t,j,k,i:integer;

    stt:array[1..C] of integer;

    pp:boolean;

begin 

yk:=1;

k:=1;

D[yk]:=v;

stt[yk]:=v;

visited[v]:=false;

 while (yk<>0) do begin

t:=stt[yk]; //выбор вершины

j:=1;

pp:=false;

 repeat

if ((graf[t,j]=1) and (visited[j]=false)) then

pp:=true

 else

j:=j+1;

 until ((pp=true) or (j>n));

if (pp=true) then begin

yk:=yk+1;

visited[t]:=true; {добавляем номер вершины }

k:=k+1;

D[k]:=j;

stt[yk]:=j;

end

else

begin

visited[t]:=true;

yk:=yk-1; //убираем номер вершины

end;

end; 

for i:=1 to n do begin

write(D[i]);

write('->');

end;

end;

 

procedure DFS; //подготовка к поиску в глубину

var v:integer;

begin

Writeln;

Writeln('Введите номер вершины откуда начать поиск в глубину');

Readln(v);

while((v<0) or (v>n)) do begin

Writeln('Нет такой вершины в графе, попробуй еще раз');

readln(v);

end;

Pgn(v);{начало поиска }

end;

 

procedure BFS;

var v,i, ps, pe : integer;//v-корневая вершина

begin

writeln;

writeln('введите номер вершины с которой следует начать обход в ширину');

readln(v);

while (v<1) or (v>n) do begin

writeln('Ошибка ввода! Такой вершины не существует');

readln(v);

end;  

ps := 1; //начало 

pe := 1; //конец

D[pe] := v;

visited[v] := TRUE;

while ps <= pe do begin

for i := 1 to n do if (graf[v, i] <> 0) and (not visited[i]) then begin

inc(pe);

D[pe] := i;

visited[i] := true;

end;

inc(ps);

v := D[ps];

end;

for i:=1 to n do begin

write(d[i]);

write('->');

end;

end;

 

procedure Deisktr;

var s,i, j, v, min : longint;{s – искомая вершина}

begin

writeln;

writeln('Введите искомую вершину');

readln(s);

while (s<1) or (s>n) do begin

writeln('Такой вершины не существует');

readln(s);

end;  

visited[s] := TRUE;

for i := 1 to N do D[i] := graf[s, i];

 for i := 1 to n-1 do  begin

min := inf;

for j := 1 to N do if (not visited[j]) and (D[j] < min) then begin

min := D[j];

v := j;

end;

for j := 1 to N do if (D[j] > D[v] + graf[v, j]) and (D[v] < inf) and (graf[v, j] < inf) then D[j] := D[v] + graf[v, j];

visited[v] := TRUE;

end;

writeln;

writeln('Поиск завершон');

for i:=1 to n do begin

writeln('Расстояние из вершины ',i,' в вершину: ',d[i]);

end;

end;

 

function Min(a,b:integer):integer;{алгоритм флойда }

begin

    if a < b then min := a else min := b;

end;

 

procedure floyd;

var i, j, k : integer;

W:array[1..C, 1..C] of integer;

begin

for i := 1 to N do for j := 1 to N do W[i, j] := graf[i, j];{копирование матрицы}

for k := 1 to N do

for i := 1 to N do

  for j := 1 to N do W[i,j] := min(W[i, j], W[i, k] + W[k, j]);

//âûâîä

writeln;

writeln('Поиск завершон');

writeln('Массив кратчайших расстояний');

for i:=1 to N do begin

writeln;

Write(i,' | ');

for j:=1 to N do begin

write(w[i,j]:2,' ');

end;

end;

end;

 

procedure obedinenieDFS;

begin

Input;

DFS;

Readln;

end;

 

procedure obedinenieBFS;

begin

Input;

BFS;

readln;

end;

 

procedure obedinenieDeisktr;

begin

InputD;

Deisktr;

readln;

end;

 

procedure obedineniefloyd;

begin

InputD;

floyd;

Readln;

end;

{тело  программы }

begin

z:Writeln('Выберите метод поиска в глубину:');

writeln('1-Поиск в ширину ');

Writeln('2-Поиск в глубину ');

writeln('3-Алгоритм Дейкстры ');

writeln('4-Алгоритм флойда ');

readln(w);

if w=1 then begin

obedinenieBFS;

end

else

if w=2 then begin

obedinenieDFS;

end

else

if w=3 then begin

obedinenieDeisktr;

end

else

if w=4 then begin

obedineniefloyd;

end;

readln;

end.