Помощь студенту ⁄ Файлы ⁄ лабы на Паскале ⁄ работа со списками Паскаль
21 Ноября 2024, Четверг 14:24 >>> Качественная веб-разработка <<<	14:24

Главная Файлы Статьи Форум Связь

Меню сайта

Советуем...

Сборник шпор по физике

CDhack cs 1.6 - Самый мощный чит для CS ( Counter Strike )

Механика, колебания и волны, молекулярная физика - Савельев И.В.

Опрос

Сотрудничество

Поставьте себе на сайт и сообщите мне

код кнопки:

Файлы

Главная » Файлы » Учебные материалы » лабы на Паскале

работа со списками Паскаль

Название: работа со списками Паскаль
Категория: лабы на Паскале
Формат файла: *.pas
Размер: 2.5 Kb
Просмотров: 12682
Загрузок: 2278

Дата добавления: 01 Июня 2009, 12:47
Теги:индексы, информатика, программирование, списки, процедуры, Паскаль, ФУНКЦИИ, ссылка, готовые лабы

Поделиться:

Скачать:

Скачать работа со списками Паскаль бесплатно и без регистрации

Внимание! Если ссылка не работает, файл не найден или просто возникают какие-либо вопросы, напишите об этом, пожалуйста, мне на почту: xdypx@yandex.ru. В письме достаточно указать ссылку на эту страницу и описание проблемы или свой вопрос.

Описание:
Задание:
Создать и заполнить список целыми числами. Найти минимальный и максимальный элементы списка; подсчитать количество мин. и макс. элементов в списке; вывести на экран индексы мин. и макс. элементов;вывести на экран индексы первого и последнего вхождений мин. и макс.

Исходный код:

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.

Комментарии: