1. Выравнивание текста.
Задача:
Дан текст в файле в виде строки. Требуется отформатировать текст:
1. выравнивание по ширине;
2. выравнивание по центру;
3. выравнивание по левому краю;
4. выравнивание по правому краю;
и вывести текст в файл в виде нескольких строк (ширина строк после форматирования не должна превышать W символов). Выравнивание текста производится путем вставки пробелов. Слова переносятся на следующую строку только целиком. Слово – последовательность символов, не содержащая пробелов.
Исходный текст содержится в файле в виде строки, его требуется отформатировать и вывести в несколько строк.
Рассмотрим процедуру Solve:
procedure SOLVE;
begin
while READS do
begin
FORMATING(W);
PRINT;
end;
PRINT;
end;
Данная процедура обращается к функции READS, которая записывает в строку S (глобальная переменная) текст из файла блоками длиной по W (глобальная переменная) символов. Далее процедура FORMATING производит форматирование строки, которая затем выводится процедурой PRINT. Этот процесс повторяется до тех пор, пока функция READS возвращает значения ИСТИНА – не конец файла. В завершении выводится остаток исходного текста без форматирования.
function READS: boolean;
var c: char;
begin
delete(s,1,w);
while (length(s)>0)and(s[1]=' ') do
delete(s,1,1);
while (not eoln) and (length(s)<=w) do
begin
read(c);
s:=s+c;
end;
if eoln then reads:=false
else reads:=true;
end;
Функция READS удаляет первые W символов из строки, если данная функция вызывается не первый раз, и удаляет все пробелы, находящиеся в начале строки. Затем, как уже было сказано, строка S дополняется до W символов. В случае, если достигнут конец строки файла, функция принимает значение ЛОЖЬ, чтобы вывести остаток исходного текста без форматирования.
Следует отметить, так как мы работаем с текстовым режимом отображения информации, то весь анализ проводится на основе анализа символьного содержания текста без использования дополнительной (мета) информации.
1.1 Выравнивание текста по ширине.
procedure FORMATING;
var i,j,k:integer;
begin
j:=length(s);
while (j>0) and (s[j]<>' ') do
dec(j);
dec(j);
k:=0;
while j<>k do
begin
i:=1;
k:=j;
while (i
if s[i]=' ' then
begin
insert(' ',s,i);
while (i
end;
inc(i);
end;
end;
end;
Логика данной процедуры довольно проста:
1. Необходимо найти позицию, с которой начинается слово, не умещающееся в строке.
2. Находим в интервале от 1 до найденного выше значения промежуток между словами и добавляем один пробел.
3. Шаг (2) повторяется до тех пор, пока последнее слово в строке не выйдет за границу W. Это слово будет перенесено в следующую строку.
1.2 Выравнивание текста по центру.
procedure FORMATING (t:integer);
var i,j:integer;
begin
if (t=w) then inc(t);
j:=t;
while (j>0) and (s[j]<>' ') do
dec(j);
dec(j);
if (j<=0) then j:=t;
for i:=1 to (w-j)div 2 do
insert(' ',s,1);
inc(j,i);
for i:=j+1 to w do
insert(' ',s,j+1);
end;
Процедура ищет начало слова, которое не вмещается в строку. Вся предыдущая часть строки дополняется одинаковым количеством пробелов с начала и с конца, таким образом, получается текст, выровненный по центру.
1.3 Выравнивание текста по левому краю.
procedure FORMATING (t:integer);
var i,j:integer;
begin
if (t=w) then inc(t);
j:=t;
while (j>0) and (s[j]<>' ') do
dec(j);
dec(j) ;
if (j<=0) then j:=t;
for i:=1 to (w-j) do
insert(' ',s,j+1);
end;
Процедура ищет начало слова, которое не вмещается в строку. Перед этим словом добавляются пробелы так, что получается текст, выровненный по левому краю. Последнее слово будет перенесено в следующую строку.
1.4 Выравнивание текста по правому краю.
procedure FORMATING (t:integer);
var i,j:integer;
begin
if (t=w) then inc(t);
j:=t;
while (j>0) and (s[j]<>' ') do
dec(j);
dec(j);
if (j<=0) then j:=t;
for i:=1 to (w-j) do
insert(' ',s,1);
end;
Процедура ищет начало слова, которое не вмещается в строку. В начало строки добавляются пробелы так, что получается текст, выровненный по правому краю. Последнее слово будет перенесено в следующую строку.
2. Формирование содержания
Задача:
Дан текст в файле в виде строк. Текст содержит заголовки разделов, глав, параграфов. Требуется составить содержание по этим заголовкам, имеющим следующий вид:
• «$X Заголовок» - заголовок первого уровня;
• «$X.X Заголовок» - заголовок второго уровня;
• и т.д.
Перед символом “$” не должно быть никаких символов, кроме пробелов.
Рассмотрим процесс создания содержания. Предполагается, что содержание формируется из заголовков, имеющих вид:
Для хранения элементов содержания используется комбинированный тип – RECORD, содержащий заголовок, номер страницы и ссылку на следующий пункт содержания. Также используется ссылочный тип на выше указанный.
type tpnt = ^trec;
trec = record
header:string;
page:integer;
next:tpnt;
end;
Процедура SOLVE выглядит следующим образом
procedure SOLVE;
var i,num,num_line:integer;
s:string;
begin
num_line:=0;
while not eof do
begin
readln(s);
inc(num_line);
num:=pos('$',s);
i:=1;
while (i
if i=num then ADD (s,num_line);
end;
item.next:=nil;
end;
Поясним работу процедуры SOLVE: из файла читается строка; проверяется наличие в строке символа “$” – признак заголовка; проверяется начало строки на наличие “посторонних” символов; если строка является заголовком, то процедурой ADD формируется очередной элемент содержания.
procedure ADD (s:string;lin:integer);
var page:integer;
begin
new(item.next^.next);
item.next:=item.next^.next;
page:=lin div lpp; {lpp – определяет количество строк на странице - константа}
if lin mod lpp>0 then inc(page);
item.next^.header:=s;
item.next^.page:=page;
end;
Теперь осталось реализовать вывод содержания в отформатированном виде – все элементы содержания, соответствующие заголовкам одного уровня, имеют одинаковый отступ слева. Это выполняет процедура PRINT.
procedure PRINT;
var s,p:string;
len,i:integer;
begin
writeln('Содержание:');
item.next:=first^.next;
while item.next<>nil do
begin
item:=item.next^;
s:=item.header;
str(item.page,p);
while s[1]=' ' do delete(s,1,1);
i:=3;
while s[i]<>' ' do
begin
if s[i]='.' then
begin
insert(' ',s,1);
inc(i,2);
end;
inc(i);
end;
len:=length(s)+1;
s:=s+p;
while length(s)
end;
end;
3. Взаимное преобразование нумерованных и маркированных списков.
Задача:
Дан текст в файле в виде строк. Текст содержит нумерованные/маркированные списки. Требуется преобразовать все нумерованные (маркированные) списки в маркированные (нумерованные) и записать новый текст в файл. Элемент маркированного списка имеет вид “* ТЕКСТ “, элемент нумерованного списка имеет вид “X) ТЕКСТ “. Элемент списка может занимать более одной строки. Все элементы одного нумерованного/маркированного списка начинаются с новой строки и имеют одинаковый отступ слева.
Разберем процедуру преобразования нумерованного списка в маркированный.
procedure SOLVE;
var p:integer;
begin
uk:=1;
while not eof do
begin
readln(s);
if (uk>1) then SRCHNEXT (p);
SRCHFRST (p);
writeln(s);
end;
end;
Каждая строка проверяется на наличие признака нумерованного списка. Процедура SRCHFRST ищет первый элемент списка и возвращает параметр форматирования этой строки. Процедура SRCHNEXT ищет следующие элементы нумерованного списка с данным параметром форматирования. Обе эти процедуры при положительном результате заменяют номер элемента списка на маркер.
procedure SRCHFRST (var p:integer);
var mkr:string;
pp,i:integer;
begin
str(1,mkr);
mkr:=mkr+')';
pp:=pos(mkr,s);
if pp>1 then
begin
i:=pp-1;
while s[i]=' ' do dec(i);
if i>0 then pp:=0;
end;
if pp <> 0 then
begin
p:=pp;
delete(s,p,Length(mkr));
insert('*',s,p);
uk:=2;
end;
end;
procedure SRCHNEXT (p:integer);
var mkr:string;
pp,i:integer;
begin
str(uk,mkr);
mkr:=mkr+')';
pp:=pos(mkr,s);
if pp>1 then
begin
i:=pp-1;
while s[i]=' ' do dec(i);
if i>0 then pp:=0;
end;
if pp=p then
begin
delete(s,p,Length(mkr));
insert('*',s,p);
inc(uk);
end;
end;
Процедуры обратного преобразования списков подобны выше описанным. Разница лишь в том, что эти процедуры ищут признаки маркированного списка и производят вставку нумерации элементов списка.
4. Перенос слов по слогам.
Задача:
Дан текст в файле в виде строки. Требуется выполнить разбиение всего текста на строки с расстановкой переносов в словах так, чтобы длина каждой строки не превышала W символов. Расстановку переносов в словах следует выполнять по следующему правилу: перенос ставится между сочетаниями букв “гг”, “гс”, “сс” и “зс”, где “г” – гласная буква, “с” – согласная буква, “з” – все остальные символы. Слово должно содержать не менее одной гласной буквы до и после переноса. Слово – последовательность символов, не содержащая пробелов.
procedure SOLVE;
var s,wd:string;
p,pp:integer;
begin
readln(s);
while length(s)>w do
begin
GETWORD (s,wd,p);
if (wd='') then pp:=0
else INSRMV (wd,w-p,pp);
wd:=copy(s,1,p+pp);
if (pp>0) then wd:=wd+'-';
writeln(wd);
delete(s,1,p+pp);
end;
writeln(s);
end;
Задача состоит в том, чтобы вывести строку S в файл в несколько строк по указанной ширине с переносом слов. Процедура GETWORD возвращает слово, которое находится в конце и должно быть перенесено, и позицию, с которой начинается слово. Процедура INSRMV вставляет в слово перенос не далее, чем в указанной позиции. Затем в файл выводится очередная строка.
procedure GETWORD (s:string;var wd:string;var p:integer);
var j:integer;
begin
wd:='';
p:=w;
while s[p]<>' ' do dec(p);
j:=w;
while s[j]<>' ' do inc(j);
if j=w+1 then p:=j
else wd:=copy(s,p+1,j-p-1);
end;
function TIP (c:char):byte;
begin
if c in gl then tip:=0
else if c in sgl then tip:=1
else tip:=2;
end;
procedure INSRMV (wd:string;p:integer;var pp:integer);
var len,af,bf,t,i,pair:integer;
begin
len:=length(wd);
if tip(wd[len])=2 then dec(len);
pp:=0;
while len-p<1 do dec(p);
if (len>=4)and(p>=2) then
begin
bf:=0;
for i:=p downto 1 do
if (wd[i] in gl) then inc(bf);
af:=0;
for i:=p+1 to len do
if (wd[i] in gl) then inc(af);
if (af+bf>1)and(bf>0) then
begin
i:=p-1;
pair:=tip(wd[p]);
repeat
pair:=(pair * 10)mod 100;
t:=tip(wd[i]);
if (pair div 10=0)then
begin
inc(af);
dec(bf);
end;
pair:=pair + t;
if (pair in [0,10,11,12])and(af*bf>0)then pp:=i;
dec(i);
until (i<2)or(pp<>0);
end;
end
else pp:=-p+1;
end;
Для определения типа символа (гласная/согласная буква или прочие символы) используется функция TIP путем проверки принадлежности символа множествам (множество гласных букв / множество согласных букв), которые инициализируются перед вызовом процедуры SOLVE.
5. Замена текста.
Задача:
Дан текст в файле в виде строк, выровненный по ширине/по центру/по левому краю/по правому краю. Требуется выполнить поиск и замену всех вхождений строки S1 строкой S2 в тексте без нарушения выравнивания текста.
При замене текста возможно нарушение форматирования текста. Для сохранения вида выравнивания текста, рассмотрим процедуру определения параметров форматирования текста при условии, что весь текст имеет одинаковые параметры форматирования.
procedure REPLACE;
var i,j:integer;
begin
llen:=length(s1);
i:=1;
while i<=len-llen do
begin
j:=0;
while (j
begin
delete(s,i,llen);
insert(s2,s,i);
len:=len-llen+length(s2);
inc(i,length(s2));
end;
inc(i);
end;
end;
Процедура REPLACE заменяет текст в глобальной переменной S. S1 – текст, который будет заменен; S2 – текст, на который заменяется искомый текст.
procedure SOLVE;
var j,i,n,m:integer;
begin
len:=0;
while reads do begin
replace;
case typ of
0:format_c(w);
1:format_l(w);
2:format_r(w);
3:format_j(w);
end;
out;
end;
replace;
case typ of
0:format_c(len);
1:format_l(len);
2:format_r(len);
3:format_l(len);
end;
out;
end;
Пока конец файла не достигнут, процедура SOLVE читает из файла строку (процедура READS), производит поиск и замену текста с помощью процедуры REPLACE и форматирует текст согласно с начальными параметрами форматирования текста.
Теперь рассмотрим процедуру определения параметров форматирования текста. Принцип работы процедуры основан на статистическом анализе, что позволяет достаточно точно определить параметры первоначального отображения текста.
lc:=0;
rc:=0;
wc:=0;
fillchar(wp,sizeof(wp),0);
fillchar(lp,sizeof(lp),0);
fillchar(rp,sizeof(rp),0);
while (not eof) do
begin
readln(s);
len:=length(s);
fld:=len;
i:=1;
while (i<=wc)and(fld<>wp[i].val) do inc(i);
if i>wc then wc:=i;
wp[i].val:=fld;
inc(wp[i].num);
i:=1;
while (i<=len) and (s[i]=' ') do inc(i);
if i<=len then
begin
fld:=i;
i:=1;
while (i<=lc)and(fld<>lp[i].val) do inc(i);
if i>lc then lc:=i;
lp[i].val:=fld;
inc(lp[i].num);
i:=len;
while (i>0) and (s[i]=' ') do dec(i);
fld:=i;
i:=1;
while (i<=rc)and(fld<>rp[i].val) do inc(i);
if i>rc then rc:=i;
rp[i].val:=fld;
inc(rp[i].num);
end;
end;
Данный фрагмент программы реализует “сбор сведений” о форматировании текста. Переменные lp, rp, wp имеют тип record содержат поля val и num, где val – значение параметра, num – количество объектов с данным значением, lp содержит информацию об отступах слева, rp содержит информацию об отступах справа, wp содержит информацию о ширине строк. Переменные lc, rc и wc определяют количество различных значений для соответствующих параметров. Теперь необходимо провести анализ данных и определить тип форматирования текста после замены.
typ:=0;
max:=0;
imax:=0;
cnt:=0;
if lc<=2 then
begin
typ:=typ+1;
if lc=1 then sh:=0;
else sh:=lp[1].val;
end;
for i:=1 to rc do
begin
inc(cnt,r[i].num);
if max
max:=rp[i].val;
imax:=i;
end;
w:=max;
if (rp[ind].num*2>=fld) then typ:=typ+2;
Переменная w содержит значение ширины текста, sh задает отступ красной строки. Значение переменной typ определяет выравнивание текста:
Значение typ 0 1 2 3
Выравнивание По центру По левому краю По правому краю По ширине
6. Статистика документа.
Задача:
Дан текст в файле в виде строк. Требуется подсчитать количество страниц, строк, слов, знаков (без пробелов), знаков (с пробелами) в тексте. Слово – последовательность символов, не содержащая пробелов.
procedure SOLVE;
begin
pge:=0;
wrd:=0;
sim:=0;
sps:=0;
lin:=-1;
while not eof do
begin
readln(s);
sp:=pos(' ',s);
inc(lin);
s:=s+' ';
while (length(s)>0) do
begin
sp:=pos(' ',s);
inc(sps);
if sp>1 then inc(wrd);
inc(sim,sp-1);
delete(s,1,sp);
end;
dec(sps);
end;
pge:=lin div lpp + 1;
inc(lin);
end;
7. Преобразование кодировки текста.
Задача:
Дан текст в файле. Требуется выполнить преобразование текста из кодировки ASCII (DOS) в кодировку ANSI (WINDOWS) и обратно.
Преобразование кодировки текста из DOS в WINDOWS и обратно происходит путем замены кодов символов одной кодировки кодами соответствующих символов другой кодировки.
Преобразование текста из DOS в WINDOWS:
procedure SOLVE;
var i:integer;
s:string;
begin
while not eof do
begin
readln(s);
for i:=1 to length(s) do
if s[i] in [#128..#175] then
s[i]:=chr(ord(s[i])+64)
else
if s[i] in [#224..#239] then
s[i]:=chr(ord(s[i])+16);
writeln(s);
end;
end;
Преобразование текста из WINDOWS в DOS:
procedure SOLVE;
var i:integer;
s:string;
begin
while not eof do
begin
readln(s);
for i:=1 to length(s) do
if s[i] in [#192..#239] then
s[i]:=chr(ord(s[i])-64)
else
if s[i] in [#240..#255] then
s[i]:=chr(ord(s[i])-16);
writeln(s);
end;
end;
