Сформировать список, содержащий 10 отрезков прямых(Найти явные и неявные пересечения)

@Mr__Mess · Регистрация: 28.10.2012

Студворк — интернет-сервис помощи студентам

Всем привет! Прошу помощи в решении сложной для меня задачи!
Задача: Сформировать список, содержащий 10 отрезков прямых, при этом первые отрезки берутся из картинки, а последующие формируются случайным образом. Размер 300х300 пикселей, случайно формируемые отрезки должны лежать в от (0;0) до (300;300), расчитать точки пересечения отрезков между собой, при этом, если точка пересечения явная, то выводим окружность радиусом 5 с центром в точке пересечения красным цветом. Если точка неявная, то выводим окружность радиусом 10 желтого цвета.
Картинка вот такая:

@Mr__Mess · 08.01.2013, 19:41 **[ТС]**

Пробовал решить с другой картинкой на turbo pascal 7.0
Картинка: Прямоугольник с двумя пересекающимися диагоналями.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
uses graph;
type
  ExSt=^st;
  st=record
    data:integer;
    poi:exst;
    end;
 
var p:exst;
    x1,x2,y1,y2:integer;
    gd,gm:integer;
    n,k,stack:byte;
    arr:array[1..12] of integer;
 
procedure push(var u:exst; digit:integer);
var x:exst;
  begin
  new(x);
  x^.data:=digit;
  x^.poi:=u;
  u:=x;
  end;
 
procedure pop(var u:exst; var digit:integer);
var x:exst;
  begin
  digit:=u^.data;
  x:=u;
  u:=u^.poi;
  dispose(x);
  end;
 
procedure finding(x1,y1,x2,y2,x3,y3,x4,y4:real);
var a,tmp,xsh,ysh:real; root:boolean;
  begin
  root:=true;
  setcolor(4);
  if (y3>y4) or (x3>x4) then
    begin
    tmp:=x4; x4:=x3; x3:=tmp;
    tmp:=y4; y4:=y3; y3:=tmp;
    end;
 
  if abs(x3-x4)<0.001 then
    a:=-pi/2
  else
    a:=-arctan((y3-y4)/(x3-x4));
 
  x1:=x1-x3; y1:=y1-y3;
  x2:=x2-x3; y2:=y2-y3;
  x4:=x4-x3; y4:=y4-y3;
  xsh:=x3; x3:=0; ysh:=y3; y3:=0;
 
  tmp:=x3*cos(a)-y3*sin(a);
  y3:=x3*sin(a)+y3*cos(a);
  x3:=tmp;
  tmp:=x4*cos(a)-y4*sin(a);
  y4:=x4*sin(a)+y4*cos(a);
  x4:=tmp;
 
  tmp:=x1*cos(a)-y1*sin(a);
  y1:=x1*sin(a)+y1*cos(a);
  x1:=tmp;
  tmp:=x2*cos(a)-y2*sin(a);
  y2:=x2*sin(a)+y2*cos(a);
  x2:=tmp;
 
  if abs(y2-y1)<0.001 then
    root:=false
  else
    begin
    x1:=(x1*y2-x2*y1)/(y2-y1);
 
    if (y1*y2>0) or (abs(x1)>abs(x4)) or (x1*x4<0) then
      setcolor(yellow);
    end;
 
  if root then
  begin
  a:=-a;
  y1:=0;
  tmp:=x1*cos(a)-y1*sin(a);
  y1:=x1*sin(a)+y1*cos(a);
  x1:=tmp;
  x1:=x1+xsh; y1:=y1+ysh;
  if getcolor=4 then circle(round(x1),300-round(y1),5)
  else circle(round(x1),300-round(y1),10);
  end;
end;
 
begin
  randomize;
  gd:=detect;
  initgraph(gd,gm,'');
  setcolor(15);
  line(0,0,300,0);
  line(300,0,300,300);
  line(300,300,0,300);
  line(0,300,0,0);
  line(0,0,300,300);
  line(0,300,300,0);
 
  for n:=0 to 15 do begin
    stack:=random(300);
 
    push(p,stack); end;
   writeln;
  for n:=0 to 3 do
    begin
    pop(p,x1);
    pop(p,y1);
    pop(p,x2);
    pop(p,y2);
    setcolor(2);
    line(x1,300-y1,x2,300-y2);
 
    finding(x1,y1,x2,y2,0,0,300,300);
    finding(x1,y1,x2,y2,300,0,0,300);
    finding(x1,y1,x2,y2,0,0,0,300);
    finding(x1,y1,x2,y2,0,300,300,300);
    finding(x1,y1,x2,y2,300,0,300,300);
    finding(x1,y1,x2,y2,0,0,300,0);
 
    for k:=1 to 12-n*4 do pop(p,arr[k]);
    for k:=1 to 12-n*4 do push(p,arr[13-n*4-k]);
 
    finding(x1,y1,x2,y2,arr[1],arr[2],arr[3],arr[4]);
    if n<2 then
      begin
      finding(x1,y1,x2,y2,arr[5],arr[6],arr[7],arr[8]);
      if n<1 then
        finding(x1,y1,x2,y2,arr[9],arr[10],arr[11],arr[12]);
      end;
    end;
    finding(0,0,300,300,0,0,0,300);
    finding(0,300,300,0,0,0,0,300);
    finding(0,0,300,300,300,0,0,300);
    finding(300,0,300,300,0,300,300,300);
    finding(0,300,300,0,300,0,300,300);
  readln;
  closegraph;
end.

А нужно написать на Free Pascal и с более сложной картинкой(Картинка в первом сообщении темы). Пожалуйста, помогите!

@Mr__Mess · 11.01.2013, 00:42 **[ТС]**

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
uses graph;
type
  ExSt=^st;
  st=record
    data:integer;
    poi:exst;
    end;
 
var p:exst;
    x1,x2,y1,y2:integer;
    gd,gm:integer;
    n,k,stack:byte;
    arr:array[1..12] of integer;
 
procedure push(var u:exst; digit:integer);
var x:exst;
  begin
  new(x);
  x^.data:=digit;
  x^.poi:=u;
  u:=x;
  end;
 
procedure pop(var u:exst; var digit:integer);
var x:exst;
  begin
  digit:=u^.data;
  x:=u;
  u:=u^.poi;
  dispose(x);
  end;
 
procedure finding(x1,y1,x2,y2,x3,y3,x4,y4:real);
var a,tmp,xsh,ysh:real; root:boolean;
  begin
  root:=true;
  setcolor(4);
  if (y3>y4) or (x3>x4) then
    begin
    tmp:=x4; x4:=x3; x3:=tmp;
    tmp:=y4; y4:=y3; y3:=tmp;
    end;
 
  if abs(x3-x4)<0.001 then
    a:=-pi/2
  else
    a:=-arctan((y3-y4)/(x3-x4));
 
  x1:=x1-x3; y1:=y1-y3;
  x2:=x2-x3; y2:=y2-y3;
  x4:=x4-x3; y4:=y4-y3;
  xsh:=x3; x3:=0; ysh:=y3; y3:=0;
 
  tmp:=x3*cos(a)-y3*sin(a);
  y3:=x3*sin(a)+y3*cos(a);
  x3:=tmp;
  tmp:=x4*cos(a)-y4*sin(a);
  y4:=x4*sin(a)+y4*cos(a);
  x4:=tmp;
 
  tmp:=x1*cos(a)-y1*sin(a);
  y1:=x1*sin(a)+y1*cos(a);
  x1:=tmp;
  tmp:=x2*cos(a)-y2*sin(a);
  y2:=x2*sin(a)+y2*cos(a);
  x2:=tmp;
 
  if abs(y2-y1)<0.001 then
    root:=false
  else
    begin
    x1:=(x1*y2-x2*y1)/(y2-y1);
 
    if (y1*y2>0) or (abs(x1)>abs(x4)) or (x1*x4<0) then
      setcolor(yellow);
    end;
 
  if root then
  begin
  a:=-a;
  y1:=0;
  tmp:=x1*cos(a)-y1*sin(a);
  y1:=x1*sin(a)+y1*cos(a);
  x1:=tmp;
  x1:=x1+xsh; y1:=y1+ysh;
  if getcolor=4 then circle(round(x1),300-round(y1),5)
  else circle(round(x1),300-round(y1),10);
  end;
end;
 
begin
  randomize;
  gd:=detect;
  initgraph(gd,gm,'');
  setcolor(15);
  line(0,0,300,0);
  line(300,0,300,300);
  line(300,300,0,300);
  line(0,300,0,0);
  line(200,0,200,100);
  line(300,100,200,100);
  line(0,300,200,100);
 
  for n:=0 to 11 do begin
    stack:=random(300);
 
    push(p,stack); end;
   writeln;
  for n:=0 to 2 do
    begin
    pop(p,x1);
    pop(p,y1);
    pop(p,x2);
    pop(p,y2);
    setcolor(2);
    line(x1,300-y1,x2,300-y2);
 
    finding(x1,y1,x2,y2,0,0,300,0);
    finding(x1,y1,x2,y2,300,0,300,300);
    finding(x1,y1,x2,y2,0,300,300,300);
    finding(x1,y1,x2,y2,0,0,0,300);
    finding(x1,y1,x2,y2,200,300,200,200);
    finding(x1,y1,x2,y2,300,200,200,200);
    finding(x1,y1,x2,y2,0,0,200,200);
 
    for k:=1 to 8-n*4 do pop(p,arr[k]);
    for k:=1 to 8-n*4 do push(p,arr[9-n*4-k]);
 
    finding(x1,y1,x2,y2,arr[1],arr[2],arr[3],arr[4]);
    if n<1 then
 
      finding(x1,y1,x2,y2,arr[5],arr[6],arr[7],arr[8]);
    end;
    finding(0,0,300,0,0,0,0,300);
    finding(0,0,300,0,300,0,300,300);
    finding(0,300,300,300,0,300,0,0);
    finding(300,0,300,300,0,300,300,300);
    finding(200,200,200,300,0,300,300,300);
    finding(300,300,300,0,300,200,200,200);
    finding(200,200,200,300,0,0,300,0);
    finding(200,200,300,200,0,0,0,300);
    finding(0,0,200,200,200,200,300,200);
    finding(0,0,200,200,300,0,300,300);
  readln;
  closegraph;
{Beta версия, автор TrAN}
end.

Вот лаба, может кому пригодится, по заданию из первого сообщения =) написана на Turbo Pascal 7.0

Новые блоги и статьи Все статьи Все блоги /
Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .
модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ

@Mr__Mess 0 / 0 / 2 Регистрация: 28.10.2012 Сообщений: 8

	Сформировать список, содержащий 10 отрезков прямых(Найти явные и неявные пересечения) 08.01.2013, 19:38. Показов 1149. Ответов 2 Метки нет (Все метки) Всем привет! Прошу помощи в решении сложной для меня задачи! Задача: Сформировать список, содержащий 10 отрезков прямых, при этом первые отрезки берутся из картинки, а последующие формируются случайным образом. Размер 300х300 пикселей, случайно формируемые отрезки должны лежать в от (0;0) до (300;300), расчитать точки пересечения отрезков между собой, при этом, если точка пересечения явная, то выводим окружность радиусом 5 с центром в точке пересечения красным цветом. Если точка неявная, то выводим окружность радиусом 10 желтого цвета. Картинка вот такая: Миниатюры 0

Сформировать список, содержащий 10 отрезков прямых(Найти явные и неявные пересечения)

Решение