|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
16.05.2014, 22:49 | #1 (permalink) |
Новичок
Регистрация: 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; |
16.05.2014, 22:49 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Пожалуйста, поищите в этих постах решение своей проблемы Помогите с вложенными списками Паскаль. Работа со списками Обмен адресами Обмен видеокарты |
04.06.2014, 00:06 | #2 (permalink) |
Новичок
Регистрация: 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; |
04.06.2014, 03:34 | #3 (permalink) |
Новичок
Регистрация: 30.11.2013
Сообщений: 11
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Ошибки нашел, больше не актуально.
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|