Оглавление
1 Задание №1.
1.1 Блок-схема программы.
1.2 Работа программы
2 Задание №2.
2.1 Блок-схема программы
2.2 Работа программы.
3 Задание №3.
3.1 Блок-схема программы
3.2 Работа программы
4 Задание №4.
4.1 Работа программы
5 Задание №5.
5.1 Блок-схема программы
5.2 Работа программы
6 Заключение.
7 Список используемой литературы.
8 Приложения А
9 Приложение Б
10 Приложение В
11 Приложение Г
12 Приложение Д
Подсчитать количество слов последовательности, начинающихся с большой буквы и оканчивающихся цифрой. Напечатать слова, содержащие задаваемую цепочку символов и хотя бы один знак.
Работа программы
Основное тело программы.
Begin
Задаем переменные, которая будет обозначать о наличии введенного текста и признака продолжения работы программы.
Vvod:=False;
Cont:=True;
while Cont do
Begin
Очмщаем экран для удобства ввода и вывода информации.
clrscr;
Выводим меню с номерами команд, которое можно увидеть на рисунке 1.
Рисунок 1 – главное меню первой программы.
menu;
write('Vvedite komandu: ');
Считываем команду в переменную Rem.
readln(Rem);
Распознаем команду и выберем необходимые функции для выполнения в соответствии с введенном знаком.
case Rem of
'0': Cont:=False;
'1': begin
Считываем введенную строку в переменную Txt и присваиваем Vvod значение True, показывая, что текст введен.
writeln('Text:');
readln(Txt);
Vvod:=True;
end;
'2': begin
Если текст не введен то выводится соответствующее сообщение, в противном случае запускается функция вывода слова с максимальным количеством букв, расположенных в алфавитном порядке.
if Not Vvod then
writeln('Ne vveden text')
else
alfslovo(Txt);
end;
'3': begin
Аналогично предыдущему, только запускается функция подсчета количества симметричных слов больше чем два знака.
if Not Vvod then
writeln('Ne vveden text')
else
colsimmslovo(Txt);
end;
'4': begin
Вывод на экран введенной строки, если же она не введены, выводится соответствующее сообщение.
if Not Vvod then
writeln('Ne vveden text')
else
writeln(Txt);
end
else
Если переменная Rem не удовлетворяет предыдущим условиям, то выводится сообщение о том что введена неизвестная команда.
writeln('Neizvestnaya komanda');
end;
Если программа все еще работает, то выводится предупреждающее сообщение о том что после нажатия клавиши ENTER необходимо будет ввести следующую команду.
if Cont then
begin
write('Nagmite ENTER dlya vvoda sleduyuschei komandy... ');
readln;
end
else
clrscr;
end;
end.
Процедура для нахождения слова с максимальным количеством букв, находящихся в алфавитном порядке.
Она получает в качестве параметра строку S и считает в ней слова, в которых латинские буквы расположены по алфавиту и печатает такое слово, в котором максимально количество букв.
procedure alfslovo(S: Stroka250);
var
Если переменная F становится True, то это показывает что найдено новое слово.
F: boolean;
Len: Byte;
I: Byte;
Counter: Byte;
FSlovo, Buf: Slovo;
Index, L: Byte;
MaxCol: Byte;
begin
Len:=Length(S);
Вставляем в конец строки пробел, если его там нет.
if S[Len]<>' ' then
begin
S:=S+' ';
Inc(Len);
end;
F:=False;
MaxCol:=0;
for I:=1 to Len do
if S[I]<>' ' then
begin
Если находим начало нового слова, тогда устанавливаем признак нового слова, запоминаем номер символа начала слова в строке в переменную Index и вводим начальную длину слова в L.
if F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Увеличиваем длину до тех пор, пока не находим пробел.
Inc(L);
end
else
Если i-й символ пробел, то сбрасываем признак слова, копируем слово в переменную Buf и длину строки в нулевую ячейку.
if F=True then
begin
F:=False;
Buf:=Copy1(S, Index, L);
Buf[0]:=char(L);
Следующая процедура проверяет слово. Если буквы расположены в алфавитном порядке, то возвращает True иначе False.
if alforder(Buf, Counter) then
begin
Если в слове больше символов, чем в максимальном, то заносим слово в Fslovo и колличество букв в MaxCol.
if Counter>MaxCol then
begin
FSlovo:=Copy1(S, Index, L);
FSlovo[0]:=char(L);
MaxCol:=Counter;
end;
end;
end;
Если таких слов нет то выводим сообщение об этом, иначе выводим слово.
if MaxCol=0 then
writeln('Net podhodyaschi slov v texte')
else
writeln(FSlovo, ' kol-vo bukv: ', MaxCol);
end;
Функция alforder получает в качестве параметров строку S1, если в строке латинские буквы расположены по алфавиту, то функция вернет True иначе False. Count – количество латинских букв в строке.
function alforder(Sl: Slovo; var Count: Byte): Boolean;
var
I, L: Byte;
F: Boolean;
Buf: Char;
begin
L:=Length(Sl);
Сбрасываем начальное количество букв в строке.
Count:=0;
Находим в цикле количество латинских букв в строке и приводим все заглавные буквы к строчному виду.
for I:=1 to L do
begin
if (isletter(Sl[I])) then
Inc(Count);
if (Sl[I]>='A') and (Sl[I]<='Z') then
Sl[I]:=char(byte(Sl[I])+32);
end;
if Count=0 then
alforder:=False
else
if Count=1 then
alforder:=True
else
begin
F:=True;
Перемещаем все буквы строки в начало строки.
While F do
begin
F:=False;
for I:=1 to L-1 do
Если i-й символ не буква, а его сосед справа – буква, то меняем эти символы местами.
if (Not isletter(Sl[I])) And (isletter(Sl[I+1])) then
begin
F:=True;
Buf:=Sl[I];
Sl[I]:=Sl[I+1];
Sl[I+1]:=Buf;
end;
end;
F:=true;
Далее проверяем расположения букв по алфавиту.
for I:=1 to Count-1 do
if Sl[I]>Sl[I+1] then
begin
F:=False;
break;
end;
alforder:=F;
end;
end;
Процедура colsimmsolvo получает в качестве параметра строку S, и считает в ней симметричные слова, выводит их на экран и выводит количество найденных симметричных слов.
procedure colsimmslovo(S: Stroka250);
var
F: boolean;
Len: Byte;
I: Byte;
Counter: Byte;
Buf: Slovo;
Index, L: Byte;
MaxCol: Byte;
begin
Len:=Length(S);
Заносим в конец строки пробел, если его там нет.
if S[Len]<>' ' then
begin
S:=S+' ';
Inc(Len);
end;
За F обозначаем флаг нахождения слова, F=true –найдено новое слово. И сбрасываем начальное значение количества симметричных слов.
F:=False;
Counter:=0;
writeln('Spisok simmetrichnyh slov iz bolshe chem 2 znaka:');
Начинаем поиск симметричных слов в строке.
for I:=1 to Len do
В случае, если i-й символ не пробел, устанавливаем флаг нового слова, запоминаем начало нового слова, и сбрасываем начальное значение длинны.
if S[I]<>' ' then
begin
if F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Inc(L);
end
else
Иначе, если установлен признак нового слова, то сбрасываем его. Если длинна слова больше двух символов, то копируем слово в буффер.
if F=True then
begin
F:=False;
if L>2 then
begin
Buf:=Copy(S, Index, L); {kopiruem slovo v Buf}
Buf[0]:=char(L);
Далее функцией проверяем слово на симметрию, и если оно симметрично, то увеличиваем счетчик на единицу, и выводим это слово на экран.
if simmetr(Buf) then
begin
Inc(Counter);
writeln(Buf);
end;
end;
end;
writeln('Kol-vo naidennyh slov: ', Counter);
end;
Процедура проверки словва на симметричность.
function simmetr(S: Slovo):boolean;
var
L, I, R: Byte;
F: Boolean;
Begin
Начинаем проверять симметричные относительно центра символы. Если они совпадают, то функции присваивается True. Если хоть один символ не сходится, то программа выходит из цикла и функции присваивается значение False.
L:=Length(S);
R:=L div 2;
F:=True;
for I:=1 to R do
if S[I]<>S[L-I+1] then
begin
F:=False;
break;
end;
simmetr:=F;
end;
Символьный квадратный массив заполнен случайным набором символов. Определить количество цепочек, расположенных по вертикали и/или горизонтали и состоящих только из латинских букв.
Вначале задаем 2 типа: самой матрицы и буффера.
type
Matrix=array[1..20,1..20] of Integer;
type
Vector=array[1..80] of Integer;
Begin
Делаем очистку экрана для удобного ввода и вывода информации и делаем запрос на ввод размера массива, согласно положению.
clrscr;
Повторяем ввод до тех пор, пока не будет введено число от 12 до 22.
repeat
write('Razmer matricy (12..20): ');
readln(N);
until (N>=12) and (N<=20);
Используем процедуру для формирования матрицы Matr размером N на N ячеек. Затем выводим ее на экран.
FormMatrix(Matr, N, N);
writeln('Sformirovana matrica:');
PrintMatrix(Matr, N, N);
Используем процедуру поворота матрицы и выводим матрицу на экран.
TurnMatrix(Matr, N);
writeln('Matrica posle povorota');
PrintMatrix(Matr, N, N);
readln;
end.
Процедура FormMatrix
Данная процедура присваивает значения от -99 до 99 элементам матрицы.
procedure FormMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
D: Integer;
R: Integer;
begin
randomize;
for I:=1 to N do
for J:=1 to M do
begin
Присваиваем элементу любое значение от 0 до 99.
A[I,J]:=random(100);
Если случайное число от 0 до 999 четное, данный элемент становится отрицательным, иначе знак не изменяется.
if (random(1000) mod 2)=0 then
A[I,J]:=0-A[I,J];
end;
end;
Процедура вывода матрицы на экран.
procedure PrintMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
Begin
Задаем два цикла, один для столбцов, второй для строк и поочередно выводим все элементы строки. После чего выводим следующую строку.
for I:=1 to N do
begin
for J:=1 to M do
write(A[I,J]:4);
writeln;
end;