1 Востаннє редагувалося Replace (08.11.2012 19:00:09)

Тема: Допоможіть переробити програму (дерева)

мені потрібно сформувати дерево речення: ""Пливуть осінні тихі небеса". Вузол "тихі" замінити на вузол "білі".
Нижче програма яка доставляє вузол, а мені треба щоб мінявся вузол.
Допоможіть будь ласка!
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.

2 Востаннє редагувалося Пам'ять не може бути READ (08.11.2012 17:45:13)

Re: Допоможіть переробити програму (дерева)

Ну чому ніхто не бере код у теги code...

3 Востаннє редагувалося галинка (08.11.2012 17:49:37)

Re: Допоможіть переробити програму (дерева)

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.

Re: Допоможіть переробити програму (дерева)

Я не повністю зрозумів, але вам треба замінити Пливуть осінні тихі небеса на Пливуть осінні білі небеса, чи тільки слово тихі на білі?

5 Востаннє редагувалося галинка (08.11.2012 18:06:55)

Re: Допоможіть переробити програму (дерева)

так! Мені треба поміняти тихі на білі. Вивести проміжний та остаточний результати.
має бути:
Пливуть осінні тихі небеса
Пливуть осінні білі небеса
, але у вигляді дерева

6 Востаннє редагувалося Пам'ять не може бути READ (08.11.2012 19:25:51)

Re: Допоможіть переробити програму (дерева)

Хм, замінити слово - не проблема.

var
search,replace,text:string;
i:integer;
begin
search:='тихі';
replace:='білі';
text:='Пливуть осінні тихі небеса';
for i:1 to length(text) - 4  do
 if copy(text,i,4) = search
 then
 begin
 delete(text,i,4);
 insert(replace,text,i);
 end;
writeln(text);
readln;
end.

Ось маленький код, для заміни слів у тексті.