Код:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{Тип основных данных.}
TData = Integer;
{Тип указателя на элемент списка.}
TPElem = ^TElem;
{Тип элемента списка.}
TElem = record
Data : TData; {Основные данные.}
PNext : TPElem; {Указатель на следующий элемент списка.}
end;
{Тип, описывающий однонаправленный список.}
TDList = record
PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
end;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
procedure Writeln(s:string);
procedure Readln(var s:string);
public
{ public declarations }
end;
const
M = 7;
var
L1, L2 : TDList;
PElem1, PNext1, PElem2, PPrev2 : TPElem;
i : Integer;
S : String;
Form1: TForm1;
implementation
{$R *.lfm}
{Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка! Иначе, будут утечки памяти.}
procedure Init(var aList : TDList);
begin
aList.PFirst := nil;
aList.PLast := nil;
end;
{Добавление элемента в конец однонаправленного списка.}
procedure Add(var aList : TDList; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := nil;
if aList.PFirst = nil then
aList.PFirst := PElem
else
aList.PLast^.PNext := PElem;
aList.PLast := PElem;
end;
{Особождение памяти, занятой под список.}
procedure Free(var aList : TDList);
var
PNext, PDel : TPElem;
begin
PNext := aList.PFirst;
while PNext <> nil do begin
PDel := PNext;
PNext := PNext^.PNext;
Dispose(PDel);
end;
Init(aList);
end;
{Распечатка однонаправленного списка.}
procedure LWriteln(const aList : TDList);
var
PElem : TPElem;
begin
if aList.PFirst = nil then begin
Writeln('Список пуст.');
Exit;
end;
PElem := aList.PFirst;
while PElem <> nil do begin
if PElem <> aList.PFirst then Write(', ');
Write(PElem^.Data);
PElem := PElem^.PNext;
end;
Writeln;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
{Начальная инициализация списков.}
Init(L1);
Init(L2);
repeat
{Создание списка.}
{
Writeln('Создание списка.');
Writeln('Прекратить ввод - пустая строка + Enter.');
i := 0;
repeat
Write('Элемент ', i + 1, ': ');
Readln(S);
if S <> '' then begin
Val(S, Data, Code);
if Code = 0 then begin
Inc(i);
Add(L, Data);
end else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Составлен список:');
LWriteln(L);
}
{Создание неупорядоченного списка.}
for i := 1 to M do Add(L1, Random(M + 5));
Writeln('Составлен неупорядоченный список:');
LWriteln(L1);
{Создание списка, упорядоченного по неубыванию.}
for i := 1 to M do Add(L2, i);
Writeln('Составлен упорядоченный по неубыванию список:');
LWriteln(L2);
{Решение задачи.
Последовательно берём элементы из неупорядоченного списка (L1), ищем место
вставки в упорядоченном списке и выполняем вставку.}
PElem1 := L1.PFirst;
while PElem1 <> nil do begin
PNext1 := PElem1^.PNext;
{Ищем в упорядоченном списке указатель на элемент PPrev2, после которого
следует вставить очередной элемент из неупорядоченного списка.}
PPrev2 := nil;
PElem2 := L2.PFirst;
while (PElem2 <> nil) and (PElem2^.Data < PElem1^.Data) do begin
PPrev2 := PElem2;
PElem2 := PElem2^.PNext;
end;
{Вставляем элемент в упорядоченный список.}
PElem1^.PNext := PElem2;
if PPrev2 = nil then
L2.PFirst := PElem1
else
PPrev2^.PNext := PElem1;
if PPrev2 = L2.PLast then
L2.PLast := PElem1;
{Переходим к следующему элементу в неупорядоченном списке.}
PElem1 := PNext1;
end;
Init(L1);
{Ответ.}
Writeln('Упорядоченный список после слияния:');
LWriteln(L2);
{Освобождение памяти, занятую под списки.}
Writeln('Память, занятая под списки, освобождена.');
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end;
procedure TForm1.Writeln(s: string);
begin
ListBox1.Items.Append(s);
end;
procedure TForm1.Readln(var s: string);
begin
s:=InputBox('Введи значение','','');
end;
end.
Не проверял.
20.05.2013, 02:50
Консольные программы.
Похожие темы
