1:- nodbgcomp.
2
3:- module_interface(demo).
4
5
6:- begin_module(demo).
7
8:- export point_intensity/4,
9	  senders_threshold_points/3,
10	  covered_rectangle/3,
11	  covered_rectangles/2,
12	  chr_demo/0.
13
14:- [data].
15:- [graphic].
16
17
18/*** point_intensity(ListSender, Point, Sender, Intensity) ***/
19point_intensity([], _, _, 0).
20point_intensity([S1 | ListSender], Point, Sender, Intensity) :-
21	point_intensity_from_one(S1, Point, I1),
22	point_intensity(ListSender, Point, S2, I2),
23	( I2 > I1
24         ->
25	  Sender = S2, Intensity = I2
26         ;
27	  Sender = S1, Intensity = I1
28        ).
29
30
31senders_threshold_points(ListSender, NbOfPoints, LLPoint) :-
32	threshold_points(ListSender, ListSender, NbOfPoints, LLPoint).
33
34threshold_points([], _ListSender, _NbOfPoints, []).
35threshold_points([S | ListS], ListSender, NbOfPoints, [area(S, ListPoint) | LLPoint]) :-
36	Increment is 2*pi / NbOfPoints,
37	do_threshold_points(NbOfPoints, 0, Increment, S, ListSender, ListPoint),
38	threshold_points(ListS, ListSender, NbOfPoints, LLPoint).
39
40do_threshold_points(0, _Angle, _Increment, _Point, _ListSender, []) :- !.
41do_threshold_points(N, Angle, Increment, Point, ListSender, [FarthestPoint | ListPoint]) :-
42	Farthest is max_threshold_distance,
43	farthest_point(Point, ListSender, Angle, 0, Farthest, FarthestPoint),
44	N1 is N - 1,
45	Angle1 is Angle + Increment,
46	do_threshold_points(N1, Angle1, Increment, Point, ListSender, ListPoint).
47
48
49farthest_point(X#Y, _ListSender, Angle, Inf, Sup, X0#Y0) :-
50	Sup - Inf < 0.25, !,
51	X0 is X + cos(Angle)*Sup,
52	Y0 is Y + sin(Angle)*Sup.
53farthest_point(X#Y, ListSender, Angle, Inf, Sup, X0#Y0) :-
54	Mid is (Inf + Sup) / 2,
55	X1 is X + cos(Angle)*Mid,
56	Y1 is Y + sin(Angle)*Mid,
57	( point_intensity(ListSender, X1#Y1, X#Y, I),
58	  I >= sender_intensity * threshold
59	 ->
60	  farthest_point(X#Y, ListSender, Angle, Mid, Sup, X0#Y0)
61         ;
62	  farthest_point(X#Y, ListSender, Angle, Inf, Mid, X0#Y0)
63        ).
64
65/***
66farthest_point(X#Y, ListSender, Angle, Farthest, Previous, X0#Y0) :-
67	X1 is X + cos(Angle)*Farthest,
68	Y1 is Y + sin(Angle)*Farthest,
69	point_intensity(ListSender, X1#Y1, X#Y, I),
70	I >= sender_intensity * threshold,
71	!,
72	( (Previous - Farthest) < 10
73         ->
74	  X0 = X1, Y0 = Y1
75         ;
76	  Farthest1 is (Farthest + Previous) / 2,
77	  farthest_point(X#Y, ListSender, Angle, Farthest1, Previous, X0#Y0)
78        ).
79farthest_point(Point, ListSender, Angle, Farthest, Previous, FarthestPoint) :-
80	Farthest1 is Farthest / 2,
81	farthest_point(Point, ListSender, Angle, Farthest1, Previous, FarthestPoint).
82***/
83
84
85max_threshold_distance(D) :-
86	D is sqrt(1/threshold).
87
88
89point_intensity_from_one(Sender, Point, I) :-
90	( Sender == Point
91         ->
92	  I is sender_intensity
93         ;
94	  getval(current_walls, ListWall),
95	  number_of_intersections(ListWall, Sender, Point, N),
96	  getval(wall_absorption, Wall_Absorption),
97	  ( N = 0 /*** in order to have 0^0 = 0 ***/
98           ->
99	   I is sender_intensity / (max(distance(Sender, Point), 1)^2)
100          ;
101	   I is sender_intensity / (max(distance(Sender, Point), 1)^2) * (Wall_Absorption / 100)^N
102          )
103        ).
104
105distance(X1#Y1, X2#Y2, D) :-
106	D is sqrt((X1 - X2)^2 + (Y1 - Y2)^2).
107
108
109number_of_intersections([], _S, _P, 0).
110number_of_intersections([wall(P1, P2) | ListWall], Sender, Point, N) :-
111	number_of_intersections(ListWall, Sender, Point, N1),
112	( intersect(P1, P2, Sender, Point)
113         ->
114	  N is N1 + 1
115         ;
116	  N = N1
117        ).
118
119
120intersect(X1#Y1, X2#Y2, XS#YS, XP#YP) :-
121	( X1 == X2
122         ->
123	  ( abs(XS - XP) > 1e-3
124           ->
125	    (X1 - XS) * (X1 - XP) =< 0,
126	    Y is (YP - YS) / (XP - XS) * (X1 - XS) + YS,
127	    (Y - Y1) *  (Y - Y2) =< 0
128	   ;
129	    abs(XS - X1) < 1e-3
130	  )
131        ; ( abs(XS - XP) < 1e-3
132           ->
133	    (XS - X1) * (XS - X2) =< 0,
134	    Y is (Y2 - Y1) / (X2 - X1) * (XS - X1) + Y1,
135	    (Y - YS) *  (Y - YP) =< 0
136	  ;
137	    Aa is (Y2 - Y1) / (X2 - X1),
138	    Ab is (YP - YS) / (XP - XS),
139	    Aa =\= Ab,
140	    Ba is Y1 - Aa * X1,
141	    Bb is YS - Ab * XS,
142	    X is (Bb - Ba) / (Aa - Ab),
143	    (X - X1) * (X - X2) =< 0,
144	    (X - XS) * (X - XP) =< 0
145	  )
146        ).
147
148
149covered_rectangles(X#Y, [rect(X1#Y1, X2#Y2) | Rectangles]) :-
150	covered_rectangle(X#Y, X1#Y1, X2#Y2),
151        XMid  is (X2 - X1) /2 + X1, YMid  is (Y2 - Y1) /2 + Y1,
152	extend_rectangle(XMid#Y2, XMid#Y2, X#Y, [right, left, up], XUp1#YUp1, XUp2#YUp2),
153	extend_rectangle(XMid#Y1, XMid#Y1, X#Y, [right, left, down], XDown1#YDown1, XDown2#YDown2),
154	extend_rectangle(X1#YMid, X1#YMid, X#Y, [up, down, left], XLeft1#YLeft1, XLeft2#YLeft2),
155	extend_rectangle(X2#YMid, X2#YMid, X#Y, [up, down, right], XRight1#YRight1, XRight2#YRight2),
156	keep_big_rectangles([rect(XUp1#YUp1, XUp2#YUp2), rect(XDown1#YDown1, XDown2#YDown2), rect(XRight1#YRight1, XRight2#YRight2), rect(XLeft1#YLeft1, XLeft2#YLeft2)], Rectangles).
157
158
159keep_big_rectangles([], []).
160keep_big_rectangles([rect(X1#Y1, X2#Y2) | Rectangles], BigRectangles) :-
161	( (Y2 - Y1) * (X2 - X1) > 30
162         ->
163	   BigRectangles = [rect(X1#Y1, X2#Y2) | BigRectangles1]
164         ;
165	   BigRectangles1 = BigRectangles
166        ),
167	keep_big_rectangles(Rectangles, BigRectangles1).
168
169
170covered_rectangle(X#Y, LeftDown, RightUp) :-
171	LongestSide is max_threshold_distance / sqrt(2),
172	largest_square(X#Y, LongestSide, Side),
173	X1 is X - Side / 2,
174	Y1 is Y - Side / 2,
175	X2 is X + Side / 2,
176	Y2 is Y + Side / 2,
177	extend_rectangle(X1#Y1, X2#Y2, X#Y, [up, right, down, left], LeftDown, RightUp).
178
179
180largest_square(X#Y, LongestSide, LongestSide) :-
181	corners_in_Center(X#Y, LongestSide),
182	!.
183largest_square(X#Y, LongestSide, Side) :-
184	LongestSide1 is LongestSide * 0.9,
185	largest_square(X#Y, LongestSide1, Side).
186
187
188corners_in_Center(X#Y, Side) :-
189	check_in((X-Side/2)#(Y-Side/2), X#Y),
190	check_in((X+Side/2)#(Y-Side/2), X#Y),
191	check_in((X-Side/2)#(Y+Side/2), X#Y),
192	check_in((X+Side/2)#(Y+Side/2), X#Y).
193
194
195
196extend_rectangle(LeftDown, RightUp, _Center, [], LeftDown, RightUp) :- !.
197extend_rectangle(LD, RU, Center, [Direction | Directions], LeftDown, RightUp) :-
198	( extend_one_side(LD, RU, Center, Direction, LD1, RU1)
199         ->
200	  reorder_directions(Direction, Directions, Directions1),
201	  extend_rectangle(LD1, RU1, Center, Directions1, LeftDown, RightUp)
202        ;
203	  extend_rectangle(LD, RU, Center, Directions, LeftDown, RightUp)
204        ).
205
206
207extend_one_side(X1#Y1, X2#Y2, Center, left, XL#Y1, X2#Y2) :-
208	XL is X1 - 2,
209	check_in(XL#Y1, Center),
210	check_in(XL#Y2, Center),
211	!.
212extend_one_side(X1#Y1, X2#Y2, Center, right, X1#Y1, XR#Y2) :-
213	XR is X2 + 2,
214	check_in(XR#Y1, Center),
215	check_in(XR#Y2, Center),
216	!.
217extend_one_side(X1#Y1, X2#Y2, Center, down, X1#YD, X2#Y2) :-
218	YD is Y1 - 2,
219	check_in(X1#YD, Center),
220	check_in(X2#YD, Center),
221	!.
222extend_one_side(X1#Y1, X2#Y2, Center, up, X1#Y1, X2#YU) :-
223	YU is Y2 + 2,
224	check_in(X1#YU, Center),
225	check_in(X2#YU, Center),
226	!.
227
228
229check_in(X#Y, Center) :-
230	X1 is X, Y1 is Y,
231	point_intensity([Center], X1#Y1, _, I),
232	I >= sender_intensity * threshold.
233
234
235
236
237
238reorder_directions(Direction, Directions, Directions1) :-
239	append(Directions, [Direction], Directions1).
240
241
242