Урок 16. Задача 4.
Primary tabs
Пользователь вводит N (N Напишите подпрограмму, которая определит - есть ли у них общее пересечение, и если есть - вычислит координаты отрезка-пересечения.
type ar = array[1..5, 1..2] of integer;
br = array[1..2] of integer;
var a :ar;
b :br;
fl :boolean;
procedure fillArr(var a1 :ar);//наполняем массив А
var i :integer;
begin
writeln();
for i := 1 to high(a1) do
begin
writeln('Введите начало отрезка');
readln(a1[i, 1]);
writeln('Введите конец отрезка');
readln(a1[i, 2]);
end;
writeln();
writeln('Ваши отрезки: ');
for i := 1 to high(a1) do
begin
writeln(a1[i, 1], ' ', a1[i, 2]);
end;
end;
procedure searchSeg(a1 :ar; var b1 :br; var fl1 :boolean);//поиск отрезка пересечения
var i :integer;
begin
b1[1] := a1[1, 1];
b1[2] := a1[1, 2];
for i := 2 to high(a1) do
begin
if (a1[1, 1] <= a1[i, 2]) and (a1[1, 2] >= a1[i, 1]) then
begin
if a1[i, 1] > b1[1] then
b1[1] := a1[i, 1];
if a1[i, 2] < b1[2] then
b1[2] := a1[i, 2];
end
else
begin
fl1 := false;
writeln('Пересечения нет');
break;
end;
end;
end;
begin
b[1] := 0;
b[2] := 0;
fl := true;
fillArr(a);
searchSeg(a, b, fl);
if fl then
begin
writeln('Пересечением является отрезок с координатами: ');
write(b[1], ' ', b[2]);
end;
readln();
end.
- Log in to post comments
- 2857 reads
vedro-compota
Thu, 09/08/2022 - 19:24
Permalink
использовать в решении
использовать в решении базовую подпрограмму http://fkn.ktu10.com/?q=node/15791
(потренируемся в декомпозиции)
_____________
матфак вгу и остальная классика =)
Dennis80
Sat, 09/10/2022 - 20:21
Permalink
type ar = array[1..5, 1..2]
type ar = array[1..5, 1..2] of integer; br = array[1..2] of integer; var arA :ar; arB :br; fl :boolean; procedure create_an_array(var arA :ar); var i :integer; begin writeln(); for i := 1 to high(arA) do begin writeln('Введите начало отрезка'); readln(arA[i, 1]); writeln('Введите конец отрезка'); readln(arA[i, 2]); end; writeln(); writeln('Ваши отрезки: '); for i := 1 to high(arA) do begin writeln(arA[i, 1], ' ', arA[i, 2]); end; end; procedure find_intersection(a_1, a_2, b_1, b_2 :integer; var arB :br; var fl :boolean); // 16.3 begin if (a_1 <= b_2) and (a_2 >= b_1) then fl := true; if fl then begin writeln(fl); if a_1 < b_1 then arB[1] := b_1; if a_2 < b_2 then arB[2] := a_2; end; end; procedure result_record(arA :ar; var arB :br; var fl :boolean); var i, j, a_1, a_2, b_1, b_2 :integer; begin j := 2; for i := 1 to (high(arA) - 1) do begin a_1 := arA[i, 1]; a_2 := arA[i, 2]; b_1 := arA[j, 1]; b_2 := arA[j, 2]; find_intersection(a_1, a_2, b_1, b_2, arB, fl); if not fl then break; j := j + 1; end; end; procedure result_output(arB :br; fl :boolean); begin if not fl then writeln('No intersection') else writeln('Here : ', arB[1], ' ', arB[2]); end; begin fl := false; create_an_array(arA); result_record(arA, arB, fl); result_output(arB, fl); end.vedro-compota
Sun, 09/11/2022 - 15:02
Permalink
procedure result_record(arA
-- по-идее после того как нашли пересение 1-ого со 2ым надо искать пересечение результат с третьим отрезком и т.д.
Ищем именно общее пересечение, а не попарно проверяем пересекаются ли.
_____________
матфак вгу и остальная классика =)
Dennis80
Wed, 09/14/2022 - 18:25
Permalink
type ar = array[1..5, 1..2]
type ar = array[1..5, 1..2] of integer; br = array[1..2] of integer; var arA :ar; arB :br; fl :boolean; procedure create_an_array(var arA :ar); var i :integer; begin writeln(); for i := 1 to high(arA) do begin writeln('Введите начало отрезка'); readln(arA[i, 1]); writeln('Введите конец отрезка'); readln(arA[i, 2]); end; writeln(); writeln('Ваши отрезки: '); for i := 1 to high(arA) do begin writeln(arA[i, 1], ' ', arA[i, 2]); end; end; procedure find_intersection(a_1, a_2 :integer; var arB :br; var fl :boolean); begin if (a_1 <= arB[2]) and (a_2 >= arB[1]) then fl := true else fl := false; if fl then begin if a_1 > arB[1] then arB[1] := a_1; if a_2 < arB[2] then arB[2] := a_2; end; end; procedure result_record(arA :ar; var arB :br; var fl :boolean); var i, a_1, a_2 :integer; begin arB[1] := arA[1, 1]; arB[2] := arA[1, 2]; for i := 2 to high(arA) do begin a_1 := arA[i, 1]; a_2 := arA[i, 2]; find_intersection(a_1, a_2, arB, fl); if not fl then break; end; end; procedure result_output(arB :br; fl :boolean); begin if not fl then writeln('No intersection') else writeln('Here : ', arB[1], ' ', arB[2]); end; begin fl := false; create_an_array(arA); result_record(arA, arB, fl); result_output(arB, fl); end.vedro-compota
Wed, 09/14/2022 - 19:35
Permalink
if (a_1 <= arB[2]) and (a_2 >
Проверить условие для такого расположения элементов:
_____________
матфак вгу и остальная классика =)
Dennis80
Wed, 09/21/2022 - 15:16
Permalink
type ar = array[1..5, 1..2]
type ar = array[1..5, 1..2] of integer; br = array[1..2] of integer; var arA :ar; arB :br; fl :boolean; procedure create_an_array(var arA :ar); var i :integer; begin writeln(); for i := 1 to high(arA) do begin writeln('Введите начало отрезка'); readln(arA[i, 1]); writeln('Введите конец отрезка'); readln(arA[i, 2]); end; writeln(); writeln('Ваши отрезки: '); for i := 1 to high(arA) do begin writeln(arA[i, 1], ' ', arA[i, 2]); end; end; procedure find_intersection(a_1, a_2 :integer; var arB :br; var fl :boolean); begin if (a_1 <= arB[1]) and (a_2 <= arB[2]) or (a_1 <= arB[2]) and (a_2 >= arB[1]) then fl := true else fl := false; if fl then begin if a_1 > arB[1] then arB[1] := a_1; if a_2 < arB[2] then arB[2] := a_2; end; end; procedure result_record(arA :ar; var arB :br; var fl :boolean); var i, a_1, a_2 :integer; begin arB[1] := arA[1, 1]; arB[2] := arA[1, 2]; for i := 2 to high(arA) do begin a_1 := arA[i, 1]; a_2 := arA[i, 2]; find_intersection(a_1, a_2, arB, fl); if not fl then break; end; end; procedure result_output(arB :br; fl :boolean); begin if not fl then writeln('No intersection') else writeln('Here : ', arB[1], ' ', arB[2]); end; begin fl := false; create_an_array(arA); result_record(arA, arB, fl); result_output(arB, fl); readln(); end.vedro-compota
Wed, 09/21/2022 - 19:29
Permalink
засчитано
засчитано
_____________
матфак вгу и остальная классика =)