Задачи Pascal
.docx-
Даны натуральные числа m и n. Найти наименьшее общее кратное этих чисел.
var
m, n, s: word;
begin
readln(m, n);
s := m * n;
while m <> n do
begin
if m > n then
begin
m := m - n
end
else
begin
n := n - m
end
end;
writeln(s div m)
end.
-
Напечатать все простые числа до 1000.
var
x:integer;
j:integer;
b:boolean;
begin
x:=2;
While x<=1000 do
begin
b:=true;
for j:=2 to x-1 do
begin
if (x mod j)=0 then
begin b:=false; break;
end;
end;
if b then
begin
Writeln(x);
end;
inc(x);
end;
end.
-
Дана последовательность целых чисел a1; a2; ...; an. Выяснить, каких чисел встречается больше положительных или отрицательных.
Var
a:array[1..100] of integer;
n,i:integer;
begin
writeln('VVEDITE KOL-VO ELEMENTOV');
read(n);
for i:=1 to n do
read(a[i]);
if a[1]>0 then writeln('Положительное')else writeln('Отрицательное');
end.
-
В целочисленной последовательности есть нулевые элементы. Создать массив из номеров этих элементов.
Var
a :array [1..100] of real;
i,n,j : integer;
x : array [1..100] of real;
Begin
write('n=');readln(n);
for i:=1 to n do
readln(a[i]);
j:=1;
for i:=1 to n do
if a[i]=0 then
begin
x[j]:=i;
j:=j+1
end;
for i:=1 to j-1 do
write(x[i],' ');
End.
-
Задана квадратная матрица. Получить транспонированную матрицу, т.е. матрицу, где столбцы и строки меняются местами.
Const
row=4;
col=4;
var
a,b:array[1..row,1..col] of integer;
i,j:integer;
begin
randomize;
writeln('Ishodnaya matriza sluchainih chisel: ');
for i:=1 to row do
begin
for j:=1 to col do
begin
a[i,j]:=random(100);
b[i,j]:=a[i,j];
write(a[i,j]:8);
end;
writeln;
end;
writeln;
writeln;
for i:=1 to row do
for j:=1 to col do
begin
if (i<>j) and (i<j) then a[i,j]:=a[j,i];
if (i<>j) and (i>j) then a[i,j]:=b[j,i];
end;
for i:=1 to row do
begin
for j:=1 to col do write(a[i,j]:8);
writeln;
end;
readln;
end.
-
Натуральные числа a, b, c называются числами Пифагора, если выполняется условие a2+b2=c2. Напечатать все числа Пифагора, меньшие N.
var
a,b,n:integer;
begin
readln(n);
for a:=1 to n-1 do
for b:=1 to n-1 do
if (sqrt (a*a+b*b)=int( sqrt (a*a+b*b))) and( sqrt (a*a+b*b)<n) then
writeln (a,' ',b,' ',trunc(sqrt(a*a+b*b)));
end.
-
Дано целое n > 2. Напечатать все простые числа из диапазона [2,n].
Var
n,i,k,d:integer;
Begin
Readln(n);
for i:=2 to n do
begin
for k:=2 to (i)+1 do if i mod k = 0 then inc(d);
if d=1 then Write(i,' ');
d:=0;
end;
readln;
End.
-
Дана последовательность действительных чисел a1; a2; ...; an. Подсчитать сколько ее членов, большие заданного числа M.
-
Даны целые числа a1; a2; ...; an. Вывести на печать только те числа, для которых выполняется ai < i.
-
Даны натуральные числа a1; a2; ...; an. Указать те, у которых остаток от деления на M равен L (0 <= L <= M - 1).
Var
i,n,m,l,f:integer;
a:array [1..10] of integer;
begin
writeln('Введите кол-во элементов вектора');
readln(n);
writeln('Ввод элементов вектора');
for i:=1 to n do
begin
write('a[',i,']=');
readln(a[i]);
end;
writeln('Вывод элементов вектора');
for i:=1 to n do
write(a[i],' ');
writeln;
writeln('Введите делитель');
readln(m);
writeln('Введите остаток');
readln(l);
writeln('Числа, которые от деления на ',m,' дают остаток ',l);
if (l>=0) and (l<=m-1) then
begin
for i:=1 to n do
if (a[i] mod m)=l then
begin
writeln(a[i]);
f:=1;
end;
end;
if f=0 then
writeln('Таких чисел в массиве нет!');
end.
-
Дана строка, содержащая английский текст. Найти количество слов, начинающихся с буквы ‘b’.
const pr: set of char=[' ','(',',','.',';',':','-'];
var s: string;
i,k: byte;
begin
write('s=');
readln(s);
if (s[1]='B') or (s[1]='b') then inc(k);
for i:=2 to length(s) do
if ((s[i]='B') or (s[i]='b')) and (s[i-1] in pr) then inc(k);
writeln('Слов на B(b): ',k);
readln;
end.
-
В строке имеется одна точка с запятой ’;’. Подсчитать количество символов до точки с запятой и после нее.
var
s1,s2:string;
i,k:integer;
begin
writeln('vvedite stroku ');
readln(s1);
s2:=';';
i:=Pos(s2,s1);
if i<>0 then
begin
k:=length(s1)-i;
i:=i-1;
writeln('kol simvolov do = ',i,'kol simvolov posle = ',k);
end
else writeln('podstroka ne naidena');
end.
-
Проверить, одинаковое ли число открывающихся и закрывающихся скобок в данной строке.
Var
str:string;
i,k1,k2:byte;
begin
writeln('vvedite stroku');
readln(str);
for i:=1 to length(str) do
begin
if str[i]='(' then inc(k1);
if str[i]=')' then inc(k2);
end;
if k1=k2 then writeln('da') else writeln('net');
readln;
end.
-
Дана строка. Подсчитать количество букв b в последнем ее слове.
Var
s,s1:string;
i,b:byte;
begin
write('Введите строку: ');readln(s);
b:=0;s1:='';
for i:=Length(s) downto 1 do
if not(s[i] in [' ',',','-']) then s1:=s1+s[i]
else break;
for i:=1 to Length(s1) do
if s1[i]='b' then inc(b);
if b>0 then write('В последнем слове букв "b"= ',b)
else write('В последнем слове буква "b" не встречаются');
end.
-
Дана строка. Удалить из нее все лишние пробелы, оставив между словами не более одного. Результат поместить в новую строку.
var
s:string;
begin
writeln('Введите строку...');
readln(s);
while pos(' ',s)>0 do
delete(s,pos(' ',s),1);
writeln('Результат:');
writeln(s)
end.
-
Написать программу нахождения наибольшего общего делителя(НОД) трех чисел, используя функцию нахождения НОД двух чисел.
-
Дан треугольник, вершины которого имеют координаты (x1, y1), (x2,y2), (x3,y3). Определить площадь треугольника, используя функцию, определяющую расстояние между двумя заданными точками.
Var
xa,ya,xb,yb,xc,yc: integer;
ab,bc,ca,s: real;
function Dlina(x1,y1,x2,y2: integer):real;
var d: real;
begin
d:= sqrt(sqr(y1-y2)+sqr(x1-x2));
Dlina:=d;
end;
function Square (a,b,c: real): real;
var sq: real;
begin
sq:=0.25*(sqrt((a+b+c)*(b+c-a)*(a+c-b)*(a+b-c)));
Square:=sq;
end;
begin
writeln ('Координаты вершины A ');
readln (xa,ya);
writeln ('Координаты вершины B ');
readln (xb,yb);
writeln ('Координаты вершины C ');
readln (xc,yc);
ab:=Dlina(xa,ya,xb,yb);
bc:=Dlina(xb,yb,xc,yc);
ca:=Dlina(xc,yc,xa,ya);
s:=Square(ab,bc,ca);
write ('Площадь треугольника = ',s:7:2);
end.
-
Написать программу использующую функцию определения симметричности матрицы
int sim(int **a);
Результат: 1 - если матрица симметрична, и 0 - в противном случае.
-
Дан текстовый файл. Заменить все символы ’0’ на символ '1' и наоборот;
Var
f1,f2:text;
ch:char;
begin
assign(f1,'C:\F.txt');
reset(f1);
assign(f2,'C:\G.txt');
rewrite(f2);
while not eof(f1) do
begin
read(f1,ch);
if ch='0' then ch:='1'
else if ch='1' then ch:='0';
write(f2,ch);
end;
close(f1);
close(f2);
end.
-
Пусть дан текстовый файл. Распечатайте, строки, начинающиеся с заданного слова.