Программа
PROGRAM Checker;
USES CRT; { Подключение модуля CRT }
TYPE List=^Slovo; { Ссылка на список слов }
Slovo=record { Слово }
S:string; { Поле слова }
Quantity:integer; { Встречаемость слова в тексте }
Next:List { Ссылка на следующее слово }
end;
VAR Txt:List; { Ссылка на список слов }
PROCEDURE DisposerList(var L:List); { Процедура удаления списка }
Begin
if L<>nil then begin { Если переменная существует, то }
DisposerList(L^.NEXT); { удаление хвоста списка }
Dispose(L); { удаление переменной }
L:=nil { Переопределение ссылки }
end
End;
FUNCTION UpCase(Ch:char):char; { Функция преобразования строчных букв в прописные }
Begin
if Ch in ['а'..'п']
then UpCase:=Chr(Ord(Ch)-32) { Преобразование первой половины строчных букв }
else if Ch in ['р'..'я']
then UpCase:=Chr(Ord(Ch)-80) { Преобразование второй половины строчных букв }
else if Ch='ё'
then UpCase:='Ё' { Преобразование "ё" }
else UpCase:=Ch
End;
FUNCTION UpCaseStr(S:string):string;
{ Функция перевода строчных букв в строке в прописные }
Var i:integer; { Счетчик цикла }
Begin
for i:=1 to Length(S) do S[i]:=UpCase(S[i]); { Цикл преобразования букв }
UpCaseStr:=S { Определение значения функции }
End;
FUNCTION GetQuantity(Slovo:string;CharFlag:boolean):integer;
{ Функция подсчета гласных или согласных в слове }
Var Meter:integer; { Счетчик гласных или согласных }
i:integer; { Счетчик цикла }
Begin
Meter:=0; { Сброс счетчика букв }
for i:=1 to Length(Slovo) do { Цикл просмотра слова }
{ Определение принадлежности буквы гласным или согласным: }
if CharFlag
then if UpCase(Slovo[i]) in ['А','Е','Ё','И','Й','О','У','Ы','Э','Ю','Я']
then Meter:=Meter+1 { Набор количества гласных }
else
else if UpCase(Slovo[i]) in ['Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С','Т','Ф','Х','Ц','Ч','Ш','Щ']
then Meter:=Meter+1 { Набор количества согласных }
else;
GetQuantity:=Meter { Определение значения функции }
End;
PROCEDURE SortList(var P:List; SortFlag:boolean);
{ Процедура сортировки списка }
Function SecondElementIsMin(First,Second:string;SortFlag:boolean):boolean;
{ Функция определения минимального элемента }
begin
SecondElementIsMin:=GetQuantity(Second,SortFlag)<GetQuantity(First,SortFlag)
end;
Var Ref, { Ссылка }
RefPred, { Ссылка на предыдущий элемент }
RefMin, { Ссылка на минимальный элемент }
RefPredMin { Ссылка на элемент предыдущий минимальному }
:List;
Begin
if P<>nil then { Если очередь не пустая, то - сортировка очереди }
begin
{ Начальное определение ссылок: }
RefMin:=P;
RefPredMin:=nil;
Ref:=RefMin;
while Ref^.Next<>nil do { Цикл просмотра очереди }
begin
RefPred:=Ref; { Переопределение ссылки на предыдущий элемент }
Ref:=Ref^.Next; { Переопределение ссылки на текщий элемент }
{ Сравнивание минимального элемента с текущим: }
if SecondElementIsMin(RefMin^.S,Ref^.S,SortFlag)
then begin { Переопределение ссылок минимального элемента: }
RefMin:=Ref;
RefPredMin:=RefPred
end
end;
if RefPredMin<>nil then
begin { Если минимальный элемент не первый, то - перестановка }
RefPredMin^.Next:=RefMin^.Next; { минимального элемента }
RefMin^.Next:=P; { в начало очереди }
P:=RefMin
end;
SortList(P^.Next,SortFlag) { Сортировка хвоста очереди }
end
End;
PROCEDURE ReadWord(var F:text; var Slovo:string); { Процедура чтения слова }
Var Ch:char; { Переменная для чтения символа }
Begin
Slovo:=''; { Сброс переменной }
Ch:='.'; { Определение буферной переменной для входа в цикл }
while not EOLn(F) and (Ch<>' ')do { Цикл чтения слова }
begin
Read(F,Ch); { Чтение символа }
if Ch<>' ' then Slovo:=Slovo+Ch
{ Если данный символ не пробел, то набор слова }
end;
if EOLn(F) then ReadLn(F) { Пропуск конца строки }
End;
PROCEDURE InsertWord(var Txt:list; Buf:string); { Процедура вставки слова в список }
Var BufRef:List; { Вспомогательная ссылка для прохождения
по списку и организации новой переменной }
Begin
BufRef:=Txt; { Начальная установка вспомогательной ссылки }
while BufRef<>nil do { Цикл просмотра списка }
begin
if UpCaseStr(BufRef^.S)=UpCaseStr(Buf) then
begin { При обнаружении слова равного вставляемому: }
Inc(BufRef^.Quantity); { Переопределение встречаемости слова }
Break { Прерывание цикла }
end;
{ Прерывание цикла при обнаружении слова равного вставляемому }
BufRef:=BufRef^.Next { Переопределение ссылки на следующий элемент списка }
end;
if BufRef=nil then { Вставка нового словаб если был достигнут конец списка }
begin
New(BufRef); { Организация новой переменной }
BufRef^.S:=Buf; { Копирование слова в переменную }
BufRef^.Quantity:=1; { Начальное определение встречаемости слова }
BufRef^.Next:=Txt; { Присоединение очереди к новой переменной }
Txt:=BufRef { Переопределение ссылки на очередь }
end
End;
PROCEDURE InputList(var Txt:List; var F:text); { Процедура ввода списка }
Var Buf:string; { Буферная переменная для чтения слов }
Begin
while not EOF(F) do { Цикл просмотра файла }
begin
ReadWord(F,Buf); { Чтение слова }
if Buf<>'' then InsertWord(Txt,Buf) {
Если получена непустая строка, то вставка слова в список }
end
End;
PROCEDURE OutputList(Txt:List); { Процедура вывода списка }
Var MeterChar:integer;
{ Переменная для подсчета количества выведенных символов в строке }
Begin
MeterChar:=0; { Сброс счетчика символов }
while Txt<>nil do { Цикл вывода списка }
begin
MeterChar:=MeterChar+Length(Txt^.S)+5;
{ Набор количества выведенных в строку символов }
if MeterChar>=80 then { Если количество символов превышает 80, то }
begin
WriteLn; { пропуск строки }
MeterChar:=Length(Txt^.S)+5;
{ Переопределение количества выведенных в строку символов }
end;
Write(Txt^.S,'(',Txt^.Quantity,') '); { Вывод слова }
Txt:=Txt^.Next { Переопределение ссылки }
end;
WriteLn { Пропуск строки }
End;
PROCEDURE OutputListWithQuantity(Txt:List;SortFlag:boolean);
{ Процедура вывода списка с указанием количества гласных или согласных }
Var MeterChar:integer;
{ Переменная для подсчета количества выведенных символов в строке }
Begin
MeterChar:=0; { Сброс счетчика символов }
while Txt<>nil do { Цикл вывода списка }
begin
MeterChar:=MeterChar+Length(Txt^.S)+5;
{ Набор количества выведенных в строку символов }
if MeterChar>=80 then { Если количество символов превышает 80, то }
begin
WriteLn; { пропуск строки }
MeterChar:=Length(Txt^.S)+5;
{ Переопределение количества выведенных в строку символов }
end;
Write(Txt^.S,'(',GetQuantity(Txt^.S,SortFlag),') '); { Вывод слова }
Txt:=Txt^.Next { Переопределение ссылки }
end;
WriteLn { Пропуск строки }
End;
VAR F:text; { Файловая переменная }
SortFlag:boolean; { Флаг - признак сортировки }
BEGIN
ClrScr; { Очистка экрана }
Assign(F,'TEXT.TXT'); { Связывание файла с файловой переменной }
Reset(F); { Открытие файла для чтения }
InputList(Txt,F); { Ввод списка }
Close(F); { Закрытие файла }
WriteLn('ИСХОДНЫЙ СПИСОК СЛОВ:'); { Вывод заголовка }
OutputList(Txt); { Вывод списка слов }
WriteLn('ВВЕДИТЕ ПРИЗНАК СОРТИРОВКИ: (1) - гласные, (2) - согласные ');
{ Вывод приглашения }
SortFlag:=ReadKey='1'; { Чтение клавиатуры и определение признака сортировки }
if SortFlag then WriteLn('Сортировка по гласным:') { Вывод заголовка }
else WriteLn('Сортировка по согласным:');
SortList(Txt,SortFlag); { Сортировка списка }
OutputListWithQuantity(Txt,SortFlag);
{ Вывод списка с указанием количества гласных или согласных }
DisposerList(Txt) { Уничтожение списка }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию