Tl3.pas 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206
  1. {$N+}
  2. const maxn=100;
  3. maxm=9997;
  4. zero=1e-6;
  5. type t1=^t2;
  6. t2=record
  7. id:extended;
  8. f:integer;
  9. nt:t1;
  10. end;
  11. type t=array[1..maxn] of integer;
  12. var a:t;
  13. i,f,n,m:integer;
  14. w:array[0..maxm] of t1;
  15. j,pp:longint;
  16. function fmod(aa:extended;bb:longint):longint;
  17. var cc:extended;
  18. begin
  19. cc:=int(aa/bb);
  20. fmod:=trunc(aa-bb*cc);
  21. end;
  22. function find(ww:extended):integer;
  23. var tt:t1;
  24. u:longint;
  25. begin
  26. u:=fmod(ww,maxm);
  27. tt:=w[u];
  28. if tt=nil then
  29. begin
  30. find:=-1;exit;
  31. end;
  32. while (abs(tt^.id-ww)>zero) and (tt^.nt<>nil) do
  33. tt:=tt^.nt;
  34. if abs(tt^.id-ww)<=zero then
  35. find:=tt^.f
  36. else
  37. find:=-1;
  38. end;
  39. procedure add(ww:extended;f:integer);
  40. var tt:t1;
  41. u:longint;
  42. begin
  43. u:=fmod(ww,maxm);
  44. tt:=w[u];
  45. if w[u]=nil then
  46. begin
  47. new(w[u]);
  48. w[u]^.id:=ww;
  49. w[u]^.f:=f;
  50. w[u]^.nt:=tt;
  51. exit;
  52. end;
  53. end;
  54. function solve(a:t):integer;
  55. var b,c:t;
  56. f,tmp,p,q,i,j,k,ss,s,s1,max:integer;
  57. ww:extended;
  58. begin
  59. ww:=0;
  60. for i:=1 to n do
  61. ww:=ww*pp+a[i]-1;
  62. f:=find(ww);
  63. if f>=0 then
  64. begin
  65. solve:=f;exit;
  66. end;
  67. f:=0;max:=0;q:=0;s:=0;
  68. for i:=1 to n do
  69. begin
  70. inc(s,a[i]);
  71. if a[i]>max then
  72. begin
  73. max:=a[i];q:=i;
  74. end;
  75. end;
  76. p:=0;
  77. for i:=1 to n do
  78. if a[i]=max then
  79. inc(p);
  80. if p>=2 then
  81. begin
  82. if p=n then
  83. begin
  84. add(ww,1);solve:=1;exit;
  85. end;
  86. if (p>2) or (m>n/2) then
  87. begin
  88. add(ww,0);solve:=0;exit;
  89. end;
  90. k:=0;p:=0;
  91. for i:=1 to n do
  92. if a[i]<max then
  93. begin
  94. if p=0 then
  95. p:=a[i]
  96. else
  97. if a[i]<>p then begin
  98. add(ww,0);solve:=0;exit;
  99. end;
  100. end
  101. else
  102. begin
  103. inc(k);b[k]:=i;
  104. end;
  105. if 2*p<=max then
  106. begin
  107. add(ww,q);solve:=q;exit;
  108. end;
  109. if n>4 then
  110. begin
  111. add(ww,0);solve:=0;exit;
  112. end;
  113. for i:=1 to n do c[i]:=a[i];
  114. c[b[1]]:=s-3*max;
  115. f:=solve(c);
  116. if b[2]<b[1] then
  117. inc(f,b[1]-b[2])
  118. else
  119. inc(f,n+b[1]-b[2]);
  120. c[b[1]]:=max;
  121. c[b[2]]:=s-3*max;
  122. tmp:=solve(c);
  123. if b[1]<b[2] then
  124. inc(tmp,b[2]-b[1])
  125. else
  126. inc(tmp,n+b[2]-b[1]);
  127. if tmp<f then f:=tmp;
  128. add(ww,f);solve:=f;exit;
  129. end;
  130. for i:=1 to n do
  131. if i<q then
  132. b[i]:=a[i]
  133. else
  134. if i>q then
  135. b[i-1]:=a[i];
  136. for i:=1 to n-2 do
  137. for j:=i+1 to n-1 do
  138. if b[i]<b[j] then
  139. begin
  140. tmp:=b[i];b[i]:=b[j];b[j]:=tmp;
  141. end;
  142. ss:=0;
  143. for i:=1 to m do inc(ss,b[i]);
  144. for i:=m+1 to n-1 do dec(ss,b[i]);
  145. if a[q]<>ss then
  146. begin
  147. add(ww,0);solve:=0;exit;
  148. end;
  149. max:=b[1];dec(s,a[q]);
  150. for i:=1 to m do b[i]:=i;
  151. for i:=1 to n do c[i]:=a[i];
  152. while true do
  153. begin
  154. j:=2;s1:=0;
  155. for i:=1 to m do
  156. begin
  157. inc(s1,a[b[i]]);
  158. if b[i]=q then j:=1;
  159. end;
  160. if j=1 then s1:=s-s1+a[q];
  161. if (2*s1>s) and (2*s1-s<a[q]) then
  162. begin
  163. c[q]:=2*s1-s;
  164. if c[q]>=max then begin
  165. add(ww,0);solve:=0;exit;
  166. end;
  167. p:=solve(c);
  168. if p=0 then
  169. begin
  170. add(ww,0);solve:=0;exit;
  171. end;
  172. i:=p mod n;
  173. if i=0 then i:=n;
  174. if i<q then
  175. inc(p,q-i)
  176. else
  177. inc(p,n+q-i);
  178. if p>f then f:=p;
  179. end;
  180. i:=m;
  181. while (i>0) and (b[i]+m-i+1>n) do dec(i);
  182. if i=0 then break;
  183. inc(b[i]);
  184. for j:=i+1 to m do b[j]:=b[j-1]+1;
  185. end;
  186. if f=0 then f:=q;
  187. add(ww,f);solve:=f;
  188. end;
  189. begin
  190. for j:=0 to maxm do w[j]:=nil;
  191. read(n,m);pp:=0;
  192. for i:=1 to n do
  193. begin
  194. read(a[i]);
  195. if a[i]>pp then pp:=a[i];
  196. end;
  197. f:=solve(a);
  198. if f=0 then
  199. writeln('No one can guess his number.')
  200. else
  201. begin
  202. i:=f mod n;
  203. if i=0 then i:=n;
  204. writeln('The student ',i,' can guess his number at round ',f);
  205. end;
  206. end.