1. ЛАБОРАТОРНА РОБОТА З ПРОГРАМУВАННЯ УЧНІ 10д КЛАСУ ШКОЛИ N57
Ахманова СЕРГІЯ ПО ТЕМІ "сортування".
2. ПОСТАНОВКА ЗАВДАННЯ.
Дан файл, що містить числа типу longint, розташовані в довільному порядку. Потрібно розташувати ці числа за зростанням, використовуючи не більше 40 кілобайт оперативної пам'яті і дискового простору не більш ніж у два рази більше вихідного файлу.
3. АЛГОРИТМ (метод рішення).
Спочатку вихідний файл розбивається на шматки по 10000 чисел, кожен шматок сортується в пам'яті і записується в один з двох тимчасових файлів, причому так, що кількість шматків в цих файлах відрізняється не більше ніж на 1 (далі - первісна сортування).
Потім, кілька разів виконується операція "склеювання" (одне виконання операції "склеювання" ми будемо незивать "крок"), тобто два вихідних файлу, в яких знаходилися відсортовані шматки копіюються в два інших файлу, при цьому з двох шматків, що знаходяться в різних файлах і мають однакові номери створюється один відсортований шматок. Цей шматок записується в перший вихідний файл якщо вихідні шматки мали непарні номери і в другій, якщо вихідні шматки мали парні номери.
4. ВНУТРІШНЯ СПЕЦИФИКАЦИЯ ПРОГРАМИ.
При написанні програми використовувалася середу Borland Pascal 7.0 і вбудований компілятор.
Для прискореного обміну з диском застосовувався блоковий введення-виведення, тобто інформація читається і записується цілими кластерами. Для здійснення цього способу введення-виведення був написаний модуль (Files), за допомогою якого ввід-висновок зовні не відрізняється від звичайного.
Схема програми гранично проста: спочатку виконується первоначльная сортування (процедура firstsort), потім викликаємо склеювання (процедура ftrans (in1, in2, out1, out2: workfile);), де пари файлів весь час змінюються і після кожного запуску процедури перевіряється умова виходу. < br /> Процедура ftrans відкриває всі файли, потім виконує кілька разів процедуру зливу одного шматка (onestep) і закриває файли.
5. Комментировать ТЕКСТ ПРОГРАМИ.
Модуль Files.
Сдесь переписані всі процедури і функції необхідні для роботи з файлами, які працюють з блоками. Робота з ними здійснюється також як і зі звичайними процедурами модуля System.
unit Files;
interface
const typesize = 4;
const bufsize = 2048;
type using = longint;
type buffer = array [1 .. bufsize] of using;
type pbuffer = ^ buffer;
type filemode = (fread, fwrite, closed);
type tfile = record
buf: pbuffer;
mode: filemode;
f: file;
count, leng: integer;
end;
procedure fAssign (var w: tfile; name: string);
procedure fReWrite (var w: tfile);
procedure fReset (var w: tfile);
procedure fPut (var w: tfile; d: using);
procedure fGet (var w: tfile; var d: using);
procedure fClose (var w: tfile);
function fEof (var w: tfile): boolean;
implementation
procedure fAssign (var w: tfile; name: string);
begin
Assign (w.f, name); w.mode: = closed;
end;
procedure fReWrite (var w: tfile); begin
if w.mode = closed then
begin
ReWrite (wf, typesize); new (w.buf); w.count: = 0; w.leng: = 0; w.mode: = fwrite;
end;
end;
procedure fReset (var w: tfile); begin
if w.mode = closed then
begin
Reset (w.f, typesize); new (w.buf);
BlockRead (wf, w.buf ^, bufsize, w.leng); w.count: = 1;
w.mode: = fread;
end;
end;
procedure fPut (var w: tfile; d: using);
begin
if w.mode = fwrite then
begin
w.count: = w.count 1;
w.buf ^ [w.count]: = d;
if w.count = bufsize then
begin
BlockWrite (wf, w.buf ^, w.count); w.count: = 0;
end;
end;
end;
procedure fGet (var w: tfile; var d: using); begin
if (w.mode = fread) then
begin
d: = w.buf ^ [w.count];
if w.leng = w.count then
begin
BlockRead (wf, w.buf ^, bufsize, w.leng); w.count: = 1;
end else w.count: = w.count 1;
end;
end;
procedure fClose (var w: tfile);
begin
if w.mode = fwrite then BlockWrite (wf, w.buf ^, w.count); dispose (w.buf);
w.mode: = closed;
 Close (w.f); end;
function fEof (var w: tfile): boolean;
begin
if (w.mode = fread) and (w.leng = 0) then fEof: = true
else fEof: = false;
end;
begin
end.
кінець files.pas
-------------------------------------------------- --------------------------
Файл sort.pas - сортування в пам'яті.
var k: integer;
function SwapTops (no: integer): integer;
var t: longint;
begin
if (memo ^ [2 * no 1]> memo ^ [2 * no]) then
begin
t: = memo ^ [no];
memo ^ [no]: = memo ^ [2 * no 1];
memo ^ [2 * no 1]: = t;
 SwapTops: = 2 * no 1; end else begin
t: = memo ^ [no];
memo ^ [no]: = memo ^ [2 * no];
memo ^ [2 * no]: = t;
 SwapTops: = 2 * no; end;
end;
procedure SwapHalf (no: integer);
var t: longint;
begin
if memo ^ [no]
begin
t: = memo ^ [no];
memo ^ [no]: = memo ^ [2 * no];
memo ^ [2 * no]: = t;
end;
end;
function Reg (no: integer): boolean;
begin
if (2 * no)> k then Reg: = true else
if (2 * no +1)> k then
begin
SwapHalf (no);
 Reg: = true; end else
if (memo ^ [2 * no]