Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Как купить рекламу на форуме


Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail


Ответ
 
Опции темы Поиск в этой теме
Старый 14.01.2016, 19:19   #1
katel
Новичок
Джуниор
 
Регистрация: 14.01.2016
Сообщений: 1
По умолчанию код прюфера есть прога нужно объяснить

построить дерево по коду прюфера

Код:
program kodpruf; {кодировка Прюфера}
uses crt, graph;
const mn=12; {Максимальное число вершин}
type sd=array[1..2*(mn-1)] of integer; {вершины ребер}
var p:array[1..mn-1,1..2] of integer; {массив ребер}
    s:sd;
    st,u:string;
    pr,sv:array[1..mn] of integer; {код, степени вершин}
    m,n,i,j,k,gd,gm,x0,y0:integer; t:boolean;
    f:text;
procedure readf; {Чтение данных из файла}
begin
assign(input,'input1.txt');
reset(input);
readln(n);
m:=n-1;
for i:=1 to m do
 begin
  read(p[i,1],p[i,2]);
  s[2*i-1]:=p[i,1];
  s[2*i]:=p[i,2];
 end;
close(input);
writeln(' Число вершин: ',n,' число ребер ',m);
writeln;
writeln(' Список ребер дерева:');
writeln;
for i:=1 to m do
write(p[i,1]:2,p[i,2]:3,' ');
writeln;
end;
function nom(x:sd; y:integer):integer;
var k:integer;
begin
nom:=0;
for k:=1 to 2*(n-1) do
if x[k]=y then
 begin
  nom:=k;
  exit
 end;
end;
procedure tree; {Рисует дерево}
const c=100;
      x0=100;
var x,y,xnum,ynum: array[1..mn] of integer;
    ss:array[1..mn] of string[5];
procedure summit(a,b:integer); {Рисует вершиyу}
begin
setcolor(4);
setlinestyle(0,0,2);
circle(a,b,5);
end;
begin
gd:=0;
initgraph(gd,gm,'tp7');
for i:=1 to 4 do x[i]:=i*c+x0;
for i:=5 to 8 do x[i]:=(i-4)*c+x0;
for i:=9 to 12 do x[i]:=(i-8)*c+x0;
for i:=1 to 4 do y[i]:=50;
for i:=5 to 8 do y[i]:=50+c;
for i:=9 to 12 do y[i]:=50+2*c;
setcolor(4); settextstyle(0,0,1);
for i:=1 to n do
 begin
  xnum[i]:=x[i]+10;
  ynum[i]:=y[i]-20; str(i,ss[i]);
 end;
for i:=1 to n do
 begin
  outtextxy(xnum[i],ynum[i],ss[i]);
  summit(x[i],y[i]); setfillstyle(1,3);
  floodfill(x[i]+2,y[i]+2,4);
 end;
setlinestyle(0,0,2); setcolor(3);
for i:=1 to m do
line(x[p[i,1]],y[p[i,1]],x[p[i,2]],y[p[i,2]] );
settextstyle(0,0,2);
outtextxy(50,360,'Kod Prufera');
outtextxy(50,410,st);
readkey;
closegraph
end;
begin
clrscr;
readf;
for i:=1 to n do sv[i]:=0;
for i:=1 to n-2 do pr[i]:=0;
for i:=1 to n do
for j:=1 to m do
if (p[j,1]=i) or (p[j,2]=i) then sv[i]:=sv[i]+1;
for i:=1 to n-2 do
 begin
  j:=1;
  while sv[j]<>1 do inc(j);
   begin
    k:=nom(s,j);
    if (k mod 2 = 0) then
     begin
      pr[i]:=s[k-1];
      dec(sv[pr[i]])
     end
    else
     begin
      pr[i]:=s[k+1];
      dec(sv[pr[i]])
     end;
    sv[j]:=0;
    if (k mod 2 = 0) then
     begin
      s[k-1]:=0;
      s[k]:=0 end
     else
      begin
       s[k+1]:=0;
       s[k]:=0
      end;
   end;
end;
writeln;
st:='';
for i:=1 to n-2 do
 begin
  str(pr[i],u);
  st:=st+u+' ';
 end;
writeln(' Kod Prufera: ');
writeln;
writeln(' ',st);
readkey;
tree;
end.

Последний раз редактировалось Stilet; 14.01.2016 в 20:35.
katel вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме 20000 рублей в месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Одномерный массив. есть код, нужно объяснить и немного подправить mikeel Общие вопросы C/C++ 8 10.06.2013 21:10
Pascal ABC буду благодарна в объяснении кода задачи(код есть нужно объяснить ее) Maliish Помощь студентам 0 02.03.2012 23:38
Срочно!Нужно объяснить код программ! ArcaN0id Помощь студентам 1 28.06.2009 11:15
C++. Есть код нужно исправить ошибки megavolt91 Общие вопросы C/C++ 6 06.06.2009 18:27
Есть код программы на с++. Нужно обьяснение Alex1991 Помощь студентам 1 16.03.2009 14:37


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS