Примеры
Пример 6.1. Составить программу, которая осуществляет перестановку одномерного массива без использования дополнительного массива.
Листинг 6.1.
const n=20;
var a: array [1..n] of integer;
i,c: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(30)-4;
write(a[i]:4)
end;
for i:=1 to n div 2 do
begin
c:=a[i];
a[i]:=a[n-i+1];
a[n-i+1]:=c
end;
writeln;
for i:=1 to n do
write(a[i]:4);
writeln
END.
Пример 6.2. Найти сумму всех элементов массиваA, больших заданного числа.
Листинг 6.2.
var a: array [1..100] of integer;
i,ch,n,s: integer;
BEGIN
randomize;
write('Введите размер массива -> ');
readln(n);
for i:=1 to n do
begin
a[i]:=random(20)-5;
write(a[i]:4)
end;
writeln;
write('Введите число -> ');
readln(ch);
s:=0;
for i:=1 to n do
if a[i]>ch then s:=s+a[i];
writeln('Сумма элементов, больших числа ',ch,' равна ',s)
END.
Пример
6.3.Заполнить массив, применив
для его заполнения следующее значение:
.
Листинг 6.3.
const n=10;
var a: array [1..n] of real;
i: integer;
x: real;
BEGIN
write('Введите значение х -> ');
readln(x);
for i:=1 to n do
begin
a[i]:=x*sqr(i)/(i+x);
write(a[i]:8:4)
end;
END.
Пример 6.4. В одномерном массиве целых чисел заменить все элементы, меньшие среднего арифметического, значением среднего арифметического, округленного до целого. Массив заполняется случайным образом.
Листинг 6.4.
const n=10;
var a: array [1..n] of integer;
i,s: integer;
sred: real;
BEGIN
randomize;
s:=0;
for i:=1 to n do
begin
a[i]:=random(20)-5;
write(a[i]:4);
s:=s+a[i];
end;
writeln;
sred:=s/n;
for i:=1 to n do
begin
if a[i]<sred then a[i]:=round(sred);
write(a[i]:4)
end;
writeln
END.
Пример 5. В одномерном массиве целых чисел удалитьk-й элемент массива.
Листинг 6.5.
const n=10;
var a: array [1..n] of integer;
i,k: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20)-5;
write(a[i]:4)
end;
writeln;
write('Введите номер элемента для удаления
(k < ',n,')->');
readln(k);
for i:=k to n-1 do
a[i]:=a[i+1];
for i:=1 to n-1 do
write(a[i]:4);
writeln
END.
Пример 6.6. В одномерном массиве целых чисел удалить элемент, равный заданному числу, если он есть. Если таких элементов несколько, то удалить последний из найденных.
Листинг 6.6.
const n=10;
var a: array [1..n] of integer;
i,k,kk: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20)-5;
write(a[i]:4)
end;
writeln;
write('Введите число ->');
readln(kk);
for i:=1 to n do
if a[i]=kk then k:=i;
for i:=k to n-1 do
a[i]:=a[i+1];
for i:=1 to n-1 do
write(a[i]:4);
writeln
END.
Пример 6.7. Вставить наk-е место массива целых чисел элемент, равный наименьшему элементу массива.
Листинг 6.7.
const n=10;
var a: array [1..n+1] of integer;
i,k,min: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20)-5;
write(a[i]:4)
end;
writeln;
min:=a[1];
for i:=2 to n do
if a[i]<a[min] then min:=a[i];
write('Введите значение k (k < ',n,') ->');
readln(k);
for i:=n+1 downto k do
a[i]:=a[i-1];
a[k]:=min;
for i:=1 to n+1 do
write(a[i]:4);
writeln
END.
Пример 6.8. Имеются два одномерных массива целых чисел размераn. Создать из них один одномерный массив, в котором сначала идут отрицательные элементы, затем нулевые и затем положительные.
Решим задачу следующим образом. Соединим два массива в один, а затем упорядочим полученный массив, используя «пузырьковый» метод сортировки.
Листинг 6.8.
const n=10;
var a,b: array [1..n] of integer;
c: array [1..2*n] of integer;
i,j,k: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20)-5;
b[i]:=random(12)
end;
writeln('Массив А');
for i:=1 to n do
write(a[i]:4);
writeln;
writeln('Массив B');
for i:=1 to n do
write(b[i]:4);
writeln;
for i:=1 to n do
c[i]:=a[i];
k:=1;
for i:=n+1 to 2*n do
begin
c[i]:=b[k];
inc(k)
end;
for i:=1 to 2*n-1 do
for j:=1 to 2*n-1 do
if c[j]>c[j+1] then
begin
k:=c[j];
c[j]:=c[j+1];
c[j+1]:=k
end;
writeln('Массив С');
for i:=1 to 2*n do
write(c[i]:4);
writeln
END.
Пример 6.9. Дан массив чисел. Найти, сколько в нем пары одинаковых соседних элементов [6].
Листинг 6.9.
const n=10;
var a: array [1..n] of integer;
i,k: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20)-5;
write(a[i]:4)
end;
writeln;
k:=0;
for i:=1 to n-1 do
if a[i] = a[i+1] then k:=k+1;
writeln('Одинаковых пар соседних элементов
в массиве ',k)
END.
Пример
6.10. Даны три одномерных числовых
массиваA,B,C. Сформировать массивKтакой же длины,
элементы которого вычисляются по
формуле:
[15].
Листинг 6.10.
const n=10;
var a,b,c: array [1..n] of integer;
k: array [1..n] of real;
i: integer;
BEGIN
randomize;
writeln;
writeln('МАССИВ А');
for i:=1 to n do
begin
a[i]:=random(20)-5;
b[i]:=random(30)-2;
c[i]:=random(40);
write(a[i]:4)
end;
writeln;
writeln('МАССИВ В');
for i:=1 to n do
write(b[i]:4);
writeln;
writeln('МАССИВ C');
for i:=1 to n do
write(c[i]:4);
writeln;
writeln('МАССИВ K');
for i:=1 to n do
begin
k[i]:=(a[i]-b[i])/(1+c[i]);
write(k[i]:8:4)
end
END.
Пример 6.11. Даны натуральные числаA1,A2, …,AN(N= 10). Не создавая дополнительные массивы, определить, какой из элементов повторяется в последовательностиA1,A2, …,ANнаибольшее число раз, и найти его порядковый номер, ближайший к началу последовательности [32].
Листинг 6.11.
const n=10;
var a: array [1..n] of integer;
i,j,max,k,q: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20);
write(a[i]:4)
end;
writeln;
max:=0;
for i:=1 to n-1 do
begin
k:=1;
for j:=i+1 to n do
if a[i]=a[j] then inc(k);
if k>max then
begin
max:=k;
q:=i
end
end;
write(a[q]:6,q:6,max:6);
writeln
END.
Пример 6.12. В заполненном наполовину массиве, не создавая дополнительный массив, продублировать все элементы с сохранением порядка их следования. Например, из массиваА (1, 2, 3, …) необходимо получить массив (1, 1, 2, 2, 3, 3) [32].
Листинг 6.12.
const n=5;
var a: array [1..2*n] of integer;
i: integer;
BEGIN
randomize;
for i:=1 to n do
begin
a[i]:=random(20);
write(a[i]:4)
end;
writeln;
i:=2*n;
while (i<=2*n) and (i>=2) do
begin
a[i]:=a[i div 2];
a[i-1]:=a[i];
dec(i,2);
end;
for i:=1 to 2*n do
write(a[i]:4);
writeln
END.
Пример 6.13. Заданы два одномерных массива различных размеровMиNи числоK(K<M). Не создавая дополнительный массив, включить второй массив в первый междуK-м и (К+1)-м его элементами [32].
Листинг 6.13.
const m=5; n=5;
var a: array [1..m+n] of integer;
b: array [1..n] of integer;
i,k: integer;
BEGIN
randomize;
write('Введите значение k -> ');
readln(k);
for i:=1 to m do
begin
a[i]:=random(20)-2;
write(a[i]:4)
end;
writeln;
for i:=1 to n do
begin
b[i]:=random(15)+4;
write(b[i]:4)
end;
writeln;
for i:=m+n downto (m+n)-(m-k)+1 do
a[i]:=a[i-n];
for i:=1 to n do
a[k+i]:=b[i];
for i:=1 to m+n do
write(a[i]:4);
writeln
END.
Пример 6.14. Сообщество роботов живет по следующим законам: один раз в год они объединяются в группы по 3 или 5 роботов; за год группа из 3 роботов собирает 5, а группа из 5 — 9 новых собратьев; каждый робот живет 3 года после сборки. Известно начальное количество роботов (K> 7), все они только что собраны. Определить, сколько роботов будет черезNлет. [13]
Листинг 6.14.
vark,n,i,r:byte;
new: LongInt;
d,q: array [-2..100] of LongInt;
BEGIN
write('Введите начальное кол-во роботов и кол-во лет -> ');
readln(k,n);
write('Всего роботов: ');
if k<3 then
if n in [0,1,2] then write(k) else write ('0')
else
begin
d[-2]:=0; d[-1]:=0; d[0]:=k; q[0]:=k;
for i:=1 to n do
begin
r:=q[i-1] mod 5;
new:=q[i-1] div 5*9+r;
if r in [3,4] then inc(new,5-r);
d[i]:=new;
q[i]:=q[i-1]+new-d[i-3]
end;
write(q[n])
end;
END.
Пример 6.15. Даны натуральные числаА1, …,А10. Предположим, что имеется 10 видов монет достоинствомА1, …,А10. Обозначим черезNчисло способов, которыми можно выплатить суммуKэтими монетами, то естьN— это число решений уравненияA1X1+ … +A10X10=K, гдеXiможет принимать целые неотрицательные значения. Требуется найтиN[32].
Листинг 6.15.
label 1;
var a,b,c: array [1..10] of integer;
i,j,n,s,k: integer;
BEGIN
write('Введите сумму -> ');
readln(k);
for i:=1 to 10 do
begin
write('a[',i,'] = ');
readln(a[i])
end;
for i:=1 to 10 do
b[i]:=k div a[i];
n:=0;
for i:=1 to 10 do
c[i]:=0;
1: s:=0;
for i:=1 to 10 do
s:=s+a[i]*c[i];
if s=k then inc(n);
for i:=10 downto 1 do
begin
if c[i]=b[i] then
for j:=i to 10 do
c[j]:=0 else
begin
c[i]:=c[i]+1;
goto 1
end;
end;
writeln('N = ',n);
END.
Пример 6.16. Составить программу для вычисления полиномаy= 2x8–x6– 4x5– 5x2+ 6x+ 1, используя формулу Горнера [5].
Формула Горнера для полинома n-й степениy=a1xn+a2xn–1+ … +anx+an+1выглядит следующим образом:
y = (…((a1x + a2)x + a3)x + … + an)x + an+1
Листинг 6.16.
var a: array [1..10] of real;
md,i: integer;
x,y: real;
BEGIN
write('Введите старшую степеньполинома
(она не должна быть больше 9)-> ');
readln(md);
writeln('Введите коэффициентыполинома
(начиная с коэффициента при
свободном члене) ');
for i:=1 to md do
read(a[i]);
y:=a[1];
for i:=2 to md do
begin
x:=i;
y:=y*x+a[i]
end;
writeln(y:8:6);
END.
Пример 6.17. Заданный массивАсдвинуть циклически наmэлементов вправо [7].
При циклическом сдвиге вправо выталкиваемые элементы с конца массива заполняют освобождающиеся места в начале массива. Например, при сдвиге вправо на 3 разряда массива А(1, 2, 3, 4, 5, 6, 7) получаем массивА(5, 6, 7, 1, 2, 3, 4).
Рассмотрим два варианта. В первом варианте используется дополнительный массив того же размера, что и исходный. Во втором варианте используется дополнительная память только для одного элемента массива.
Листинг 6.17.1.
const n=5;
var a,b: array [1..n] of integer;
i,c,k: integer;
BEGIN
write('На сколько элементов сдвигать вправо?-> ');
readln(c);
for i:=1 to n do
begin
a[i]:=random(20)-3;
write(a[i]:4)
end;
writeln;
for i:=1 to n do
begin
k:=(i+c-1) mod n+1;
b[k]:=a[i]
end;
for i:=1 to n do
write(b[i]:4)
END.
Листинг 6.17.2.
const n=5;
var a: array [1..n] of integer;
i,c,k,j: integer;
BEGIN
write('На сколько сдвигать вправо -> ');
readln(c);
for i:=1 to n do
begin
a[i]:=random(20)-3;
write(a[i]:4)
end;
writeln;
for i:=1 to c do
begin
k:=a[n];
for j:=n downto 2 do
a[j]:=a[j-1];
a[1]:=k
end;
for i:=1 to n do
write(a[i]:4);
END.
Пример 6.18. Билет с шестизначным цифровым номером считается «счастливым», если сумма трех старших цифр совпадает с сумой трех младших цифр. В предположении, что в билетной кассе находится миллион билетов с номерами от 000000 до 999999, надо определить количество потенциально осчастливленных пассажиров [18].
Можно организовать шесть вложенных циклов, в каждом из которых перебирается очередная цифра номера. В самом внутреннем цикле можно проверять суммы старших и младших цифр номера и вести подсчет счастливых билетов, но такая проверка нерациональна. Гораздо меньше операций можно проделать, если подсчитать, сколько раз сумма трех цифр равна 0, 1, 2, …, 27.
Листинг 6.18.
const m=9;
var b: array [0..3*m] of integer;
a1,a2,a3,k: integer;
n: longint;
BEGIN
for a1:=0 to m do
for a2:=0 to m do
for a3:=0 to m do
inc(b[a1+a2+a3]);
for k:=0 to 3*m do
n:=n+b[k]*b[k];
writeln('Количество счастливых билетов = ',n);
END.
В результате получим ответ: 55 252 билета.
Пример 6.19. Дана матрицаА5,5, содержащая случайные элементы. Найти сумму всех элементов матрицы [11].
Листинг 6.19.
const n=5;
var a: array [1..n,1..n] of integer;
i,j,s: integer;
BEGIN
randomize;
s:=0;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(20);
write(a[i,j]:4);
s:=s+a[i,j]
end;
writeln
end;
writeln('Сумма элементов матрицы = ',s);
END.
Пример 6.20. Дана матрицаА5,5, состоящая из случайных чисел. Составить одномерный массивS, в котором будут содержаться значения суммы элементов каждого столбца матрицы [11].
Листинг 6.20.
const n=5;
var a: array [1..n,1..n] of integer;
s: array [1..n] of integer;
i,j,ss: integer;
BEGIN
randomize;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(20);
write(a[i,j]:4);
end;
writeln
end;
for i:=1 to n do
begin
ss:=0;
for j:=1 to n do
ss:=ss+a[j,i];
s[i]:=ss
end;
writeln;
for i:=1 to n do
write(s[i]:4);
writeln;
END.
Пример 6.21. Вывести на экран таблицу Пифагора.
Листинг 6.21.
const n=9;
var a: array[1..n,1..n] of integer;
i,j: integer;
BEGIN
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=i*j;
write(a[i,j]:4)
end;
writeln
end;
END.
Пример 6.22. Найти сумму положительных элементов указанного столбца матрицыА5,5целых чисел.
Листинг 6.22.
const n=5;
var a: array [1..n,1..n] of integer;
i,j,num,s: integer;
BEGIN
randomize;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(20);
write(a[i,j]:4);
end;
writeln
end;
write('Введите номер столбца для
суммирования -> ');
readln(num);
s:=0;
for i:=1 to n do
if a[i,num]>0 then s:=s+a[i,num];
writeln;
writeln('Сумма элементов в ',i,' столбце = ',s);
writeln
END.
Пример 6.23. Заменить все элементы Двумерного массиваАцелых чисел, которые меньше среднего арифметического первого столбца, квадратами этих элементов.
Листинг 6.23.
const n=5;
var a: array [1..n,1..n] of integer;
i,j,s: integer;
sr: real;
BEGIN
randomize;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(20);
write(a[i,j]:4);
end;
writeln
end;
s:=0;
for i:=1 to n do
s:=s+a[i,1];
sr:=s/n;
for i:=1 to n do
for j:=1 to n do
if a[i,j]<sr then a[i,j]:=sqr(a[i,j]);
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:4);
writeln
end;
writeln
END.
Пример 6.24. Дана матрицаА5,5, состоящая из латинских букв. Отсортировать каждую строку в алфавитном порядке [6].
Листинг 6.24.
const n=5;
var a: array [1..n,1..n] of char;
i,j,k: integer;
buf: char;
BEGIN
writeln('Введите ',n*n,' букв:');
for i:=1 to n do
for j:=1 to n do
read(a[i,j]);
for i:=1 to n do
begin
for k:=1 to n-1 do
for j:= k to n do
if a[i,k]>a[i,j] then
begin
buf:=a[i,k];
a[i,k]:=a[i,j];
a[i,j]:=buf
end;
end;
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:4);
writeln
end;
writeln
END.
Пример 6.25. Дана матрицаА5,5, состоящая из целых чисел. Вывести значения элементов на печать, выполнив обход матрицы по «спирали»:
Листинг 6.25.
const n=5;
var a: array [1..n,1..n] of integer;
i,j,k: integer;
BEGIN
writeln ('ИСХОДНАЯ МАТРИЦА:');
k:=1;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=k;
write(a[i,j]:4);
inc(k)
end;
writeln
end;
writeln;
for k:=1 to (n+1) div 2 do
begin
for j:=k to n-k+1 do
write(a[k,j]:4);
for i:=k+1 to n-k+1 do
write(a[i,n-k+1]:4);
for j:=n-k downto k do
write(a[n-k+1,j]:4);
for i:=n-k downto k+1 do
write(a[i,k]:4);
end;
writeln
END.
Пример 6.26. Даны вещественные числаа1, …,аnи вещественная квадратная матрица порядкаn≥ 6. Получить вещественную матрицу размераn× (n+ 1), вставив в исходную матрицу между пятым и шестым столбцами новый столбец с элементамиа1, …,аn[13].
Листинг 6.26.
const n=10;
a: array [1..n] of real = (1,2,3,4,5,6,7,8,9,10);
var x: array [1..n,1..n+1] of real;
i: 1..n;
j: 1..n+1;
BEGIN
for i:=1 to n do
begin
for j:=1 to n do
begin
x[i,j]:=i/j;
write(x[i,j]:6:2)
end;
writeln
end;
writeln;
for i:=1 to n do
begin
for j:=n downto 6 do
x[i,j+1]:=x[i,j];
x[i,6]:=a[i]
end;
for i:=1 to n do
begin
for j:=1 to n+1 do
write(x[i,j]:6:2);
writeln
end;
END.
Пример 6.27. Дано вещественное числоx. Получить вещественную квадратную матрицуАиз 10 строк и 10 столбцов, формируя элементы матрицыАijпо приведенной схеме (середина матрицы заполняется нулями) [32]:
Листинг 6.27.
const n=10;
var a: array [1..n,1..n] of real;
i,j: integer;
x: real;
BEGIN
for i:=2 to n-1 do
for j:=2 to n-1 do
a[i,j]:=0;
write('Введите значение x -> ');
readln(x);
a[1,1]:=1;
a[n,n]:=1;
for i:=2 to n do
begin
a[i,1]:=a[i-1,1]*x;
a[1,i]:=a[i,1];
a[11-i,10]:=a[i,1];
a[10,11-i]:=a[i,1]
end;
writeln('Полученная матрица:');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:6:2);
writeln
end;
END.
Пример 6.28. Дана целочисленная квадратная матрицаАразмером 8 × 8. Получить целочисленную одномерную последовательностьВ1,В2, …,В64, элементами которой являются числа, полученные из квадратной матрицы по схеме:В1 = А11,В2 = А21, …,В64 = А18[32].
Листинг 6.28.
const n=8;
var a: array [1..n,1..n] of integer;
b: array [1..n*n] of integer;
i,j,k: integer;
BEGIN
randomize;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(20)-3;
write(a[i,j]:4)
end;
writeln
end;
k:=0;
for j:=1 to n do
if j div 2 = j/2 then
for i:= n downto 1 do
begin
inc(k);
b[k]:=a[i,j]
end;
else
for i:=1 to n do
begin
inc(k);
b[k]:=a[i,j]
end;
writeln('Полученный одномерный массив');
for i:=1 to n*n do
write(b[i]:4);
END.
Пример 6.29. Элемент матрицы называетсяседловой точкой, если он является одновременно наименьшим в своей строке и наибольшим в своем столбце. Дана матрица целых чисел размеромN × M(NиMзаданы). Выяснить, имеются ли седловые точки в этой матрице и, если имеются, указать индекс одной из них [32].
Листинг 6.29.
const n=10; m=10;
var a: array [1..n,1..m] of integer;
i,j,l,k: integer;
min,max,c,p: real;
BEGIN
randomize;
for i:=1 to n do
begin
for j:=1 to m do
begin
a[i,j]:=random(30)-3;
write(a[i,j]:3)
end;
writeln
end;
for i:=1 to n do
begin
min:=a[i,1];
for j:=1 to m do
if a[i,j] <= min then
begin
min:=a[i,j];
k:=j
end;
max:=a[1,k];
for l:=1 to n do
if a[l,k]>=max then max:=a[l,k];
if max=min then
begin
writeln('Строка — ',i,' Столбец — ',k);
break;
goto 1
end
end;
writeln('Таких точек не существует!');
1: END.
Пример 6.30. Образовать два одномерных массива путем перезаписи в них элементов из заданного целочисленного Двумерного массива размеромN×N, при этом в один из формируемых массивов переписать все элементы, стоящие выше главной диагонали, а другой — ниже главной диагонали, в порядке.
Решение задачи заключается в нахождении алгоритма считывания элементов по указанным на рисунке направлениям. Весь процесс «прохождения» матрицы реализован в 3-х циклах.
Листинг 6.30.
label 1,2;
const n=10;
var a: array [1..n,1..n] of integer;
b,c: array [1..28] of integer;
i,j,d,l,w: integer;
k: real;
BEGIN
randomize;
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(20)-3;
write(a[i,j]:3)
end;
writeln
end;
k:=(n*n-n)/2; w:=1; i:=1;
1: for j:=w to n-2*w+1 do
begin
b[i]:=a[j,j+w];
c[i]:=a[j+w,j];
if i=k then
begin
break;
goto 2
end;
inc(i)
end;
for d:=n-2*w downto w do
begin
b[i]:=a[d,n-w+1];
c[i]:=a[n-w+1,d];
if i=k then
begin
break;
goto 2
end;
inc(i)
end;
for l:=n-w downto 2*w+1 do
begin
b[i]:=a[w,l];
c[i]:=a[l,w];
if i=k then
begin
break;
goto 2
end;
inc(i)
end;
inc(w);
goto 1;
2: writeln('Массив В:');
for i:=1 to trunc(k) do
write(b[i]:4);
writeln;
writeln('Массив C:');
for i:=1 to trunc(k) do
write(c[i]:4)
END.
Пример 6.31. На квадратном клетчатом листе бумаги размером 100 × 100 клеток нарисовано несколько прямоугольников. Каждый прямоугольник состоит из целых клеток, различные прямоугольники не накладываются друг на друга и не соприкасаются. Надо сосчитать число нарисованных прямоугольников.
Для решения используем массив размером 100 на 100, в котором А[i,j] = 1, если клетка [i,j] принадлежит какому-либо прямоугольнику, иА[i,j] = 0 — в противном случае.
Листинг 6.31.
label 1,2,3;
const n=100;
var a: array [1..n,1..n] of integer;
i,j,s,x,y: integer;
BEGIN
randomize;
for i:=1 to n do
for j:=1 to n do
a[i,j]:=random(2);
s:=0;
for i:=1 to n do
for j:=1 to n do
begin
if a[i,j]=0 then goto 1;
for x:=j to n do
begin
if a[i,x] = 0 then goto 3;
a[i,x]:=0;
for y:=i to n do
begin
if a[y,j]=0 then goto 2;
a[y,i]:=0
end;
2: end;
3: inc(s);
1: end;
writeln('S = ',s);
END.