Шпаргалка по информатике (сборник Паскаль). Сборник_Паскаль1. 1. Найти значение выражения 1122 nn

• Название: 1. Найти значение выражения 1122 nn
• Анкор: Шпаргалка по информатике (сборник Паскаль
• Дата: 08.02.2023
• Размер: 192 Kb.
• Имя файла: Сборник_Паскаль1.doc
• Тип: Документы; #926117
• страница: 2 из 3

program z24;

{ Составить программу для определения расстояния от точки (x3;y3)

до прямой проходящей через точки (x1;y1),(x2;y2) }

uses crt;

var x1,x2,x3,y1,y2,y3,a,b,c,d,t : real;

begin

clrscr;

write('x1=');readln(x1);

write('y1=');readln(y1);

write('x2=');readln(x2);

write('y2=');readln(y2);

write('x3=');readln(x3);

write('y3=');readln(y3);

a:=y2-y1;

b:=x1-x2;

c:=-x1*(y2-y1)+y1*(x2-x1);

t:=sqrt(a*a+b*b);

d:=abs((a*x3+b*y3+c)/t);

write('расстояние =',d);

readln;

end.
program z25;

{ Треугольник задан координатами вершин (x1;y1),(x2;y2),(x3;y3).

Найти площадь треугольника (используя формулу Герона) }

uses crt;

var x1,x2,x3,y1,y2,y3,a,b,c,s,p : real;

begin

clrscr;

write('x1=');readln(x1);

write('y1=');readln(y1);
write('x2=');readln(x2);

write('y2=');readln(y2);

write('x3=');readln(x3);

write('y3=');readln(y3);

a:=sqrt(sqr(x1-x2)+sqr(y1-y2));

b:=sqrt(sqr(x2-x3)+sqr(y2-y3));

c:=sqrt(sqr(x3-x1)+sqr(y1-y3));

p:=(a+b+c)/2;

s:=sqrt(p*(p-a)*(p-b)*(p-c));

write('s=',s);

readln;

end.
program z26;

{ Даны координаты диагонали прямоугольника.

Найти его площадь. }

uses crt;

var x1,x2,y1,y2,s,a,b : real;

begin

clrscr;

write('x1=');readln(x1);

write('y1=');readln(y1);

write('x2=');readln(x2);

write('y2=');readln(y2);

a:=abs(x2-x1);

b:=abs(y2-y1);

s:=a*b;

write('s=',s);

readln;

end.
program z27;

{ Найти номер максимального элемента таблицы а[1..10] }

uses crt;

var a : array [1..100] of longint;

k,i,n,max : longint;

begin

clrscr;

write('n=');readln(n);

for i:=1 to n do

begin

write('a[',i,']=');readln(a[i]);

end;

max:=a[1];k:=1;

for i:=2 to n do

if a[i]>max then

begin

max:=a[i];k:=i;

end;

write('номер: ',k);

readln;

end.
program z28;

{ Дан линейный массив из n эл-тов.

Составить программу упорядочивания элементов таблицы.}

uses crt;

var a : array [1..100] of longint;

j,i,n,max : longint;

begin

clrscr;

write('n=');readln(n);

for i:=1 to n do

begin

write('a[',i,']=');readln(a[i]);

end;

for i:=1 to n-1 do

for j:=i+1 to n do

if a[j]>a[i] then

begin

max:=a[j];

a[j]:=a[i];

a[i]:=max;

end;

for i:=1 to n do writeln('a[',i,']=',a[i] );

readln;

end.
program z29;

{ Даны числа a,b,c. Составить программу вычисления

(min(a,c)-min(a,b)/(5+min(b,c)) }

uses crt;

var a,b,c,m1,m2,m3,w:real;

procedure min(var d,e,m : real);

begin

if d>e then m:=e else m:=d;

end;

begin

clrscr;

write('a=');readln(a);

write('b=');readln(b);

write('c=');readln(c);

min(a,c,m1);

min(a,b,m2);

min(b,c,m3);

w:=(m1-m2)/(5+m3);

writeln('ОТВЕТ:',w);

readln;

end.
program z30;

{ Яв-ся ли число b делителем числа a. }

uses crt;

var a,b : integer;

begin

clrscr;

write('a=');readln(a);

write('b=');readln(b);

if a mod b=0 then write('делится')

else write('не делится');

readln;

end.
program z31;

{ Составить программу определяющую яв-ся ли число простым. }

uses crt;

var a : real;

p : boolean;

i : integer;

procedure haltproc;

begin

writeln('неверные данные');

writeln('a>=2');readln;

halt;

end;

begin

clrscr;

write('a=');readln(a);

if a<2 then haltproc;

if a=2 then begin

writeln2('простое');

readln;halt;

end;

p:=true;

for i:=2 to trunc(a-1) do

if a/i=trunc(a/i) then p:=false;

if p=true

then write('простое')

else write('не простое');

readln;

end.
program z32;

{ Составить программу нахождения НОД и НОК двух чисел a и b. }

uses crt;

var a,b,p : real;

nod,nok : real;

begin

clrscr;

write('a=');readln(a);

write('b=');readln(b);

p:=a*b;

while a<>b do

if a>b then a:=a-b

else b:=b-a;

nod:=a;

nok:=p/nod;

writeln('НОД:',a);

write('НОК:',nok);

readln;

end.
program z33;

{ Составить программу решения квадратного ур-я. }

uses crt;

var a,b,c,x1,x2,d : real;

begin

clrscr;

write('a=');readln(a);

write('b=');readln(b);

write('c=');readln(c);

d:=sqr(b)-4*a*c;

if d>0 then

begin

x1:=(-b+sqrt(d))/(2*a);

x2:=(-b-sqrt(d))/(2*a);

writeln('x1=',x1);

writeln('x2=',x2);

end;

if d=0 then

begin

x1:=(-b)/(2*a);

writeln('x=',x1);

end;

if d<0 then write('корней нет');

readln;

end.
program z34;

{ Найти сумму элементов прямоугольной таблицы размером [n:m] }

uses crt;
var a : array [1..10,1..10] of longint;

i,j,n,m,s : longint;

begin

clrscr;

write('кол-во строк : ');readln(m);

write('кол-во столбцов : ');readln(n);

for i:=1 to m do

for j:=1 to n do

begin

write('a[',i,',',i,']=');readln(a[i,j]);

end;

for i:=1 to m do

for j:=1 to n do s:=s+a[i,j];

write('Сумма:',s);

readln;

end.
program z35;

{ Найти maксимальный элемент прямоугольной

таблицы размером [n:m]. }

uses crt;

var a : array [1..10,1..10] of longint;

i,j,n,m,max : longint;

begin

clrscr;

write('кол-во строк : ');readln(m);

write('кол-во столбцов : ');readln(n);

for i:=1 to m do

for j:=1 to n do

begin

write('a[',i,',',j,']=');readln(a[i,j]);

end;

max:=a[1,1];

for i:=1 to m do

for j:=1 to n do

if max
write('max=',max);

readln;

end.
program z36;

{ Цифры числа хранятся в таблице b. b[1] содержит цифру

высшего разряда a=a, a2, a3...an. Найти число. }

var n,i,a : integer;

b : array[1..6] of integer;

begin

write('Введите кол-во цифр числа n=');

readln(n);

for i:=1 to n do

begin

write('b[',i,']=');readln(b[i]);

end;

a:=0;

for i:=1 to n do a:=a*10+b[i];

write('Число:',a);

readln;

end.
program z37;

{ Найти макс. элм. таб. и кол-во макс. элементов }

uses crt;

var a : array [1..10] of longint;

k,n,i,max : longint;

begin

clrscr;

write('кол-во элм таб n=');readln(n);

for i:=1 to n do

begin

write('a[',i,']=');readln(a[i]);

end;

max:=a[1];

for i:=2 to n do if a[i]>max then max:=a[i];

for i:=1 to n do if a[i]=max then k:=k+1;

writeln('max=',max);

writeln('кол-во: ',k);

readln;

end.
program z38;

{ Дано предложение, определить кол-во слов в нём. }

uses crt;

var tec : string;

l,i,n : longint;

begin

clrscr;

write('введите текст:');readln(tec);

l:=length(tec)+1;tec[l]:=' ';

for i:=1 to l do if tec[i]=' 'then n:=n+1;

write('В тексте ',n,' слов');

readln;

end.
program z39;

{ Дан текст, определить кол-во слов "кот". }

uses crt;

var a : string;

i,m,k,n : longint;

begin

clrscr;

write('введите текст ');readln(a);

k:=0;m:=length(a);

a:=a[m]+' ';

for i:=1 to m do if a[i+2]='кот'then inc(k);

write('В тексте ',k,' слов кот');

readln;

end.
program z40;

{ Определить является ли данное слово перевертышем. }

uses crt;

var a,b,c : string;

i : longint;

begin

clrscr;

write('Введите слово: ');readln(a);

b:='';

for i:=1 to length(a) do b:=a[i]+b;{ переворачиваем слово }

if a=b then write('перевертыш')

else write('не перевертыш');

readln;

end.
program z41;

{Найти количество различных чисел в одномерной таблице}

(*МЕТОД:Каждый следующий элемент сравниваем со всеми

предыдущими и если равных ему среди предыдущих не будет

то flag оставляем неизменным и счетчик к увеличиваем*)

uses crt;

var a : array [1..10] of longint;

i,j,k,flag,n : integer;

begin

clrscr;

write('введите кол.эл.таб. а n=');readln(n);

for i:=1 to n do

begin

write('a[',i,']=');readln(a[i]);

end;

k:=1;{Пусть разных чисел нет т.е.все одинак.}

for i:=2 to n do

begin

flag:=0;j:=i-1;{j -стоит перед i}

while (flag=0) and (j>=1) do

begin

if a[i]=a[j] then flag:=1;{решение}

j:=j-1;

end;

if flag=0 then k:=k+1;

end;

write('Колич.различных чисел к=',k);

readln;

end.
program z42;

{ Каждую букву слова A поместить в таблицу. }

uses crt;

var a : string;

n,i : longint;

b : array [1..10] of string;

begin

clrscr;

write('введите текст:');readln(a);

n:=length(a);

for i:=1 to n do b[i]:=a[i];

for i:=1 to n do

begin

writeln('b[',i,']=',a[i]);

end;

readln;

end.
program z43;

{ Найти наименьшее однозначное число х удолв условию x*x*x-x*x=n. }

uses crt;

var x,n : longint;

ot : boolean;

begin

clrscr;

write('n = ');readln(n);

ot:=false;

x:=1;

while (x*x*x-x*x<>n) do

begin

inc(x);

if x*x*x-x*x=n then ot:=true;

end;

if ot=false then write('нет')

else write('x=',x);

readln;

end.
program z44;

{ Составить алгоритм нахождения суммы цифр числа. }

uses crt;

var i,n,k,s : longint;

b : array [1..10] of integer;

begin

clrscr;

write('введите число ');readln(n);

k:=1;

while n>=1 do

begin

b[k]:=trunc(n) mod 10; {элм. таб}

n:=trunc(n)div 10;

k:=k+1;

end;

for i:=1 to k do s:=s+b[i];

write('s=',s);

readln;

end.
program z45;

{ Найти двузначное число сумма кубов цифр которого равна n. }

uses crt;

var j,i : integer;

z,n : longint;

begin

clrscr;

write('n=');readln(n);

for j:=1 to 9 do

for i:=1 to 9 do

if i*i*i+j*j*j=n then z:=10*i+j;

write('z=',z);

readln;

end.
program z46;

{ Заданы 2 слова a и b. Можно ли получить из слова a,

вычеркивание некоторого кол-ва букв, слово b. }

uses crt;

var i,j,m,n : integer;

a,b,d,e : string;

begin

clrscr;

write('введите текст a=');readln(a);

write('введите текст b=');readln(b);

n:=length(a);m:=length(b);e:=b;

if n
for i:=1 to n do

for j:=1 to m do

if a[i]=b[j] then begin

d:=d+a[i];

delete(b,j,1);

end;

if d=e then write('Да')

else write('Нет');

readln;

end.
program z47;

{ Заданы 2 точки. Определить какой из отрезков

AO или BO образует больший угол с осью OX. }

uses crt;

var x1,x2,y1,y2 : longint;

a,b,a1,b1 : real;

begin

clrscr;

writeln('коорд. точки А');

write('x1=');readln(x1);

write('y1=');readln(y1);

writeln('коорд. точки В');

write('x2=');readln(x2);

write('y2=');readln(y2);

a:=sqrt(x1*x1+y1*y1);

b:=sqrt(x2*x2+y2*y2);

a1:=y1/a;b1:=y2/b;

if a1>b1

then write('отрезок OA обр. бол. угол ')

else write('отрезок OB обр. бол. угол');

readln;

end.
program z48;

{ Дана таблица А. Записать '+' элементы таблицы А в

таблицу В '-' элементы таблицы А в табл С. }

uses crt;

var a,b,c : array [1..10] of longint;

n,k,i,l : longint;

begin

clrscr;

write('n = ');readln(n);

for i:=1 to n do

begin

write('a[',i,']=');readln(a[i]);

end;
for i:=1 to n do

if a[i]<0 then begin

inc(k);b[k]:=a[i];

end

else begin

inc(l);c[l]:=a[i];

end;

writeln('положительное:');

for i:=1 to l do writeln('c[',i,']=',c[i]);

writeln('отрицательное:');

for i:=1 to k do writeln('b[',i,']=',b[i]);

readln;

end.
program z49;

{ Яв-ся ли перевёртышем число. }

uses crt;

var a,b : string;

n,i : longint;

begin

clrscr;

write('введите число n=');readln(n);

str(n,a);

b:='';

for i:=1 to length(a) do b:=a[i]+b;

if a=b then write('перевёртыш')

else write('не перевёртыш');

readln;

end.
program z50;

{Даны таблицы А[1..n] ,В[1..m]. Построить таблицу С

в которой сначала размещаются все элм-ты А, затем

все элм-ты табл В. }

uses crt;

var a : array [1..5,1..2] of string;

m,j,i,g : longint;

b,c : array [1..5] of string;

begin

clrscr;

writeln('введ i-фамилии, j-пол');

for i:=1 to 5 do

for j:=1 to 2 do

begin

write('a[',i,',',j,']=');readln(a[i,j]);

end;

for i:=1 to 5 do

begin

if a[i,2]='м' then begin

m:=m+1;

b[m]:=a[i,1];

end;

if a[i,2]='ж' then begin

g:=g+1;

c[g]:=a[i,1];

end;

end;

writeln('мальчики:');

for i:=1 to m do writeln(b[m]);

writeln('девочки:');

for i:=1 to g do writeln(c[g]);

readln;

end.
program z51;

{ Решить систему ур-ий {ax+by+c=0 и a1x+b1y+c1=0 }

uses crt;

var flag,a,a1,b,b1,c,c1,x,y,s,s1 : longint;

begin

clrscr;

flag:=0;

write('a=');readln(a);

write('b=');readln(b);

write('c=');readln(c);

write('a1=');readln(a1);

write('b1=');readln(b1);

write('c1=');readln(c1);

for x:=-10 to 10 do

for y:=-10 to 10 do

begin

s:=a*x+b*y+c;

s1:=a1*x+b1*y+c1;

if (s=0)and(s1=0)

then begin

flag:=1;

writeln('x=',x,' y=',y);

end;

end;

if flag=0 then write('в заданной области реш. нет');

readln;

end.
program z52;

{Даны 3 точки x1,y1,x2,y2,x3,y3 Составить программу для опред. площади и

периметра треуг. используя процедуру для опред расстояния между двумя

точками}

uses crt;

var x1,x2,x3,y1,y2,y3,s,p,

a,b,c : real;

procedure rasst( a1,b1,a2,b2 : real;var r : real );

begin

r:=sqrt(sqr(a1-a2)+sqr(b1-b2));

end;

begin

clrscr;

write('x1=');readln(x1);

write('y1=');readln(y1);

write('x2=');readln(x2);

write('y2=');readln(y2);

write('x3=');readln(x3);

write('y3=');readln(y3);

rasst(x1,y1,x2,y2,a);

rasst(x2,y2,x3,y3,b);

rasst(x3,y3,x1,y1,c);

p:=a+b+c;

p:=p/2;

s:=sqrt(p*(p-a)*(p-b)*(p-c));

writeln('s=',s);

readln;

end.
program z14;

{Дана лин. таб содерж. группы одинаковых подряд идущих положит. чисел.Вывести

на экран "число-кол-во чисел в группе,число-кол-во чисел в группе, ... "}

uses crt;

var a : array [1..100] of longint; {кол.эл.не больше 100}

m,n,i : longint;

begin

clrscr;

write('введите кол-во элм. таб. a,n=');readln(n);

for i:=1 to n do

begin

write('a[',i,']=');readln(a[i]);

end;

i:=1; m:=1;(*кол. одинак.эл.*)

while i<=n do

begin

if a[i]<>a[i+1]

then begin

(*если подряд идущие эл.разные то печать стоящий первым

и их кол. брать новое i для выполнения команды пока и счетчик m

опять взять =1 для подсчета других чисел*)

write('число: ',a[i]);

writeln(' кол-во ',m);

i:=i+1;

m:=1;

end {сдесь ; не ставить}

else

(*если подряд идущие эл.одинаковые то их считаем и берем

новое i для выполнения команды пока*)

begin

i:=i+1;

m:=m+1;

end;

end;

readln;

end.