fork download
copy 
  1. program p1;
  2. var x,y,x1,y1,x2,y2:array[1..100] of integer;ax,ay,b,c:array[1..100,1..100] of integer;i,j,n,pom,k,sx,sy,k1,a,b1,k2,k3:integer;
  3. max,xbar,ybar:extended;
  4. begin
  5. readln(n);
  6.     for i:=1 to n do
  7. 	for j:=1 to n do 
  8. 	  begin
  9. 	    b[i,j]:=0;
  10. 	    c[i,j]:=0;
  11. 	  end;
  12. 	for i:=1 to n do begin
  13. 	readln(x[i],y[i]);
  14. 	x1[i]:=x[i];
  15. 	y1[i]:=y[i];
  16. 	end;
  17. 	for i:=1 to n do 
  18.         for j:=i+1 to n do begin
  19.             if x[i]>x[j] then begin
  20.                 pom:=x[i];
  21.                 x[i]:=x[j];
  22.                 x[j]:=pom;
  23.                 end;
  24. end;
  25. 	for i:=1 to n do 
  26.         for j:=i+1 to n do begin
  27.             if y[i]>y[j] then begin
  28.                 pom:=y[i];
  29.                 y[i]:=y[j];
  30.                 y[j]:=pom;
  31.                 end;
  32. end;
  33. x[n+1]:=-1;y[n+1]:=-1;k2:=0;k3:=0;
  34. for i:=1 to n do 
  35. begin
  36. if x[i]<>x[i+1] then
  37.   begin
  38.     k2:=k2+1;
  39.     x2[k2]:=x[i];
  40.   end;
  41.   if y[i]<>y[i+1] then
  42.   begin
  43.     k3:=k3+1;
  44.     y2[k3]:=y[i];
  45.   end;
  46. end;
  47. 	for i:=1 to k3 do 
  48. 	for j:=1 to k2 do 
  49. 	  begin
  50. 	    ax[i,j]:=x2[j];
  51. 	    ay[i,j]:=y2[i];
  52. 	    for k:=1 to n do 
  53. 	       begin
  54. 	          if (y2[i]=y1[k])and(x2[j]=x1[k]) then 
  55. 	            begin
  56. 	              b[i,j]:=1;
  57. 	              c[i,j]:=1;
  58. 	            end;
  59. 	      end;
  60. 	  end;
  61.  
  62. 	k1:=n;
  63.     while (k1>1) do 
  64. 	begin
  65. 	sx:=0;sy:=0;
  66. 	for i:=1 to k3 do
  67. 	for j:=1 to k2 do 
  68. 	   begin
  69. 	     if b[i,j]=1 then 
  70. 	       begin
  71. 	          sx:=sx+ax[i,j];
  72. 	          sy:=sy+ay[i,j];
  73. 	       end;
  74. 	   end;
  75. 	xbar:=sx/k1;ybar:=sy/k1;
  76.  
  77.  
  78.  
  79. 	max:=0;
  80. 	for i:=1 to k3 do 
  81. 	begin
  82. 	for j:=1 to k2 do 
  83. 	    begin
  84. 	     if b[i,j]=1 then 
  85. 	       begin
  86. 	         if sqrt((xbar-ax[i,j])*(xbar-ax[i,j])+(ybar-ay[i,j])*(ybar-ay[i,j]))>max then 
  87. 	           begin 
  88. 	             max:=sqrt((xbar-ax[i,j])*(xbar-ax[i,j])+(ybar-ay[i,j])*(ybar-ay[i,j]));      
  89. 	             a:=i;
  90. 	             b1:=j;
  91. 	           end;
  92. 	       end;
  93. 	    end;
  94. 	end;
  95.  
  96. 	if ((ax[a,b1]<xbar)and(ay[a,b1]=ybar)) then
  97. 	 begin
  98. 	   if b[a,b1+1]=1 then k1:=k1-1;
  99. 	   c[a,b1+1]:=c[a,b1+1]+c[a,b1];
  100. 	   c[a,b1]:=0;
  101. 	   b[a,b1]:=0;
  102. 	   b[a,b1+1]:=1;
  103. 	 end;
  104. 	 if ((ax[a,b1]=xbar)and(ay[a,b1]>ybar)) then
  105. 	 begin
  106. 	   if b[a-1,b1]=1 then k1:=k1-1;
  107. 	   c[a-1,b1]:=c[a-1,b1]+c[a,b1];
  108. 	   c[a,b1]:=0;
  109. 	   b[a,b1]:=0;
  110. 	   b[a-1,b1]:=1;
  111. 	 end;
  112. 	 if ((ax[a,b1]>xbar)and(ay[a,b1]=ybar)) then
  113. 	 begin
  114. 	   if b[a,b1-1]=1 then k1:=k1-1;
  115. 	   c[a,b1-1]:=c[a,b1-1]+c[a,b1];
  116. 	   c[a,b1]:=0;
  117. 	   b[a,b1]:=0;
  118. 	   b[a,b1-1]:=1;
  119. 	 end;
  120. 	 if ((ax[a,b1]=xbar)and(ay[a,b1]<ybar)) then
  121. 	 begin
  122. 	   if b[a+1,b1]=1 then k1:=k1-1;
  123. 	   c[a+1,b1]:=c[a+1,b1]+c[a,b1];
  124. 	   c[a,b1]:=0;
  125. 	   b[a,b1]:=0;
  126. 	   b[a+1,b1]:=1;
  127. 	 end;
  128.  
  129. 	if ((ax[a,b1]<xbar)and(ay[a,b1]>ybar)) then
  130. 	begin
  131. 	  if (xbar-ax[a,b1]<ay[a,b1]-ybar) then
  132. 	    begin
  133. 	      if b[a-1,b1]=1 then k1:=k1-1;
  134. 	      c[a-1,b1]:=c[a-1,b1]+c[a,b1];
  135. 	      c[a,b1]:=0;
  136. 	      b[a,b1]:=0;
  137. 	      b[a-1,b1]:=1;
  138. 	    end;
  139. 	    if (xbar-ax[a,b1]>ay[a,b1]-ybar) then
  140. 	    begin
  141. 	      if b[a,b1+1]=1 then k1:=k1-1;
  142. 	      c[a,b1+1]:=c[a,b1+1]+c[a,b1];
  143. 	      c[a,b1]:=0;
  144. 	      b[a,b1]:=0;
  145. 	      b[a,b1+1]:=1;
  146. 	    end;
  147. 	end;
  148.  
  149.  
  150. 	if ((ax[a,b1]>xbar)and(ay[a,b1]>ybar)) then
  151. 	begin
  152. 	  if (ax[a,b1]-xbar<ay[a,b1]-ybar) then
  153. 	    begin
  154. 	      if b[a-1,b1]=1 then k1:=k1-1;
  155. 	      c[a-1,b1]:=c[a-1,b1]+c[a,b1];
  156. 	      c[a,b1]:=0;
  157. 	      b[a,b1]:=0;
  158. 	      b[a-1,b1]:=1;
  159. 	    end;
  160. 	    if (ax[a,b1]-xbar>ay[a,b1]-ybar) then
  161. 	    begin
  162. 	      if b[a,b1-1]=1 then k1:=k1-1;
  163. 	      c[a,b1-1]:=c[a,b1-1]+c[a,b1];
  164. 	      c[a,b1]:=0;
  165. 	      b[a,b1]:=0;
  166. 	      b[a,b1-1]:=1;
  167. 	    end;
  168. 	end;
  169.  
  170.  
  171. 	if ((ax[a,b1]>xbar)and(ay[a,b1]<ybar)) then
  172. 	begin
  173. 	  if (ax[a,b1]-xbar<ybar-ay[a,b1]) then
  174. 	    begin
  175. 	      if b[a+1,b1]=1 then k1:=k1-1;
  176. 	      c[a+1,b1]:=c[a+1,b1]+c[a,b1];
  177. 	      c[a,b1]:=0;
  178. 	      b[a,b1]:=0;
  179. 	      b[a+1,b1]:=1;
  180. 	    end;
  181. 	    if (ax[a,b1]-xbar>ybar-ay[a,b1]) then
  182. 	    begin
  183. 	      if b[a,b1-1]=1 then k1:=k1-1;
  184. 	      c[a,b1-1]:=c[a,b1-1]+c[a,b1];
  185. 	      c[a,b1]:=0;
  186. 	      b[a,b1]:=0;
  187. 	      b[a,b1-1]:=1;
  188. 	    end;
  189. 	end;
  190.  
  191. 	if ((ax[a,b1]<xbar)and(ay[a,b1]<ybar)) then
  192. 	begin
  193. 	  if (xbar-ax[a,b1]<ybar-ay[a,b1]) then
  194. 	    begin
  195. 	      if b[a+1,b1]=1 then k1:=k1-1;
  196. 	      c[a+1,b1]:=c[a+1,b1]+c[a,b1];
  197. 	      c[a,b1]:=0;
  198. 	      b[a,b1]:=0;
  199. 	      b[a+1,b1]:=1;
  200. 	    end;
  201. 	    if (xbar-ax[a,b1]>ybar-ay[a,b1]) then
  202. 	    begin
  203. 	      if b[a,b1+1]=1 then k1:=k1-1;
  204. 	      c[a,b1+1]:=c[a,b1+1]+c[a,b1];
  205. 	      c[a,b1]:=0;
  206. 	      b[a,b1]:=0;
  207. 	      b[a,b1+1]:=1;
  208. 	    end;
  209. 	end;
  210.  
  211. 	for i:=k3 downto 1 do begin
  212. 	for j:=1 to k2 do begin
  213. 	write(c[i,j]);
  214. 	end;
  215. 	writeln;
  216. 	end;
  217. 	writeln;
  218. 	writeln;
  219. 	end;
  220. end.
Success #stdin #stdout 0s 376KB
comments (?)
stdin
copy 
4
1 2
7 1
2 4
6 5
stdout
copy 
0010
0100
1000
0010


0010
0100
1000
0100


0100
0100
1000
0100


0100
0100
1100
0000


0000
0200
1100
0000


0000
0000
1300
0000


0000
0000
0400
0000
https://ideone.com/6ZFJ8X
language:
Pascal (fpc 3.0.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!