Подготовка ребенка* к ЕГЭ по информатике. Часть вторая

 Заполнение двумерного массива «змейкой»:
 
program filling_of_the_array_using_snake;
const
N=10;
M=10;
var
a:array[1..N, 1..M]of integer;
FirstArrayIndex, SecondArrayIndex, meaning:integer;
begin
meaning:=1;
for FirstArrayIndex := 1 to N do
begin
if FirstArrayIndex mod 2 = 1 then
begin
for SecondArrayIndex := 1 to M do
begin
a[FirstArrayIndex, SecondArrayIndex] := meaning;
meaning := meaning + 1;
end;
end
else
for SecondArrayIndex := M downto 1 do
begin
begin
a[FirstArrayIndex, SecondArrayIndex] := meaning;
meaning := meaning + 1;
end;
end;
end;
for FirstArrayIndex := 1 to N do
begin
for SecondArrayIndex := 1 to M do
write(a[FirstArrayIndex,SecondArrayIndex]:4);
writeln;
end;
end.
 

Заполнение двумерного массива «по спирали»:
 
program filling_of_the_array_using_spiral;
const
N=10;
M=10;
var
a:array[1..N, 1..M]of integer;
FirstArrayIndex, SecondArrayIndex, meaning:integer;
begin
meaning:=1;
for FirstArrayIndex:=1 to N div 2 do
begin
for SecondArrayIndex := FirstArrayIndex to M-FirstArrayIndex+1 do
begin
a[FirstArrayIndex,SecondArrayIndex] := meaning;
meaning := meaning + 1;
end;
for SecondArrayIndex:=FirstArrayIndex+1 to M-FirstArrayIndex+1 do
begin
a[SecondArrayIndex,M-FirstArrayIndex+1] := meaning;
meaning := meaning + 1;
end;
for SecondArrayIndex:=M-FirstArrayIndex downto FirstArrayIndex do
begin
a[M-FirstArrayIndex+1,SecondArrayIndex] := meaning;
meaning := meaning + 1;
end;
for SecondArrayIndex:=M-FirstArrayIndex downto FirstArrayIndex+1 do
begin
a[SecondArrayIndex, FirstArrayIndex]:= meaning;
meaning := meaning+1;
end;
end;
for FirstArrayIndex := 1 to N do
begin
for SecondArrayIndex := 1 to M do write(a[FirstArrayIndex,SecondArrayIndex]:4);
writeln
end;
end.

 program finding_of_max_and_the_amount_of_equal_elements;
const
N=9;
var
a:array[0..N] of integer;
amount_of_equal_elements, max, ArrayIndex:integer;
begin
for ArrayIndex := 0 to N do
a[ArrayIndex] := random(1, 99);
max:=a[0];
for ArrayIndex := 0 to N do
if a[ArrayIndex] > max then
begin
max := a[ArrayIndex];
amount_of_equal_elements := 1;
end
else if a[ArrayIndex] = max then
amount_of_equal_elements := amount_of_equal_elements + 1;
writeln(a);
writeln('Максимальный элемент = ', max, ' Количество равных ему = ', amount_of_equal_elements);
end.

Нахождение минимального четного элемента в массиве (при условии, что известно, какое максимально значение может принимать элемент массива. В заданиях ЕГЭ обычно указано максимально возможное значение элемента массива):

program finding_of_min_even_element_in_the_array;

const

N=9;

var

a:array[0..N]of integer;

min_even, ArrayIndex:integer;

begin

for ArrayIndex := 0 to N do

a[ArrayIndex] := random(1, 99);

min_even := 101;

for ArrayIndex := 1 to N do

if (a[ArrayIndex] mod 2 = 0) and (min_even > a[ArrayIndex]) then

min_even := a[ArrayIndex];

writeln(a);

if min_even mod 2 <> 0 then

writeln('В массиве нет элемента,удовлетворяющего обоим условиям ')

else

writeln('Минимальный четный элемент = ', min_even);

end.

Нахождение количества и суммы всех чётных элементов в массиве (рассмотрим лишь количество, т. к. сумма считается по аналогии):
 
program finding_of_the_amount_of_all_even_elements_in_the_array;
const
N=9;
var
a:array[0..N]of integer;
amount_of_all_even_elements, ArrayIndex:integer;
begin
amount_of_all_even_elements := 0;
for ArrayIndex := 0 to N do
a[ArrayIndex] := random(1, 99);
for ArrayIndex := 0 to N do
if a[ArrayIndex] mod 2 = 0 then
amount_of_all_even_elements := amount_of_all_even_elements + 1;
writeln(a);
writeln('Количество четных элементов массива = ', amount_of_all_even_elements);
end.

Предлагаю рассмотреть популярную сортировку «пузырьком»:

program sorting_of_the_array_bubble;

const

N=9;

var

disorder:boolean;

ArrayIndex, temporary:integer;

a:array[0..N]of integer;

begin

for ArrayIndex:=0 to N do

a[ArrayIndex]:=random(1,99);

writeln(a);

disorder := true;

while disorder do

begin

disorder := false;

for ArrayIndex:=0 to N-1 do

begin

if a[ArrayIndex] > a[ArrayIndex +1] then

begin

temporary := a[ArrayIndex];

a[ArrayIndex] := a[ArrayIndex +1];

a[ArrayIndex +1] := temporary;

disorder := true;

end;

end;

end;

writeln(a);

end.

Сортировка «вставками»:
 
program sorting_using_of_exchange;
const
N=9;
var
FirstArrayIndex, SecondArrayIndex, temporary:integer;
a:array[1..N]of integer;
begin
for FirstArrayIndex:= 1 to N do
a[FirstArrayIndex]:=random(1,99);
writeln(a);
for FirstArrayIndex := 2 to N do
begin
temporary := a[FirstArrayIndex];
SecondArrayIndex := FirstArrayIndex - 1;
while (SecondArrayIndex >= 1) and (a[SecondArrayIndex] > temporary) do
begin
a[SecondArrayIndex + 1] := a[SecondArrayIndex];
SecondArrayIndex := SecondArrayIndex - 1;
end;
a[SecondArrayIndex + 1] := temporary;
end;
writeln(a);
end.

Сортировка «перемешиванием»:

program sorting_using_of_mixing;

const

N=10;

var

ArrayIndex, first_element, last_element, temporary, k:integer;

a:array[1..N]of integer;

begin

for ArrayIndex:=1 to N do

a[ArrayIndex]:=random(1,99);

writeln(a);

first_element := 1;

last_element := N;

while last_element > first_element do

begin

for ArrayIndex:= last_element downto first_element+1 do

if a[ArrayIndex] < a[ArrayIndex -1] then

begin

temporary := a[ArrayIndex];

a[ArrayIndex] := a[ArrayIndex -1];

a[ArrayIndex -1] := temporary;

k := ArrayIndex;

end;

first_element := k; 

for ArrayIndex := first_element to last_element-1 do

if a[ArrayIndex] > a[ArrayIndex +1] then

begin

temporary := a[ArrayIndex];

a[ArrayIndex] := a[ArrayIndex +1];

a[ArrayIndex +1] := temporary;

k := ArrayIndex;

end;

last_element := k;

end;

writeln(a);

end.

«Гномья» сортировка:
 
program gnomes_sorting;
const
N=10;
var
a:array[1..N] of integer;
FirstArrayIndex, SecondArrayIndex, temporary:integer;
begin
for FirstArrayIndex:=1 to N do
a[FirstArrayIndex]:=random(1,99);
writeln(a);
FirstArrayIndex := 2;
SecondArrayIndex := 3;
while FirstArrayIndex <= N do
begin
if a[FirstArrayIndex -1] <= a[FirstArrayIndex] then
begin
FirstArrayIndex := SecondArrayIndex;
SecondArrayIndex := SecondArrayIndex + 1
end
else
begin
temporary := a[FirstArrayIndex -1];
a[FirstArrayIndex -1] := a[FirstArrayIndex];
a[FirstArrayIndex] := temporary;
FirstArrayIndex := FirstArrayIndex - 1;
if FirstArrayIndex = 1 then
begin
FirstArrayIndex := SecondArrayIndex;
SecondArrayIndex := SecondArrayIndex + 1
end;
end;
end;
writeln(a);
end.
 

 program merger_of_two_arrays_without_sorting;
const
N=5;
M=5;
O=N+M;
var
FirstArrayIndex,SecondArrayIndex,ThirdArrayIndex:integer;
a:array[1..N]of integer;
b:array[1..M]of integer;
c:array[1..O]of integer;
begin
for FirstArrayIndex:=1 to N do
begin
writeln('Введите значение элемента первого массива =');
readln(a[FirstArrayIndex]); 
end;
for SecondArrayIndex:=1 to M do
begin
writeln('Введите значение элемента второго массива =');
readln(b[SecondArrayIndex]); 
end;
FirstArrayIndex:=1;
SecondArrayIndex:=1;
ThirdArrayIndex:=1;
while (FirstArrayIndex <= N) and (SecondArrayIndex <= M) do
begin
if a[FirstArrayIndex] < b[SecondArrayIndex] then
begin
c[ThirdArrayIndex] := a[FirstArrayIndex];
FirstArrayIndex := FirstArrayIndex + 1;
ThirdArrayIndex := ThirdArrayIndex + 1;
end
else
begin
c[ThirdArrayIndex] := b[SecondArrayIndex];
SecondArrayIndex := SecondArrayIndex + 1;
ThirdArrayIndex := ThirdArrayIndex + 1;
end;
end;
while FirstArrayIndex <= N do
begin
c[ThirdArrayIndex] := a[FirstArrayIndex];
FirstArrayIndex := FirstArrayIndex + 1;
ThirdArrayIndex := ThirdArrayIndex + 1;
end;
while SecondArrayIndex <= M do
begin
c[ThirdArrayIndex] := b[SecondArrayIndex];
SecondArrayIndex := SecondArrayIndex + 1;
ThirdArrayIndex := ThirdArrayIndex + 1;
end;
writeln('Полученный массив = ', c);
end.

Для конкретного символа:
 
program processing_of_separate_symbols_in_the_string;
var
i, counter:integer;
input_string:string;
begin
counter := 0;
writeln('Введите строку ');
readln(input_string);
for i:=1 to length(input_string) do
if input_string[i] = 'a' then
counter := counter + 1;
writeln('Количество символов a = ', counter);
end.
 

Для любого символа:
 
program processing_of_separate_symbols_in_the_string;
var
disorder:boolean;
j, k, i, counter, temporary:integer;
input_string:string;
a:array[1..255] of integer;
begin
for i :=1 to 255 do
a[i] := -1;
counter := 1;
writeln('Введите строку ');
readln(input_string);
for i:=1 to length(input_string) do
a[i] := ord(input_string[i]);
disorder := true;
while disorder do
begin
disorder := false;
for i:=1 to 254 do
begin
if a[i] < a[i+1] then
begin
temporary := a[i+1];
a[i+1] := a[i];
a[i] := temporary;
disorder := true;
end;
end;
end;
writeln(a);
j:=1;
write(chr(a[1]),' встречается ');
for i:=2 to 255 do
if a[i]=a[i-1] then
j := j+1
else
begin
writeln(j, ' раз(а)');
if a[i]>-1 then
write(chr(a[i]),' встречается ');
j:=1;
end;
if a[i]>-1 then
writeln(j, ' раз(а)');
end.
 

Инверсия строки
 
program the_inversion_of_the_string;
var
temporary:char;
i:integer;
input_string:string;
begin
writeln('Введите строку ');
readln(input_string);
for i:=1 to length(input_string) div 2 do
begin
temporary := input_string[i];
input_string[i] := input_string[length(input_string)+1-i];
input_string[length(input_string)+1-i] := temporary;
end;
writeln(input_string);
end.
 

Удаление заданных символов из строки
 
program the_deleting_of_the_symbols_from_the_string;
var
symbols:char;
i, j:integer;
input_string:string;
begin
writeln('Введите строку ');
readln(input_string);
writeln('Введите символы, которые неоходимо удалить ');
readln(symbols);
for i := 1 to length(input_string) do
if input_string[i] = symbols then
input_string[i] := chr(32);
writeln(input_string);
end.

  Разбиение на слова по пробельным символам:

program the_separating_of_the_string;

var

divider:string;

space, i, j:integer;

resultat, input_string:string;

begin

writeln('Введите строку ');

readln(input_string);

space:=1;

j:=1;

divider := ' ';

resultat := '';

writeln('Разбитая на подстроки строка: ');

for i := 1 to length(input_string) do

begin

if pos(input_string[i], divider) = 0 then

resultat := resultat + input_string[i]

else

begin

if length(resultat) > 0 then

writeln(resultat);

writeln;

resultat := '';

end;

end;

writeln(resultat);

end.

Поиск подстроки внутри данной строки:
 
program the_finding_of_the_substring_in_the_string;
const
N=128;
var
indicator:boolean;
a:array[1..N]of string;
divider:string;
space, i, j, k:integer;
resultat, input_string, input_substring:string;
begin
indicator := false;
k := 1;
writeln('Введите строку ');
readln(input_string);
writeln('Введите подстроку, наличие которой надо проверить ');
readln(input_substring);
space:=1;
j:=1;
divider := ' ';
resultat := '';
for i := 1 to length(input_string) do
begin
if pos(input_string[i], divider) = 0 then
resultat := resultat + input_string[i]
else
begin
if length(resultat) > 0 then
a[k]:=resultat;
k := k+1;
resultat := '';
end;
end;
a[k]:=resultat;
for k:=1 to N do
if a[k] = input_substring then
indicator := true;
if indicator then
writeln('Такая подстрока имеется в строке')
else
writeln('Такая подстрока НЕ имеется в строке');
end.
 

Замена найденной подстроки на другую строку:

program the_replacement_of_thesubstring_in_the_string;

const

N=128;

var

indicator:boolean;

a:array[1..N]of string;

divider:string;

space, i, j, k:integer;

resultat, input_string, another_string, input_substring:string;

begin

indicator := false;

k := 1;

writeln('Введите строку ');

readln(input_string);

writeln('Введите подстроку, которую нужно заменить');

readln(input_substring);

writeln('Введите подстроку, на которую ее нужно заменить');

readln(another_string);

space:=1;

j:=1;

divider := ' ';

resultat := '';

for i := 1 to length(input_string) do

begin

if pos(input_string[i], divider) = 0 then

resultat := resultat + input_string[i]

else

begin

if length(resultat) > 0 then

a[k]:=resultat;

k := k+1;

resultat := '';

end;

end;

a[k]:=resultat;

for k:=1 to N do

if a[k] = input_substring then

a[k]:=another_string;

for k:=1 to N do

write(a[k],' ');

end.