Урок 16 Задача 4

Primary tabs

Submitted by avast36 on Fri, 04/15/2022 - 11:24

Forums:

Урок 16 Задача 4

Пользователь вводит N (N < 20) пар целых чисел, считаем что это пары координат отрезков на прямой, сохраните их в двумерный массив.

Напишите подпрограмму, которая определит - есть ли у них общее пересечение, и если есть - вычислит координаты отрезка-пересечения.

Решение:

program u16z04;
type newArr = array[1..5,1..2] of integer;
type newArr2 = array[1..2] of integer;
var arr:newArr;
  i,j:integer;

function readArr():newArr;
begin
  randomize;
  for i:=low(arr) to high(arr) do
  begin
    write('vvedite pervuyu koordinatu: ');
    readln(arr[i][1]);
    write('vvedite vtoruyu koordinatu: ');
    readln(arr[i][2]);
  end;
  result:=arr;
end;

procedure writeArr1(arr:newArr);
begin
  for i:=low(arr) to high(arr) do
  begin
    for j:=low(arr[i]) to high(arr[i]) do
      write(arr[i][j],'|');
    writeln();
  end;
end;

procedure writeArr2(barr:newArr2);
begin
  write(barr[1],', ',barr[2]);
end;

procedure otrezki(arr:newArr);
var barr:newArr2;
  s:boolean;
begin
  s:=TRUE;
  barr[1]:=arr[1][1];
  barr[2]:=arr[1][2];
  for i:=low(arr)+1 to high(arr) do
  begin
    if (arr[i][1]>barr[1])and(arr[i][2]<barr[2]) then
    begin
      barr[1]:=arr[i][1];
      barr[2]:=arr[i][2];
    end
    else
      if (arr[i][1]<barr[1])and(arr[i][2]>barr[2]) then
      begin
        barr[1]:=barr[1];
        barr[2]:=barr[2];
      end
      else
        if (arr[i][1]<barr[1])and(arr[i][2]>barr[1])and(arr[i][2]<barr[2]) then
        begin
          barr[1]:=barr[1];
          barr[2]:=arr[i][2];
        end
        else
          if (arr[i][2]>barr[2])and(arr[i][1]<barr[2])and(arr[i][1]>barr[1]) then
          begin
            barr[1]:=arr[i][1];
            barr[2]:=barr[2];
          end
          else
            s:=FALSE;
    end;
  if s=TRUE then
  begin
    writeln('otrezok peresecheniya:');
    writeArr2(barr);
  end
  else
    writeln('otrezki ne peresekayutsya:');
end;

begin
  arr:=readArr();
  writeln('otrezki:');
  writeArr1(arr);
  otrezki(arr);
  writeln();
  readln();
end.

Консоль:

vvedite pervuyu koordinatu: 1
vvedite vtoruyu koordinatu: 20
vvedite pervuyu koordinatu: -7
vvedite vtoruyu koordinatu: 31
vvedite pervuyu koordinatu: -3
vvedite vtoruyu koordinatu: 18
vvedite pervuyu koordinatu: 2
vvedite vtoruyu koordinatu: 24
vvedite pervuyu koordinatu: 6
vvedite vtoruyu koordinatu: 55
otrezki:
1|20|
-7|31|
-3|18|
2|24|
6|55|
otrezok peresecheniya:
6, 18
  • Log in to post comments
  • 2026 reads
vedro-compota's picture

vedro-compota

Wed, 06/15/2022 - 19:33

используйте в решение процедуру из предыдущей задачи

_____________
матфак вгу и остальная классика =)

avast36

Tue, 07/05/2022 - 09:45

Решение:

program u16z04;
type newArr = array[1..2] of integer;
var arr:newArr;
  s: boolean;
  i,j,n,a3,a4: integer;

procedure writeArr(arr:newArr);
begin
  for j:=low(arr) to high(arr) do
    write(arr[j],' ');
end;

procedure otrezki(a3,a4:integer; var arr:newArr; var s:boolean);
begin
  if (a3<=arr[1]) and (arr[1]<=a4) then
    begin
      if (a4<arr[2]) then                   // x2|x1|y2|y1
      begin
        s:= TRUE;
        arr[2]:=a4;
      end
      else                                  // x1=x2|y1=y2 and x2|x1|y1|y2
        s:=TRUE;
    end
  else if (arr[1]<=a3) and (a3<=arr[2]) then
    begin
      if (arr[2]<=a4) then                  // x1|x2|y1|y2
      begin
        s:= TRUE;
        arr[1]:=a3;
      end
      else                                  // x1|x2|y2|y1
      begin
        s:= TRUE;
        arr[1]:=a3;
        arr[2]:=a4;
      end;
    end
  else
    s:= FALSE;                              // x1|y1|   |x2|y2
end;

begin
  s:=FALSE;
  n:=5;
  write('vvedite pervuyu koordinatu 1 otrezka - ');
  readln(arr[1]);
  write('vvedite vturuyu koordinatu 1 otrezka - ');
  readln(arr[2]);
  for i:=2 to n do
  begin
    write('vvedite pervuyu koordinatu ',i,' otrezka - ');
    readln(a3);
    write('vvedite vtoruyu koordinatu ',i,' otrezka - ');
    readln(a4);
    otrezki(a3,a4,arr,s);
  end;
  if s then
  begin
    write('otrezok peresecheniya: ');
    writeArr(arr);
  end
  else
    writeln('otrezki ne peresekayutsya');
  readln();
end.

Консоль:

vvedite pervuyu koordinatu 1 otrezka - 1
vvedite vturuyu koordinatu 1 otrezka - 20
vvedite pervuyu koordinatu 2 otrezka - -3
vvedite vtoruyu koordinatu 2 otrezka - 14
vvedite pervuyu koordinatu 3 otrezka - 2
vvedite vtoruyu koordinatu 3 otrezka - 16
vvedite pervuyu koordinatu 4 otrezka - 0
vvedite vtoruyu koordinatu 4 otrezka - 25
vvedite pervuyu koordinatu 5 otrezka - 5
vvedite vtoruyu koordinatu 5 otrezka - 21
otrezok peresecheniya: 5 14

vvedite pervuyu koordinatu 1 otrezka - 1
vvedite vturuyu koordinatu 1 otrezka - 2
vvedite pervuyu koordinatu 2 otrezka - 2
vvedite vtoruyu koordinatu 2 otrezka - 3
vvedite pervuyu koordinatu 3 otrezka - 3
vvedite vtoruyu koordinatu 3 otrezka - 4
vvedite pervuyu koordinatu 4 otrezka - 5
vvedite vtoruyu koordinatu 4 otrezka - 6
vvedite pervuyu koordinatu 5 otrezka - 7
vvedite vtoruyu koordinatu 5 otrezka - 8
otrezki ne peresekayutsya
vedro-compota's picture

vedro-compota

Wed, 07/06/2022 - 20:44

исправить форматирование и сигнатуру, потом будем проверять

_____________
матфак вгу и остальная классика =)

avast36

Thu, 07/07/2022 - 09:44 

program u16z04;
type newArr = array[1..2] of integer;
var arr:newArr;
  s: boolean;
  i,j,n,a3,a4: integer;

procedure writeArr(arr:newArr);
begin
  for j:=low(arr) to high(arr) do
    write(arr[j],' ');
end;

procedure otrezki(a3,a4:integer; var arr:newArr; var s:boolean);
begin
  if (a3<=arr[1]) and (arr[1]<=a4) then
  begin
    if (a4<arr[2]) then                   // x2|x1|y2|y1
    begin
      s:= TRUE;
      arr[2]:=a4;
    end
    else                                  // x1=x2|y1=y2 and x2|x1|y1|y2
      s:=TRUE;
  end
  else if (arr[1]<=a3) and (a3<=arr[2]) then
  begin
    if (arr[2]<=a4) then                  // x1|x2|y1|y2
    begin
      s:= TRUE;
      arr[1]:=a3;
    end
    else                                  // x1|x2|y2|y1
    begin
      s:= TRUE;
      arr[1]:=a3;
      arr[2]:=a4;
    end;
  end
  else
    s:= FALSE;                            // x1|y1|   |x2|y2
end;

begin
  s:=FALSE;
  n:=5;
  write('vvedite pervuyu koordinatu 1 otrezka - ');
  readln(arr[1]);
  write('vvedite vtoruyu koordinatu 1 otrezka - ');
  readln(arr[2]);
  for i:=2 to n do
  begin
    write('vvedite pervuyu koordinatu ',i,' otrezka - ');
    readln(a3);
    write('vvedite vtoruyu koordinatu ',i,' otrezka - ');
    readln(a4);
    otrezki(a3,a4,arr,s);
  end;
  if s then
  begin
    write('otrezok peresecheniya: ');
    writeArr(arr);
  end
  else
    writeln('otrezki ne peresekayutsya');
  readln();
end.