Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 16.05.2014, 22:49   #1 (permalink)
andrew_ryaba
Новичок
 
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Pascal. Обмен числами между динамическими списками

Здравствуйте! Помогите пожалуйста. Есть такая задача, которую надо сделать отдельными процедурами для массивов и для линейных динамических списков:
Два массива обмениваются числами так, чтобы в одном оказались только четные значения, а в другом - нечетные значения. Затем привести количество чисел к одинаковой длине путем удаления начальных значений. Исходные данные считываются из текстового файла.
Я написал процедуру для массива, но не могу понять, как реализовать примерно этот же алгоритм, применяя списки?
Код:
procedure MASSIV;
type aa=array [1..n] of integer;
var  A,B: aa;
  i: integer;
  ka,kb: integer;
procedure SOZDANIEMASSIVA(var C:aa; var kolzap:integer);
  begin
    clrscr;
    i := 0;
    Reset(f1);
    while not seekeof(f1) do
    begin
      inc(i);
      read(f1, C[i]);
    end;
    kolzap := i;
  end;

  procedure VIVODMASSIVA(txt: string; C:aa; k:integer);
  var
    i: integer;
  begin
    writeln(txt);
    for i := 1 to k do
      write(C[i]:3);
    writeln;
  end;
  
  procedure RABOTAMASSIVA;
  var k,i,j:integer;
  procedure urezaniemassiva;
  var j,i: integer;
  begin
  if ka<kb then
  for j:=1 to (kb-ka) do begin
  for i:=1 to n-1 do
  B[i]:=B[i+1];
  Dec(kb);
  end else 
  for j:=1 to (ka-kb) do begin
  for i:=1 to n-1 do
  A[i]:=A[i+1];
  Dec(ka);
  end;
  end;
  
  begin
  j:=kb+1;
  i:=1;
  while i <= ka do begin
  if (A[i]mod 2 = 0) then begin
  B[j]:=A[i];
  Inc(j);
  for k:=i to n-1 do begin
  A[k]:=A[k+1];  
  end; 
  Dec (ka);
  end else Inc(i); 
  end;
  kb:=j-1;
  j:=ka+1;
  i:=1;
  while i <= kb do begin
  if (B[i]mod 2 = 1) then begin
  A[j]:=B[i];
  Inc(j);
  for k:=i to n-1 do begin
  B[k]:=B[k+1];  
  end;   
  Dec (kb);
  end  else Inc(i);
  end;
  ka:=j-1;
  urezaniemassiva;
  end;
  
  begin
  SOZDANIEMASSIVA(A,ka);
  SOZDANIEMASSIVA(B,kb);  
  VIVODMASSIVA('Созданный массив A',A,ka);
  VIVODMASSIVA('Созданный массив B',B,kb);
  RABOTAMASSIVA;
  VIVODMASSIVA('После обработки А',A,ka);
  VIVODMASSIVA('После обработки В',B,kb);
  Writeln('Enter-Return to Main Manu');
  Readln;
end;
andrew_ryaba вне форума   Ответить с цитированием

Старый 16.05.2014, 22:49
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Пожалуйста, поищите в этих постах решение своей проблемы

Помогите с вложенными списками
Паскаль. Работа со списками
Обмен адресами
Обмен видеокарты

Старый 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 вне форума   Ответить с цитированием
Старый 04.06.2014, 03:34   #3 (permalink)
andrew_ryaba
Новичок
 
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Ошибки нашел, больше не актуально.
andrew_ryaba вне форума   Ответить с цитированием
Ads

Яндекс

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

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 09:43.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.