Двумерный
Создание матрицы 5x4, вывод ее на экран по строкам
program Massiv_2;
const
N = 5; { Число строк }
M = 4; { Число столбцов }
var
Table: array [1..N, 1..М] of integer; { Заказываем область памяти для хранения двумерного массива из N строк и М столбцов }
{ Вообще говоря, нигде не определено, что первый индекс - это номер строки, а второй - это номер столбца. Так как выводом на экран занимается программист, он сам решает, как ему удобнее.
Нам удобнее считать, что номер строки - первый индекс, а номер столбца - второй }
i, j: integer; { Переменные для хранения индексов строки и столбца }
begin
{ Заполнение массива датчиком случайных чисел; }
randomize;
for i:=1 to N do
for j:=l to M do
Table[i, j]:=Random(100); { Запись случайного числа в массив на место с номером строки i и номером столбца j }
{ Вывод матрицы на экран по строкам; }
for i:=1 to N do
begin
for j:=1 to M do
write(Table[i, j]);
writeln { Переход на новую строку после вывода всех элементов строки i }
end;
readln
end.
Найти сумму всех элементов двумерного массива и сумму элементов каждой строки.
program prim J;
uses crt;
type mas=array[1..100, 1..100] of integer;
var a:mas;
i,j,n,s,sl:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
for i:=1 to n do
begin
for j:=1 to n do
begin
{ Получаем случайные значения элементов матрицы. }
a[i,j]=random(45)-22;
write(a[i,j]:4);
{ Находим сумму элементов. }
s:=s+a[i,j]; sl:=sl+a[i,j];
end;
{ Печатаем сумму всех элементов каждой строки и обнуляем значение суммы. }
writeln('сумма строки =',s);s:=0;
writeln;
end;
writeln('сумма всех элем. sl=',sl);
readln;
end.
Найти максимальный элемент каждой строки массива и его индексы (всего массива и его индексы).
{Так как элементы могут повторяться, то договоримся, что будем запоминать только индексы первого максимального элемента.}
program prim2;
uses crt;
type mas=array[1..100,1..100] of integer;
var a:mas;
i,j,n: integer;
max,min,i1,j1,i2,j2:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
for i:=1 to n do
begin
{ Так как тип массива integer, то за начальные значения возьмем. }
max: =-32 768;
for j:=1 to n do
begin
{ Получаем случайные значения элементов матрицы. }
a[i,j]:=random(45)-22;
{ Выводим элементы матрицы на экран. }
write(a[i,j]:4);
{ Находим максимальный элемент в каждой строке и его индексы. }
if a[i,j]>max then
begin
max:=a[i,j];i1:=i; j1:=j;
end;
end;
{ Печатаем максимальный элемент в каждой строке и его индекс. }
write (' тах=',тах, ' строка=',i1,' cmon6eц =',j1);
writeln;
end;
readln;
end.
{ Для нахождения максимального элемента всего массива необходимо:
- перенести начальный максимум на одну строку выше;
- перенести печать максимального элемента на две строки вниз. }
Найти количество элементов, больших некоторого заданного числа X в каждой строке массива (во всем массиве).
program prim25;
uses crt;
var a: =array[1.. 100,1..100] of integer;
i,j,n:integer;
k,l,x:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
{ Задаем значение Х. }
x:=0;
for i:=1 to n do
begin
k:=0;l:=0;
for j:=1 to n do
begin
a[i,j]:=random(45)-22;
write(a[i,j]:4);
{ Считаем число элементов, удовлетворяющих условию задачи. }
if a[i,j]>x then k:=k+1 else l:=l+1
end;
{ Если находим для всего массива, то следующую строку надо убрать, а начальные значения K=0:L=0 перенести выше на одну строку. }
write('k=',k, 'l=',l);k:=0;l:=0;;
end;
{ Печатаем число элементов, удовлетворяющих условию задачи во всем массиве. }
write('k=',k, 'l=',l);
readln;
end.
Определить, является ли данный квадратный массив симметричным относительно своей главной диагонали.
{ Если массив является симметричным, то для него выполняется равенство a[i,j]=a[j,i] для всех i=l,..., n и j=l,..., n при условии, что i>j. Но если встретится хотя бы одна такая пара, что соответствующие элементы не будут равны, то массив будет несимметричным }
program prim1;
uses crt;
var a: array[1..100,1..100] of integer;
i,j,n:integer;
begin
clrscr;
randomize;
write('n='); readln(n);
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(45)-22;
write(a[i,j]:4);
end;
writeln;
end;
readln;
for i:=1 to n do
for j:=1 to n do
if (i>j) and (a[i,j]<>a[j,i] then
begin
writeln ('no');
exit;
end;
writeln('yes');
readln;
end.
Вставить строку из нулей на место строки с номером k
{ Для решения этой задачи необходимо:
Первые k-1 строк оставить без изменения.
Все строки после k-й сдвинуть на одну назад, это лучше начать с последней строки и идти до k-й.
Элементам строки k присвоить заданное значение
Кроме того, необходимо изменить размер массива. Так как мы вставляем строку, то число строк будет на одну больше: }
program prim2;
uses crt;
type mas=array[1..100,1.. 100] of integer;
var a:mas;
i,j,k,n:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
{ Создаем и распечатываем двумерный массив. }
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(45)-22;
write(a[i,j]:4);
end;
writeln;
end;
{ Вводим номер вставляемой строки. }
write('k=');readln(k);
{ Сдвигаем строки назад до К-й строки, начиная с последней. }
for i:=n downto k do
for j:=1 to n do a[i+1,j]:=a[i,j];
{ Обнуляем элементы К-й строки. }
for j:=1 to n do a[k,j]:=0;
{ Распечатываем новый массив, который на одну строку больше исходного. }
for i: = 1 to n+1 do
begin
for j:=1 to n do
begin
write(a[i,j]:4);
end;
writeln;
end;
readln;
end.
Поменять местами строки с номерами К1 и К2.
program prim4;
uses art;
type mas=array[1..100,1..100] of integer;
var a:mas;
i,j,n,k1,k2,r: integer;
begin
clrscr;
randomize;
write('n=');readln(n);
{ Создаем и распечатываем двумерный массив. }
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(45)-22;
write(a[i,j]:4);
end;
writeln;
end;
{ Вводим номера строк, которые будем менять местами. }
write('stroki k1=k2=');readln(k1,k2);
{ Меняем значения К1 и К2 строк между собой. }
for j:=1 to n do
begin
r:= a[k1,j];a[k1,j]:=:=a[k2,j];
a[k2,j]:=r;
end;
{ Распечатаем измененный массив. }
for i:=1 to n do
begin
for j:=1 to n do
begin
write(a[i,j]:4);
end;
writeln;
end;
readln;
end.
Заполнить массив А размером п*m следующим образом, например, n=5 и m=5:
1 2 3 4 5
10 9 8 7 6
11 12 13 14 15
20 19 18 17 16
21 22 23 24 25
То есть заполняется в виде "змейки".
{ Для того, чтобы заполнить, надо вывести правило заполнения, а оно в данном случае будет таким: если ряд нечетный (то есть номер строки - нечетное число), то A [i,j]=(i-1)*m+j, иначе (то есть когда строка четная) A[i,j]==i*m-j+l.
По этому правилу и составляем процедуру заполнения. }
program prim 1;
uses crt;
type mas=array[1..100,1.. 100] of integer;
var a:mas;
i,j,n,m:integer;
begin
clrscr;
write('n=m=');readln(n,m);
for i:=1 to n do
begin
for j:=1 to m do
begin
{ Заполняем массив по выведенному правилу заполнения и выводим его на экран. }
if i mod 2 =1 then
a[i,j]:=(i-1)*m+j
else a[i,j]:=i*m-j+1;
write(a[i,j]:4);
end;
writeln;
end;
readln;
end.
Строки
1) Составить программу проверки есть ли в тексте буква "s"
uses crt;
var t: string;
i: integer;
ot: boolean;
begin
clrscr;
writeln('введите текст:');readln(t);
for i:=1 to length(t) do
if t[i]='s' then ot:=true;
if ot=true then write('да')
else write('нет');
readln;
end.
2) Дано нат. число n. Верно ли, что сумма цифр этого числа яв-ся нечётной.
uses crt;
var a: string;
t,er,n,i,s: integer;
begin
clrscr;
write('введите число ');readln(a);
s:=0;
for i:=1 to length(a) do
begin
val(a[i],t,er);
s:=s+t;
end;
if s mod 2<>0
then write('сумма яв-ся нечётной')
else write('сумма яв-ся чётной');
readln;
end.
program z3;
3) Посчитать сумму цифр всех целых чисел 1 до n
uses crt;
var i,j,n,er,s,t: integer;
a: string;
begin
clrscr;
write('до скольки считать ');readln(n);
s:=0;
for i:=1 to n do
begin
str(i,a);
for j:=1 to length(a)do
begin
val(a[j],t,er);
s:=s+t;
end;
end;
write('сумма=',s);
readln;
end.
4) Дано число n.Выбросить из него все единицы и пятёрки, оставив порядок цифр
{ ПРИМЕР: 527012 преобразуется в 2702 }
uses crt;
var b: array[1..10]of string;
a,c: string;
i,j,k: integer;
begin
clrscr;
write('введите число ');readln(a);
j:=0;k:=0;c:='';
for i:=1 to length(a)do
if (a[i]<>'1')and(a[i]<>'5')then
begin
j:=j+1;
k:=k+1;
b[j]:=a[i];
end;
for j:=1 to k do c:=c+b[j];
write('полученое число ',c);
readln;
end.
Ввести слово и:
а) напечатать его по вертикали;
б) переставить буквы слова в обратном порядке.
{ а) Будем рассматривать слово слева направо и делать посимвольную вырезку (копию), а затем печатать вырезанный символ. }
program рЗ5;
uses crt;
var i:byte;
a:string;
begin
clrscr;
writeln('a=');readln(a);
for i:=1to length(a) do
writeln(copy(a,i,1);
readln;
end.
{ б) Двигаясь справа налево и делая посимвольную вырезку, мы получим нужное слово. }
Ввести число, записать образующие его цифры в обратном порядке и найти квадрат полученного числа. (Например, исходное число -81; обратное - 18; его квадрат - 324).
program р36;
uses crt;
var n,k:integer;
L1,L:string;
i:Byte;
begin
clrscr;
writeln('n =');readln(n);
str(n,L);l1:= ' ';
for i:=length(L) downto 1 do
L1:=L1+copy(L,i,1);
writeln('o6pam.чucлo=',L1);val(L1,n,k);
if k=o then
writeln('квад'=),sqr(n);
readln;
end.
В введенном тексте подсчитать количество букв и количество цифр.
program р37;
uses crt;
var i,kod, s1,s2; integer;
a:string;
begin
clrscr;
writeln' (a=',);readln(a);
for i:=1 to length(a) do
begin
{ Находим код буквы. }
kod;=ord(a[i]);
{ Заглавные латинские буквы. }
if ((kod >= 65) and (kod <= 90));
{ Строчные латинские. }
OR ((kod > 97) AND (kod <=122)) OR;
{ Заглавные, строчные русские буквы. }
(kod>=128) and (kod < 175) OR (kod >= 224 AND (kod < = 239))
THEN S1:= S1 + 1;
{ Цифры. }
IF(kod>=48)AND(kod<=57)
THEN S2:=S2+1;
end;
writeln('букв=',s1)
writeln('цифр=',s2)
readln;
end.
Ввести слово и напечатать его разделенным пробелами на три части: первые две буквы, середина слова, последние две буквы.
{ Сразу необходимо выяснить, какой длины должно быть слово, чтобы удовлетворять условию нашей задачи. (2 + 1 + 2) = 5. Таким образом, слово, с которым можно проделать описанную в условии задачи операцию, должно состоять не менее чем из 5 символов. }
program р38;
uses crt;
var i: byte;
a:string;
begin
clrscr;
repeat
writeln('a=');readln(a);
until length(a)>=5;
writeln (copy(a,1,2), '', copy (a, 3, length(a)-4), ' ',copy(a,length(a)-1,2));
readln;
end.
Ввести целое число и напечатать его, добавляя перед каждой восьмеркой пробел.
program р39;
uses crt;
var i: byte;
a:string;
begin
clrscr;
writeln('a=');readln(a);
for i:=1 to length(a) do
if (copy(a,i,1) <> '8') then
write(copy(a,i,1)) else write(' ',8);
readln;
end.
Напечатайте все подслова данного слова А, начинающиеся с его первой буквы, по возрастанию их длин.
program p40;
uses crt;
var i:byte;
a:string;
begin
clrscr;
writeln('a=');readln(a);
for i:=1 to length(a) do
writeln(copy(a,1,i));
readln;
end.
Составить программу подсчета количества вхождений буквы "а" в заданном тексте.
program p41;
uses crt;
var i,s:integr;
A:string;
begin
clrscr;
write('a=');readln(a);
for j:=1 to length(a) do
begin
if copy(a,i,1)= ' a' then s:=s+1;
end;
writeln ('s=',s);
readln;
end.
Составить программу подсчета в заданном тексте количества вхождений символов из заданного набора.
program p42;
uses crt;
var a,b,s:string;
i,j,n: integer;
begin
clrscr;
write('Исходный текст =');readln(а);
write('нa6op символов = ');readln(b);
for j:=1 to length(b) do
begin
s: = copy(b,j,1);
n:=0;
for i:=1 to length(a) do
if copy(a,i,1)=s then n:=n+1;
writeln ('s=',s, ' ', n);
end;
readln;
end.
Составить программу подсчета в заданном тексте количества вхождений заданного сочетания символов.
program p43;
uses crt;
var a, b: string;
i,n:integer;
begin
clrscr;
write('Исходный текст a=');readln(a);
write(' набор символов b=,);readln(b);
for i:=1 to length(a)-length(b)+1 do
begin
if copy (a,i,length(b))=b then
n:=n+1;
end;
writeln ('n=',n);
readln;
end.
Составить программу устранения лишних пробелов в тексте. (Лишним будем считать каждый пробел, следующий непосредственно за пробелом.)
program р44;
uses crt;
var a: string;
i:integer;
begin
clrscr;
write('Исходный текст а=');readlп(а);
i:=1;
repeat
if copy(a,i,2)=' ' then
a:=copy(a,1,i)+copy(a,i+2,length (a))
else
i:=i+1;
until (i>length(a));
writeln('a=',a);
readln;
end.
По общим правилам оформления машинописных работ и служебных документов после знаков препинания (,.:;!?) пробел обязателен. Составить программу, добавляющую недостающие пробелы.
program p45;
uses crt;
var a,b: string;
i:integer;
begin
clrscr;
write(' Исходный текcm = ');readln(a);
i:=1;
repeat
b:=copy(a,i,1);
if((b='.')or(b=',')or(b='!') or (b='?'))and (copy(a,i+1,1)<>' ')
then a:=copy(a,1,i)+' ' + copy(a,i+1,length(a)-i);
i:=i+1;
until i>=length(a);
writeln('a=',a);
readln;
end.
Убрать из данного текста уже встречающиеся символы. (Произвести "выжимку" текста)
program p46;
uses crt;
var а,b, с: string;
i,j:integer;
begin
clrscr;
write(' Введ текст a=');readln(a);
b:= ' ';
for i:=1 to length(a) do
begin
c:=copy(a,i,1);
if pos(c,b) = 0 then b:=b+c;
end;
writeln(b)
readln;
end.
Составить программу, заменяющую в заданном тексте одну подстроку на другую.
program p48;
uses crt;
var a,b,c:string;
i:integer;
begin
clrscr;
write('Иcx текст a=');readln(a);
write('заменить строку ');readln(b);
write('Ha строку ');readln(c);
i:=i+1;
repeat
if copy(a,i,length(b)) = b then
a:=copy(a,1,i-1)+c+ copy(a,i+length(b),length(a));
i:=i+1;
until i >length(a)- length(b) + 1;
writeln('a=',a);
readln;
end.
{ Эту программу можно использовать в разных случаях. Рассмотрим некоторые из них. }
Задача 67a.
Реализовать на компьютере возможность автоматического исправления слова <граматика> (правильно <грамматика>).
{ Достаточно воспользоваться предыдущей программой, введя в качестве заменяемого текста слово "граматика", а в качестве заменяющего - "грамматика". }
Задача 67b.
Реализовать на компьютере операцию "вычитание" символьных величин (из введенного текста удаляются все вхождения некоторой строки).
{ В задаче 67 надо ввести в качестве заменяющего текста пустую строку. }
Задача 67с.
Реализовать на компьютере замену сокращения "С. п." на словосочетание "Составить программу".
{ В задачет 67 надо ввести в качестве заменяемого текста "С. п.", заменяющего текста "Составить программу". }
Задача 67.
Изменить в романе имя героя с Пьера на Виктора.
{ В задачу 67 надо ввести в качестве заменяемого текста слово "Пьер", заменяющего текста - "Виктор", а в качестве исходного - текст романа. }
Введите массив строк из N элементов, напечатайте элементы массива в прямом и обратном порядке.
program р53;
uses crt;
const n=3;
var a:array[1..n] of string;
i: integer;
begin
clrscr;
for i:=1 to n do
begin
write(i, ' ');readln(a[i]);
end;
writeln;
for i:=1 to n do
begin
write(a[i],' ');a[n+1-i]);
end;
readln;
end.
Расположить по алфавиту введенные слова, записанные латинскими буквами.
{ При решении этой задачи воспользуемся свойством операции сравнения }
Program р54;
uses crt;
const n=3;
var a:array[1..n] of string;
r:string;
i,j:integer;
begin
clrscr;
for i:=1 to n do
begin
write(i,' ');readln(a[i];
end;
for i:=1 to n-1 do
begin
for j:=i+1 to n do
if a[i] >a[j] then
begin
r: =a[i];a[i]: =a[j];a[j]: =r;
end;
end;
for i:= 1 to n do
writeln(a[i]);
readkey;
end.
Ввести массив слов A(N) и найти в нем максимальную по длине строку.
program p56;
uses crt;
const n=3;
var a:array[1..n] of string;
r:string;
i,j:integer;
begin
clrscr;
for i:=1 to n do
begin
write(i,' ');readln(a[i]);
end;
max:=length(a[1]);
for i:1l to n do
if max< =length(a[i]) then
max:=lengt(a[i]);r:=a[i];
writeln(max,' ',r)
readkey;
end.
Перепишите фамилии учащихся в случайном порядке.
{ Для решения этой задачи зададим массив B(N) фамилиями учащихся. Затем найдем N целых различных чисел в пределах от 1 до N и занесем их в массив А. Далее распечатаем последовательно элементы массива В(А(I)). }
program p57;
uses crt;
const n=3;
var a:array[1..n] of integer;
b:array[1..n] of string;
i,k,x:integer;
label 50;
begin
clrscr;
randomize;
for i:=1 to n do
begin
write(i, ' ');readln(b[i]);
end;
writeln;
a[1]:=trunc(random(n)) +1;k:=1;
50: x:=trunc(random(n)) +1;
for i:=1 to k do
if x=a[i] then goto 50;
k:=k+1;a[k]:=x;
if k < n then goto 50;
for i:= 1 to n do
writeln(i,' ',b[a[i]]);
readkey;
end.
Дана строка, состоящая из нескольких слов, между словами стоит один пробел, в конце предложения - точка. Подсчитать количество слов и вывести на экран только те из них, которые начинаются с буквы 'а' (слов не больше 30).
{ Разобьем предложение на отдельные слова, и каждое будем хранить как элемент массива. }
program р58;
uses crt;
const n=30;
var b: array[1..n] of string;
st: string[255];
i,k: integer;
begin
clrscr;
write('st=');readln(st);
k: = 1;
{ Пока не встретится пробел, формируем очередное слово к, прибавляя по одной букве }
for i:=1 to length(st) do
If st[i]<>' ' then
b[k]:=b[k]+st[i]
else
{Если это не последний символ, то увеличиваем счетчик слов и начинаем формировать соответствующий элемент массива.}
if i<>length(str) then
begin
inc(k);b [k]:= ' ';
end;
end;
writeln('k=',k);
{Просматриваем все слова, если первый символ очередного слова равен букве V, то выводим его}
for i:=1 to k do
if copy(b[i],1,1) = 'a' then
write(i,'-',b[i, ' ');
readln;
end.
Задача 73.
Если длина строки нечетное число, то удалить среднюю букву.
{ Пусть k - это длина строки, если оно нечетное, то надо удалить средний символ, а его номер равен k Div 2+1. }
program c59;
uses ctr;
к: integer;
st:string;
begin
clsscr;
write('st= ');readln(st);
k: =length(st);
if k mod 2=1 then
delete(st,k div 2+1,1);
writeln(st);
readln;
end.
Подсчитать сумму всех цифр данного предложения.
program c60;
uses ctr;
var d,i,k,n:integer;
st:string;
begin
clrscr;
write('st= ');readln(st);
k: =length(st);
n:=0;
for i:=1 to k do
begin
val(st[i],d,k);
if k=0 then n: =n+d;
end;
writeln('n= ',n);
readln;
end.
Составить программу "простейший справочник".
{ В Turbo Pascal 7.0 нет операторов DATA... READ информацию придется вводить в массивы в разделе описания констант. Методом присвоения в цикле, через оператор readln Методом присвоения (для небольших массивов) }
program p61;
uses crt;
const n=3;
a:array[1..n] of string=('Иванов', 'Петров','Сидоров');
c:array[1..n] of string=('911-11-11','911-22- 22','911-33-33');
var b:string;
i:integer;
begin
clrscr;
writeln('b=');readln(b);
for i:=1 to n do
if a[i]=b then writeln (a[i],' ',c[i]);
readln;
end.
Составить программу-справочник, предоставляющую полную информацию об объекте по некоторому фрагменту сведений о нем.
program p62;
uses crt;
const n=3;
a:array[1..n] of string =('Иванов','Петров', Сидоров');
c:array[1..n] of string=('911-11-11,'911-22-22','911-33-33');
var b:string;
i,j:integer;
begin
clrscr;
writeln('b=');readln(b);
for j:=1 to n do
for i:= 1 to length(a[j])-length(b)+1 do
if copy(a[j], i, length(b)) =b then
writeln (a[j],' ',c[j]);
readln;
end.
Процедуры и функции. Понятие подпрограмм
Составить процедуру сложения двух чисел, вводимых с клавиатуры.
uses crt;
var a,b,s:real;
procedure summa (x,y:real;var s:real);
begin
s:=x+y;
writeln('s=',s:3:l, ' ',a:3:l,' ',b:3:l);
end;
begin
clrscr;
writeln('a=b=');readln(a,b);
summa(a,b,s);
writeln('s=',s:3:1,' ',a:3:1,' ',b:3:1);
readln;
end.
Составить процедуру нахождения максимального из двух действительных чисел, вводимых с клавиатуры. Используйте процедуру для нахождения максимального значения для четырех чисел.
uses crt;
var a,b,s,c,d:real;
procedure maxim (x,y:real;var s:real);
begin
if x < y then s:=y else s:=x;
end;
begin
clrscr;
writeln('a=b=');readln(a,b);
writeln('c=d=');readln(c,d);
{ В переменную S заносим большее из двух чисел А и В. }
maxim(a,b,s);
{ В переменную S заносим большее из двух чисел С и S. }
maxim(c,s,s);
{ В переменную S заносим большее из двух чисел D и S. }
maxim(d,s,s);
writeln('max=',s:3:1);
readln;
end.
Составить программу, которая будет находить аb, то есть b-ю степень числа А, где А и В - это целые числа и В>0, вводимые с клавиатуры.
uses crt;
var a,b:integer;
s:longint;
procedure stepen (x,y:integer;var s:longint);
var i: integer;
begin
s:=1;
for i:=1 to у do
s:=s*x;
end;
begin
clrscr;
writeln('a=b=');readln(a,b);
{ Вызов процедуры нахождения степени числа А. }
stepen(a,b,s);
writeln('s=',s);
readln;
end.
Даны два целых числа. Поменять местами их значения.
{ В Turbo Pascal 7.0 такой процедуры нет, поэтому мы создадим ее сами. Менять местами значения двух переменных можно двумя способами - через промежуточную переменную или без нее. Напишем процедуру, воспользовавшись первым способом. }
uses crt;
var a,b: integer;
procedure swap (var x,y: integer);
var z: integer;
begin
z:=x;x:=y;y:=z;
end;
begin
clrscr;
write('a=b=');readln(a, b);
swap(a,b);
writeln('a=,b=',a, ' ',b);
readln;
end.
Составить программу, подсчитывающую число сочетаний без повторения из N элементов по К элементов.
{ Число сочетаний без повторения считается по формуле: Cnk=n!/k!(n-k)! Обозначим:
n, k- переменные для хранения введенных чисел;
С - переменная для хранения результата. Чтобы подсчитать количество сочетаний без повторения, необходимо вычислить n!, (n-к)!, к! }
uses crt;
var n,k:integer;
al,a2,a3,c:longint;
function factorial (n: integer) longint;
var i: integer;
rez:longint;
begin
rez:=1;
for i:=1 to n do
rez:=rez*i;
factorial: =rez;
end;
begin
clrscr;
writeln('введите n>=k ');
readln(n,k);
a1: =factorial (n);
a2:=factorial (k);
a3:=factorial (n-k);
c:=a1 div (a2*a3);
writeln('c=',c, ' ', al, ' ',a2, ' ',a3);
readln;
end.
Написать функцию, подсчитывающую количество цифр целого числа. Используя ее, определить, в каком из двух данных чисел больше цифр.
uses crt;
var n1,n2:longint;
k1,k2:byte;
function zifr (x:longint):integer;
var k:integer;
begin
k:=0;
while x<>0 do
begin
inc(k);
x:=x div 10;
end;
zifr:=k;
end;
begin
clrscr;
writeln('n1=n2=');readln(n1,n2);
k1:= zifr(n1); k2:= zifr(n2);
if k1 =k2 then writeln ('Одинаково')
else
if k1>k2 then writeln('B n1>n2')
else writeln('B n2>n1 ');
readln;
end.
Задача: Найти произведение ненулевых элементов матрицы.
Решение:
· Для решения данной задачи нам потребуются переменные: матрица, состоящая, например, из целочисленных элементов; P – произведение элементов, отличных от 0; I, J – индексы массива; N, M – количество строк и столбцов в матрице.
· Входными данными являются N, M – их значения введем с клавиатуры; матрица – ввод матрицы оформим в виде процедуры, заполнение матрицы осуществим случайным образом, т.е. с помощью функции random ().
· Выходными данными будет являться значение переменной P (произведение).
· Чтобы проверить правильность выполнения программы, необходимо вывести матрицу на экран, для этого оформим процедуру вывода матрицы.
· Ход решения задачи:
обсудим сначала выполнение основной программы, реализацию процедур обговорим чуть позже:
· введем значения N и M;
· Введем двумерный массив Паскаля, для этого обращаемся к процедуре vvod (a), где а – матрица;
· Напечатаем полученную матрицу, для этого обращаемся к процедуре print (a);
· Присвоим начальное значение переменной P =1;
· Будем последовательно перебирать все строки I от 1-й до N -й, в каждой строке будем перебирать все столбцы J от 1-го до M -го, для каждого элемента матрицы будем проверять условие: если a ij? 0, то произведение P будем домножать на элемент a ij (P = P * a ij);
· Выведем на экран значение произведения ненулевых элементов матрицы – P;
А теперь поговорим о процедурах.
Замечание (это важно!) Параметром процедуры может быть любая переменная предопределенного типа, это означает, что для передачи в процедуру массива в качестве параметра, тип его должен быть описан заранее. Например:
Type Matrix=array [1..10, 1..10] of integer;.............................. procedure primer (a: matrix);..............................Вернемся теперь к нашим процедурам.
Процедура ввода матрицы называется vvod, параметром процедуры является матрица, причем она должна быть, как результат, передана в основную программу, следовательно, параметр должен передаваться по ссылке. Тогда заголовок нашей процедуры будет выглядеть так:
Procedure vvod (var m: matrix);Для реализации вложенных циклов в процедуре нам потребуются локальные переменные-счетчики, например, k и h. Алгоритм заполнения матрицы уже обсуждался, поэтому не будем его повторять.
Процедура вывода матрицы на экран называется print, параметром процедуры является матрица, но в этом случае она является входным параметром, следовательно, передается по значению. Заголовок этой процедуры будет выглядеть следующим образом:
Procedure print (m: matrix);И вновь для реализации вложенных циклов внутри процедуры нам потребуются счетчики, пусть они называются так же – k и h. Алгоритм вывода матрицы на экран был описан выше, воспользуемся этим описанием.