Каталог статей
Работа со списками на Паскале (Pascal)
Задание: Создать и заполнить список целыми числами. Найти минимальный и
максимальный элементы списка; подсчитать количество мин. и макс.
элементов в списке; вывести на экран индексы мин. и макс.
элементов;вывести на экран индексы первого и последнего вхождений мин.
и макс.
Исходный код:
Program spiski; uses crt; Type TElement=^element; Element=record a:integer; next:TElement; End;
var
Q,last,head:TElement; m,j,c:integer;
{====sozdanie spiska====}
procedure
createhead(var head,last:TElement); Begin new(head); head^.next:=nil; last:=head; End;
{====zapolnenie
spiska=====}
Procedure add(var last:TElement; k:integer); var
Q:TElement; Begin new(Q); Q^.a:=k; Q^.next:=nil;
last^.next:=Q; Last:=Q; End;
{====vivod na ekran
spiska====}
procedure print(head:TElement); var Q:TElement;
l:integer; Begin Q:=head^.next; while Q<>nil do
Begin write(Q^.a,'-->'); Q:=Q^.next; End; writeln; End;
{====vipoln9Iet...====}
procedure
poisk(head:TElement); var Q,O:TElement;
max,min,iax,iin,i,p:integer; Begin {====poisk min i max zna4enii
iz spiska====} Q:=head^.next; max:=q^.a; min:=q^.a; while
Q<>nil do Begin if q^.a<min then min:=q^.a;
if q^.a>max then max:=q^.a; Q:=Q^.next; End; textcolor(9); writeln('max=
',max,' | min= ',min); {====poisk indexov min i max zna4enii
povtoreni9I} writeln('indexi: '); Q:=head^.next; i:=1; iax:=0; iin:=0; while
q<>nil do Begin if q^.a=min then Begin iin:=iin+1;
textcolor(4); write(i,' '); End; if q^.a=max then Begin
iax:=iax+1; textcolor(2); write(i,' '); End; Q:=q^.next;
inc(i); End; textcolor(12); writeln; writeln('kol-vo
max= ',iax,' | kol-vo min= ',iin);
textcolor(4); write('pervoe
i poslednee vhozhdenie minimalnogo: '); writeln; i:=1; Q:=head^.next; while
q^.a<>min do Begin Q:=q^.next; inc(i); End; p:=i; write(p,'
'); while q<>nil do Begin if q^.a=min then p:=i;
Q:=q^.next; inc(i); End; writeln(p);
textcolor(2); write('pervoe
i poslednee vhozhdenie maximalnogo: '); writeln; i:=1; Q:=head^.next; while
q^.a<>max do Begin Q:=q^.next; inc(i); End; p:=i; write(p,'
'); while q<>nil do Begin if q^.a=max then p:=i;
Q:=q^.next; inc(i); End; write(p);
End;
{Function
DiskFree(Drive : Byte) : Longint; Function DiskSize(Drive : Byte) :
Longint;}
BEGIN clrscr; createhead(head,last); j:=1; textcolor(6); write(j,'.
'); textcolor(9); readln(m); inc(j); if m<>0 then
Begin while m<>0 do Begin add(last,m);
textcolor(6); write(j,'. '); textcolor(9);
readln(m); inc(j); End; End else Begin
textcolor(214);Writeln('spisok pust'); readln; Exit; End; textcolor(13); print(head); poisk(head); readln; END.
|
Категория: Pascal | Добавил: _Hz_ (28.02.2010)
|
Просмотров: 1020
| Рейтинг: 0.0/0 |
Добавлять комментарии могут только зарегистрированные пользователи.
[
Регистрация |
Вход ]