IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> однонаправленые списки, помогите решить задачку плиз
B&M
сообщение 23.12.2008 18:12
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской
Реальное имя: коля

Репутация: -  0  +


дан список А, который состоит из записей: первое полее речовинне число, второе поле - адрес следующего елемента,
составить програму для вставки нового елемента Е1 перед последним вжодом елемента Е, если елемент есть в списке А.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
B&M
сообщение 24.12.2008 0:22
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской
Реальное имя: коля

Репутация: -  0  +


{
дан список А, который состоит из записей: первое поле - вещественное число,
второе - адрес следующего элемента. нужно составить программу для вставки нового
элемента Е1 перед последним вхождением элемента Е, если элемент есть в списке А.
}

вотвам ее решение




program p2227;

{$APPTYPE CONSOLE}

uses
SysUtils;

type
PRec = ^TRec;
TRec = packed record
Value: Real; // Значение
NextLink: PRec; // Ссылка на следующий элемент
PrevLink: PRec; // Ссылка не предыдущий элемент
end;

// Функция создания списка и инициализация элементов случайными числами
function MakeList(const Count: Cardinal): PRec;
var
Rec, Next: PRec;
Index: Integer;
begin
New(Rec);
Rec.Value:= Random(100);
Rec.PrevLink:= nil;
Result:= Rec;

Index:= Count - 1;
while Index > 0 do
begin
New(Next); // следующий элемент
Next.Value:= Random(100);
Rec.NextLink:= Next; // Ссылка на следующий элемент
Next.PrevLink:= Rec; // Ссылка не предыдущий элемент
Next.NextLink:= nil;
Rec:= Next;
Dec(Index);
end;
end;

// Освобождение памяти из-под списка
procedure FreeList(var AList: PRec);
var
Rec, Next: PRec;
begin
Rec:= AList;
while Assigned(Rec) do
begin
Next:= Rec.NextLink;
Dispose(Rec);
Rec:= Next;
end;
end;

// Вывод списка на экран
procedure PrintList(const AList: PRec);
var
Rec: PRec;
Count: Cardinal;
begin
WriteLn('List: ');
Rec:= AList;
Count:= 0;

while Assigned(Rec) do
begin
Write(Rec.Value: 8: 2);
Rec:= Rec.NextLink;
Inc(Count);
end;

WriteLn(#13#10' Total count: ', Count);
end;

// Поиск последнего вхождения элемента в списке
function SearchLast(const AList: PRec; const Value: Real): PRec;
var
Rec: PRec;
begin
Rec:= AList;
Result:= nil;

while Assigned(Rec) do
begin
if Rec.Value = Value // Хреновое сравнение, кстати. Числа-то вещественные!
then Result:= Rec;
Rec:= Rec.NextLink;
end;
end;

// Вставка нового элемента перед элементом ARec
procedure InsRec(ARec: PRec; const Value: Real);
var
NewRec: PRec;
begin
New(NewRec);
NewRec.Value:= Value;
NewRec.NextLink:= ARec;
NewRec.PrevLink:= ARec.PrevLink;
ARec.PrevLink.NextLink:= NewRec;
ARec.PrevLink:= NewRec;
end;

var
List, Rec: PRec;
E, E1: Real; // Что вставляем

begin
List:= MakeList(8);
PrintList(List);

Write('Enter "E" to search: ');
ReadLn(E);
Rec:= SearchLast(List, E); // Поиск последнего вхождения элемента Е в список
if Assigned(Rec)
then begin
Write('Element found. Enter "E1" to insert: ');
ReadLn(E1);
InsRec(Rec, E1);
WriteLn('List after insert: ');
PrintList(List);
end
else WriteLn(' Value ', E: 8: 2, ' not found.');


FreeList(List);

Write(#13#10' Press "ENTER" to exit...');
ReadLn;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.07.2025 7:20
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"