Программирование (Ассемблер) (договоримся о времени)
Нужно
Перевірити впорядкованість дійсних змінних a, b, c за спаданням їхніх значень.

👇

Открыть все ответы

Ответ:

yfcnz1215

06.05.2021

// PascalABC.NET 3.2, сборка 1356 от 04.12.2016
// Внимание! Если программа не работает, обновите версию!

type
Point=record
    x,y:real;
    name:char
end;
Vector=record
    x,y,l:real;
end;

function CreatePoint(px,py:real):Point;
begin
With Result do begin
    x:=px;
    y:=py;
end
end;

function CreateVector(A,B:Point):Vector;
begin
With Result do begin
    x:=B.x-A.x;
    y:=B.y-A.y;
    l:=Sqrt(x*x+y*y)
end
end;

function IsNormal(A,B:Vector):=Abs(B.x*A.x+B.y*A.y)<=1e-6;

begin
var x,y:real;
Write('Введите координаты x и y точки A: '); Read(x,y);
var A:=CreatePoint(x,y);
Write('Введите координаты x и y точки B: '); Read(x,y);
var B:=CreatePoint(x,y);
var AB:=CreateVector(A,B);
Write('Введите координаты x и y точки C: '); Read(x,y);
var C:=CreatePoint(x,y);
var BC:=CreateVector(B,C);
if Abs(AB.l-BC.l)>1e-6 then begin
    Writeln('Стороны AB и BC не равны');
    Exit
    end;
if not IsNormal(AB,BC) then begin
    Writeln('Стороны AB и BC не перпендикулярны');
    Exit
    end;
Write('Введите координаты x и y точки D: '); Read(x,y);
var D:=CreatePoint(x,y);
var CD:=CreateVector(C,D);
if Abs(AB.l-CD.l)>1e-6 then begin
    Writeln('Стороны AB и CD не равны');
    Exit
    end;
var AD:=CreateVector(D,A);
if Abs(AB.l-AD.l)>1e-6 then Writeln('Стороны AB и ADC не равны')
else Writeln('Точки образуют квадрат с точностью не ниже 0.000001')
end.

Пример
Здесь заданы координаты квадрата, сдвинутого относительно осей координат и повернутого на угол 30 градусов против часовой стрелки. Поэтому числа такие "некруглые".

Введите координаты x и y точки A: -0.4641 -4.4641
Введите координаты x и y точки B: 3.5359 2.4641
Введите координаты x и y точки C: 10.4641 -1.5359
Введите координаты x и y точки D: 6.4641 -8.4641
Точки образуют квадрат с точностью не ниже 0.000001

4,7(93 оценок)

Ответ:

apajcheva

06.05.2021

program massiv_zamena_min_max;
uses crt;
var massiv: array [1..100,1..100] of integer;
i,j,mr,mc,min, max, minj, maxj, tmp:integer;
begin
clrscr;
mr:=101;
mc:=101;
while ((mr>100)or(mr<0)or(mc>100)or(mc<0)) do
begin
writeln('Vvedite razmernost massiva (ne bolee chem 100x100):');
readln(mr);
readln(mc);
end;
for i:=1 to mr do
for j:=1 to mc do
begin
writeln('Vvedite element massiva nomer ',(i-1)*mc+j,':');
readln(massiv[i,j]);
end;

writeln('Massiv do izmeneniya:');
for i:=1 to mr do
begin
for j:=1 to mc do write(massiv[i,j],' ');
writeln;
end;

min:=massiv[1,1];
minj:=1;
for i:=1 to mr do
for j:=1 to mc do
if massiv[i,j]begin
min:=massiv[i,j];
minj:=j;
end;

max:=massiv[1,1];
maxj:=1;
for i:=1 to mr do
for j:=1 to mc do
if massiv[i,j]>max then
begin
maX:=massiv[i,j];
maxj:=j;
end;

for i:=1 to mr do
begin
tmp:=massiv[i,minj];
massiv[i,minj]:=massiv[i,maxj];
massiv[i,maxj]:=tmp;
end;

writeln('Nomer ctolbca s minimalnym elementom: ',minj);
writeln('Nomer ctolbca s maximalnym elementom: ',maxj);

writeln('Massiv posle izmeneniya:');
for i:=1 to mr do
begin
for j:=1 to mc do write(massiv[i,j],' ');
writeln;
end;

readln;
end. Это решение

4,7(18 оценок)

Это интересно:

Стиль-и-уход-за-собой

18.02.2021

Как избавиться от темных кругов под глазами: советы от экспертов...

16.02.2023

Как расширить границы разума: несколько простых способов...

31.05.2021

Как перестать бояться быть счастливым: 7 советов для изменения мышления...

Компьютеры-и-электроника

14.05.2023

Как создать свою видеоигру с нуля: от идеи до релиза...