Показать сообщение отдельно
Старый 04.06.2014, 00:06   #2 (permalink)
andrew_ryaba
Новичок
 
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Написал процедуру для однонаправленного списка. Помогите, пожалуйста, найти ошибку (не работает, видимо, зацикливается)
Код:
type
  Uk = ^rec;
  rec = record
    x: integer;
    adr: Uk;
  end;
var  
  f1: Text;

procedure DINAMO;
var
  p1, p2, p3, PP_A, PP_B, first_A, first_B: uk;    {//указатели для работы со списком}
  ka, kb: integer;
  
  procedure SOZDANIEDINAMO(var first: Uk; txtname:string);
  begin
    clrscr; {//очистка экрана после предыдущих действий}
    Assign(f1, txtname);
    Reset(f1);
    first := nil; {//запоминаем первый элемент}
    while not seekeof(f1) do {//выполняем до конца файла}
    begin
      new(p1); {//выделяем память под элемент}
      read(f1, p1^.x); {//считываем из текстового файла в элемент число}
      if first = nil then first := p1 else p2^.adr := p1;
      {//в первый раз укажем, что теперь первый элемент - это только что созданный элемент}
      {//в последующие разы указываем адрес для элемента P2 - ссылаемся на P1}
      p2 := p1; {//а элемент P1 переименовываем в P2, для последующего повторения действий}
    end;
    p2^.adr := nil; {//завершаем список}
  end;
  
  procedure VIVODDINAMO(first: uk; txt: string);
  begin
    writeln(txt); {//параметр, который будет описывать выводимый тип информации}
    p1 := first;    {//указываем на первый элемент}
    while p1 <> nil do {//пробегаем до конца списка}
    begin
      write(p1^.x, ' '); {//и каждый раз выводим число из элемента}
      p1 := p1^.adr; {//и сразу же переходим к следующему элементу}
    end;
    writeln;
  end;
  
  procedure Proc(var spis1, spis2: uk; pr: boolean; var ka: integer);
  
    procedure AddElem(var spis1: Uk; znach1: integer);
    var
      tmp: Uk;
    begin
      tmp := spis1;
      while tmp^.adr <> nil do
        tmp := tmp^.adr; {ставим tmp на последний элемент списка}
      new(p3);
      p3^.x := znach1;
      p3^.adr := tmp^.adr;
      tmp^.adr := p3;
      tmp := p3^.adr;
      writeln('add');
    end;
    
    procedure DelElem(var spis1: Uk; tmp: Uk);
    var
      tmpi: Uk;
    begin
      if (spis1 = nil) or (tmp = nil) then
        exit;
      if tmp = spis1 then
      begin
        spis1 := tmp^.adr;
        dispose(tmp);
      end
      else
      begin
        tmpi := spis1;
        while tmpi^.adr <> tmp do
          tmpi := tmpi^.adr;
        tmpi^.adr := tmp^.adr;
        dispose(tmp);
      end;
      writeln('del');
    end;
  
  begin
  writeln('start proc');
    p1 := spis1;
    while (p1^.adr <> nil) do
    begin
      if (p1^.x mod 2 = 0) = pr then 
      begin
        AddElem(spis2, p1^.x);
        DelElem(spis1, p1);
      end;
      p1 := p1^.adr;{//к следующему элементу}
    end;
    writeln('obrabotka zavershena');
    ka := 0;
    p1 := spis1;
    while p1^.adr <> nil do 
    begin
      p1 := p1^.adr;
      ka := ka + 1;
    end;
    writeln('kolvo raschitano');
  end;
  
  procedure urezaniespiska(var first_A: Uk; ka, kb: integer);
  var
    j: integer;
  begin
  writeln('start urezanie spiska');
    p1 := first_A;
    for j := 1 to (ka - kb) do 
    begin
      first_A := p1^.adr;
      dispose(p1);
      p1 := first_A;
    end;
    writeln('stop urezanie spiska');
  end;

begin
  SOZDANIEDINAMO(first_A, 'curs1.txt');
  SOZDANIEDINAMO(first_B, 'curs2.txt');
  VIVODDINAMO(first_A, 'spisok A');
  VIVODDINAMO(first_B, 'spisok B');
  proc(first_A, first_B, true, ka);
  proc(first_B, first_A, false, kb);
  if ka > kb then urezaniespiska(first_A, ka, kb) else urezaniespiska(first_B,kb,ka);
  VIVODDINAMO(first_A, 'spisok A');
  VIVODDINAMO(first_B, 'spisok B');
end;
andrew_ryaba вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070