дерева(допоможіть переробити) - Паскаль, Turbo Pascal, PascalABC.NET

галинка94 · 08.11.2012, 19:25

Потрібно не вставити вузол а замінити!!!

Код:

program derevo;
uses crt;
type der=^pointer;
     pointer=record
     kl:integer;
     zap: string[15];
     pr, lv: der;
end;
var vs, vl, q:der;
    tekst: string[15];
    kluth:integer;
procedure vderevo;
begin
  vl:=vs;
  repeat
    while kluth > vl^.kl do
      begin
        if vl^.pr=nil then
          begin
            new(vl^.pr);
            vl:=vl^.pr;
            vl^.kl:=kluth;
            vl^.zap:=tekst;
            vl^.lv:=nil;
            vl^.pr:=nil;
          end else
            vl:=vl^.pr;
      end;
    while kluth< vl^.kl do
      begin
        if vl^.lv=nil then
          begin
            new(vl^.lv);
            vl:=vl^.lv;
            vl^.kl:=kluth;
            vl^.zap:=tekst;
            vl^.pr:=nil;
            vl^.lv:=nil;
          end else
        vl:=vl^.lv;
      end;
until kluth=vl^.kl;
end;
begin
  clrscr;
  new(vs);
  vs^.zap:='Ѓi* а*Ґ';
  vs^.kl:=100;
  vs^.pr:=nil;
  vs^.lv:=nil;
  writeln('Kluch Text');
repeat
  readln(kluth, tekst);
  vderevo;
until kluth=0;
  writeln('                 Котята 1'); writeln;
  vl:=vs;
  writeln('                      ',vl^.zap);
  writeln('                       /\');
  writeln('                      /  \');
  writeln('                     /    \');
  writeln('                    /      \');
  writeln('                   /        \');
  writeln('                  /          \');
  writeln('            ',vl^.lv^.zap,'          ',vl^.pr^.zap);
  writeln('               /                \');
  writeln('              /                  \');
  writeln('             /                    \');
  writeln('            /                      \');
  writeln('           /                        \');
  writeln('          /                          \');
  writeln('     ',vl^.lv^.lv^.zap,'                   ',vl^.pr^.pr^.zap);
  writeln;
  writeln('Press any key ...');
  readkey;
  writeln;
  kluth:=75;
  tekst:='одним ';
  vderevo;
  writeln('                 binarne derevo 2'); writeln;
  vl:=vs;
  writeln('                      ',vl^.zap);
  writeln('                       /\');
  writeln('                      /  \');
  writeln('                     /    \');
  writeln('                    /      \');
  writeln('                   /        \');
  writeln('                  /          \');
  writeln('            ',vl^.lv^.zap,'          ',vl^.pr^.zap);
  writeln('               / \              \');
  writeln('              /   \              \');
  writeln('             /     \              \');
  writeln('            /       \              \');
  writeln('           /         \              \');
  writeln('          /           \              \');
  writeln('   ',vl^.lv^.lv^.zap,'    ',vl^.lv^.pr^.zap,'   ',vl^.pr^.pr^.zap);
  writeln;
  writeln('Press any key ...');
  readkey;
  writeln;
end.

галинка94 · 08.11.2012, 19:50

Код:

program derevo;
uses crt;
type der=^pointer;
     pointer=record
     kl:integer;
     zap: string[15];
     pr, lv: der;
end;
var vs, vl, q:der;
    tekst: string[15];
    kluth:integer;
procedure vderevo;
begin
  vl:=vs;
  repeat
    while kluth > vl^.kl do
      begin
        if vl^.pr=nil then
          begin
            new(vl^.pr);
            vl:=vl^.pr;
            vl^.kl:=kluth;
            vl^.zap:=tekst;
            vl^.lv:=nil;
            vl^.pr:=nil;
          end else
            vl:=vl^.pr;
      end;
    while kluth< vl^.kl do
      begin
        if vl^.lv=nil then
          begin
            new(vl^.lv);
            vl:=vl^.lv;
            vl^.kl:=kluth;
            vl^.zap:=tekst;
            vl^.pr:=nil;
            vl^.lv:=nil;
          end else
        vl:=vl^.lv;
      end;
until kluth=vl^.kl;
end;
begin
  clrscr;
  new(vs);
  vs^.zap:='Котята';
  vs^.kl:=100;
  vs^.pr:=nil;
  vs^.lv:=nil;
  writeln('Kluch Text');
repeat
  readln(kluth, tekst);
  vderevo;
until kluth=0;
  writeln('                 Котята 1'); writeln;
  vl:=vs;
  writeln('                      ',vl^.zap);
  writeln('                       /\');
  writeln('                      /  \');
  writeln('                     /    \');
  writeln('                    /      \');
  writeln('                   /        \');
  writeln('                  /          \');
  writeln('            ',vl^.lv^.zap,'          ',vl^.pr^.zap);
  writeln('               /                \');
  writeln('              /                  \');
  writeln('             /                    \');
  writeln('            /                      \');
  writeln('           /                        \');
  writeln('          /                          \');
  writeln('     ',vl^.lv^.lv^.zap,'                   ',vl^.pr^.pr^.zap);
  writeln;
  writeln('Press any key ...');
  readkey;
  writeln;
  kluth:=75;
  tekst:='одним ';
  vderevo;
  writeln('                 binarne derevo 2'); writeln;
  vl:=vs;
  writeln('                      ',vl^.zap);
  writeln('                       /\');
  writeln('                      /  \');
  writeln('                     /    \');
  writeln('                    /      \');
  writeln('                   /        \');
  writeln('                  /          \');
  writeln('            ',vl^.lv^.zap,'          ',vl^.pr^.zap);
  writeln('               / \              \');
  writeln('              /   \              \');
  writeln('             /     \              \');
  writeln('            /       \              \');
  writeln('           /         \              \');
  writeln('          /           \              \');
  writeln('   ',vl^.lv^.lv^.zap,'    ',vl^.lv^.pr^.zap,'   ',vl^.pr^.pr^.zap);
  writeln;
  writeln('Press any key ...');
  readkey;
  writeln;
end.

Develop · 08.11.2012, 20:06

Галинко, Ваш кодестайл жжот

Обычно пишут так:

Код:

type 
  PElement = ^TElement;
  TElement = record
     key: integer;
     text: string[15];
     prev, next: PElement;
  end;

и т.д.

Stilet · 08.11.2012, 20:14

Не пойму что менять, у тебя как такового списка то нет, он не вводится должным образом.

Цитата:

pointer=record

Это что? Ты зря переопределяешь тип зарезервированный.
И попрошу по русски писать - форум русскоязычный.

галинка94 · 08.11.2012, 20:22

это должно быть дерево .. просто надо заменить тихие на белые
и все больше ничего не нужно

Develop · 08.11.2012, 20:40

Передача параметров в процедуру через глобальные переменные это полная жесть.

Лучше передавать явно: procedure vderevo(pKey: integer; pText: string);

08.11.2012, 20:06	#3
Develop Пользователь Регистрация: 26.06.2010 Сообщений: 52	Галинко, Ваш кодестайл жжот Обычно пишут так: Код: `type PElement = ^TElement; TElement = record key: integer; text: string[15]; prev, next: PElement; end;` и т.д.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Допоможіть	Дорош	Помощь студентам	2	25.04.2012 23:56

08.11.2012, 20:22	#5
галинка94 Пользователь Регистрация: 26.10.2012 Сообщений: 10	это должно быть дерево .. просто надо заменить тихие на белые и все больше ничего не нужно

08.11.2012, 20:40	#6
Develop Пользователь Регистрация: 26.06.2010 Сообщений: 52	Передача параметров в процедуру через глобальные переменные это полная жесть. Лучше передавать явно: *procedure vderevo(pKey: integer; pText: string);*