Работа с двунаправленным списком. Описание: в исходнике
---- Исходный текст ----
Program Mina;
uses un4, crt;
begin { ************* Начало главной программы ************** }
textattr:= $1f; clrscr;
writeln(' +---------- Условия задачи: -------------+');
writeln(' | Даны действительные A[1],A[2],...A[N] |');
writeln(' | (N - четное). Найти min(A[1]*A[N/2+1], |');
writeln(' | A[2]*A[N/2+2],... A[N/2]*A[N]) |');
writeln(' | Использовать двунаправленный список |');
writeln(' +----------------------------------------+');
writeln;
writeln(' Выберите вариант заполнения: ');
writeln(' 1 - с клавиатуры, 2 - случайные числа');
repeat
cc1:= readkey;
until cc1 in ['1','2']; {чтобы запретить ввод других символов}
case cc1 of
'1': VvodSpiska(LeftHead,RightHead);
'2': Zapoln;
end;
if Pusto(LeftHead.Next) then halt(1);
ControlPrav(RightHead); writeln;
write(' В списке ',count,' элемент');
case count mod 10 of
1:writeln('.');
2..4:writeln('а.');
0,5..9:writeln('ов.');
end;
writeln;
mini:= MinSpis(LeftHead,poradok);
writeln(' Результат (Min)= ',mini:10:2,' (В ',count div 2 - poradok,
'-й паре).');
readln;
{ чтобы результат остался на экране - ожидаю нажатия клав Enter}
textattr:= $07; clrscr;
end.
---------- Модуль с описаниями ----------
Unit un4;
interface {интерфейсная часть модуля содержит описания элементов программы (типов, констант,
переменных, ЗАГОЛОВКИ подпрограмм) которые должны быть доступны в других модулях
(в том числе в главной программе)}
Const KP=8;
Type PElem = ^TElem; {указатель на элемент двунаправленного списка}
TElem = record {элемент двунаправленного списка}
Number: double; {поле для хранения вещественного числа}
Next: PElem; {указатель (на следующий элемент списка)}
Prev: PElem; {указатель (на предыдущий элемент списка)}
end;
Var d1,LeftHead, { используя эту переменную будем двигаться по списку слева-направо}
RightHead: { используя эту переменную будем двигаться по списку справа-налево }
TElem;
count,NN,poradok: integer; cc1: char; mini: double;
Function Pusto(PP: Pointer):Boolean; { описание подпрограмм см ниже }
Procedure ControlSpiska(var Lev,Prav:TElem);
Procedure ControlPrav(Nac:TElem);
Procedure VvodSpiska(var Lev,Prav:TElem);
Function MinSpis(Lev: TElem; var poradok:integer):double;
Procedure Zapoln;
implementation {эта часть (реализация) содержит описания, которые не нужны другим модулям}
uses crt; {предложение USES содержит список модулей, необходимых для компиляции описаний,
размещенных в этой части модуля (implementation). Интерфейс тоже может
содержать предложение USES, если необходимо. Необходимость определяется при
компиляции (компилятор сообщает, что какие-то детали описания неизвестны)}
Function Pusto(PP: Pointer):Boolean; { Если указатель PP=nil - печатает сообщение и
возвращает true }
begin
if PP=nil then
begin writeln(' Список пустой. Жми Enter'); readln;
Pusto := true;
textattr:= $07; clrscr; {устанавливает цвет фона и символов (перед выходом из проги)}
end else Pusto:= false;
end;
Procedure ControlSpiska(var Lev,Prav:TElem);
{Показывает содержимое списка и организует левые связи (.Prev)}
var ele,e2: PElem;
begin clrscr; {чистит экран}
count:= 0; {обнуляет счетчик} writeln;
writeln(' --------- КОНТРОЛЬ списка (вывод слева-направо) -----------');
ele:= Lev.Next;
if Pusto(ele) then halt(1); {если указатель ele пустой, прога выходит в систему с кодом
возврата = 1 (т е аварийно)}
ele^.Prev:= nil; {это будет последний (при движении справа-налево) элемент, поэтому
его указатель .Prev должен содержать nil}
Repeat
e2:= ele; {сохраняю ссылку на элемент ele}
write (ele^.Number:10:2); {распечатываю содержимое элемента ele }
inc(count); {увеличиваю счетчик на 1}
ele:= ele^.Next; {после этого оператора ele будет указывать на следующий (вправо) элемент}
if ele <> nil then {т е если этот элемент существует, то }
ele^.Prev:= e2; {указателю на предыдущий (т е расположенный слева) элемент
присваиваю e2 (который действительно расположен левее от ele)}
until ele = nil; {цикл продолжается до конца списка (движение слева-направо)}
Prav.Prev := e2; {после выхода из этого цикла e2 указывает на последний элемент списка,
поэтому нужно свяхать его с переменной, указывающий на начало (при движении справа-налево)
списка}
writeln;
write(' Для продолжения жми Enter');
readln; {чтобы программа ожидала нажатия на клавишу Enter}
end;
Procedure ControlPrav(Nac:TElem);
{Показывает содержимое списка, начиная справа }
var ele: PElem; half,ii: Integer;
begin clrscr; half:= count div 2; writeln;
writeln(' --------- КОНТРОЛЬ списка (вывод справа-налево) -----------');
ele:= Nac.Prev; {указателю ele присваиваю адрес крайнего справа элемента списка
(потому что при вызове фактическим параметром для Nac будет RightHead)}
if Pusto(ele) then halt(1);
ii:=0; {(счетчик)}
Repeat
inc(ii);
write (ele^.Number:10:2);
if ii = half then
begin writeln;writeln(' ------------ Другая половина ------- ');
end;
ele:= ele^.Prev; {перемещаюсь к предыдущему (т е ближайшему слева) элементу списка}
until ele = nil; {цикл повторяется до конца списка}
writeln; writeln;
write(' Для продолжения жми Enter'); readln;
end;
Procedure VvodSpiska(var Lev,Prav:TElem);
{Ввод списка производится с использованием только правых (.Next) указателей}
var ele: PElem; cnt: integer;
begin textattr:= $1F; {текст атрибуты: цвет фона = 1(синий), цвет символов=$F (белый)}
clrscr; cnt:=0;
writeln(' --------- Введи список (четное число элементов) ---------');
Lev.Next:= nil;
Repeat
repeat
write(' В списке ',cnt,
' элементов. Введи вещественное число (0 - выход)-> ');
readln(d1.Number);
until not ((d1.Number = 0) and (cnt mod 2 <> 0));
if (d1.Number = 0) then break;
inc(cnt);
New(ele);
ele^ := d1;
ele^.Next:= Lev.Next;
Lev.Next:= ele;
until false;
ControlSpiska(Lev,Prav);
end;
Function MinSpis(Lev: TElem; var poradok:integer):double;
{План действий:
1. Нахожу середину списка (сохраняю в указателе Sered),
т е элемент с порядк номером N/2
(отсчет начинаю с 1). N вычисляет Procedure ControlPrav
2. В задаче требуется найти мин среди чисел:
a[1]*a[N/2+1], a[2]*a[N/2+2],a[3]*a[N/2+3],...a[N/2]*a[N],
где a[i] обозначает содержимое (т е число, хранящееся в )
i-м элементе списка
3. Имея указатель LeftHead, передвигаюсь по элементам
списка 1,2,3,... N/2, а при помощи указателя Sered
передвигаюсь по элементам списка N/2+1,N/2+2,N/2+3,...N,
перемножая соответствующие числа.
4. Мин нахожу, используя стандартный алгоритм т е
а)Переменной Min присваиваю a[1]*a[N/2+1]
б)Выполняю цикл по j от 2 до N/2:
- если a[j]*a[N/2+j] < Min => присваиваю Min:= a[j]*a[N/2+j];
и poradok:= j;
(по списку передвигаюсь при помощи elem:= elem^.Next,
т е передвигаюсь слева-направо)
}
var ele,ele2,Sered: PElem; cnt2,NSered,jj: integer; bufa,Mina: double;
begin
ele:= Lev.Next; cnt2:= 0;
if Pusto(ele) then halt(1); {если указатель ele пустой, прога выходит в систему с кодом
возврата = 1 (т е аварийно)}
Repeat
inc(cnt2); {увеличиваю счетчик на 1}
ele:= ele^.Next;
{после этого оператора ele будет указывать на следующий (вправо) элемент}
until cnt2 = count div 2 - 1;
{цикл продолжается до середины списка (движение слева-направо)}
{*********** writeln(ele^.Number); ********** }
Sered:= ele;
ele:= Lev.Next;
ele2:= Sered^.Next;
Mina:= ele^.Number*ele2^.Number; {перемножил 1-й и N/2 + 1-й элементы }
{ writeln(' ----------- Сравниваю произведения: -------------');
write(Mina:10:2); отладочная распечатка }
jj:= 0; {счетчик}
Repeat inc(jj);
ele:= ele^.Next;
ele2:= ele2^.Next;
bufa:= ele^.Number*ele2^.Number;
{перемножаю следующие элементы (2 на N/2+2 и т д )}
{ write(bufa:10:2); отладочная распечатка }
if bufa < Mina then
begin Mina:= bufa; poradok:=jj;
end;
until ele2^.Next = nil;
MinSpis:= Mina;
end;
Procedure Zapoln; {заполняю список случайными числами}
var cnt,ii: integer;
elem: PElem;
begin randomize; {Чтобы избежать повтора цепочки случайных чисел}
repeat write(' Введите число элементов списка (четное) -> ');
readln(cnt);
until cnt mod 2 = 0; {чтобы избежать ввода нечетного числа}
LeftHead.Next:= nil; ii:=0;
Repeat
inc(ii); {счет созданных элементов}
New(elem);
elem^.Number := random(10)+1 {random*1000 - 500}; {2 варианта случайных чисел}
elem^.Next:= LeftHead.Next;
LeftHead.Next:= elem; {стандартно вставляю новый элемент в начало списка }
until ii=cnt;
ControlSpiska(LeftHead,RightHead);
end;
end.
