GAME.PAS 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187
  1. var
  2. n : integer;
  3. number : integer;
  4. sym : char;
  5. procedure gamerule;
  6. begin
  7. writeln; writeln; writeln; writeln; writeln; writeln;
  8. writeln('Hi! You are now in a funny game. There are n balls. One of them is different ');
  9. writeln('from the others -- it can be either heavier or lighter.');
  10. writeln;
  11. writeln('You should select the special ball and whether it''s heavier or lighter in mind.');
  12. writeln;
  13. writeln('The computer will ask you some questions. For each question, two sets of balls ');
  14. writeln('will be given, and you should answer which set is');
  15. writeln(' heavier or that they are of the same weight.');
  16. writeln;
  17. writeln('At the end, the computer will tell which ball is special, and whether it is ');
  18. writeln('heavier or lighter.');
  19. writeln('The computer will ask the least number of questions possible during a game');
  20. writeln('session.');
  21. writeln;
  22. writeln('Now, have the special ball number in your mind and enter the number of balls:');
  23. readln(n);
  24. writeln;
  25. end;
  26. procedure show(s, t : integer);
  27. var
  28. i : integer;
  29. begin
  30. for i := s to t do
  31. write(' ', i);
  32. end;
  33. procedure difball(s0, t0, s1, t1 : integer);
  34. var
  35. l0, l1 : integer;
  36. part0, part1 : integer;
  37. p : integer;
  38. begin
  39. l0 := t0 - s0 + 1;
  40. l1 := t1 - s1 + 1;
  41. if l0 = 0 then begin
  42. number := s1;
  43. sym := 'L'
  44. end else if l1 = 0 then begin
  45. number := s0;
  46. sym := 'H';;
  47. end else if (l0 = 1) and (l1 = 1) then begin
  48. write('Set 1 : '); writeln(s0);
  49. write('Set 2 : '); writeln(n);
  50. write('Enter which set is heavier (1 or 2) or 0 if same : ');
  51. readln(p);
  52. if p = 1 then begin
  53. number := s0;
  54. sym := 'H'
  55. end else if p = 0 then begin
  56. number := s1;
  57. sym := 'L';
  58. end;
  59. end else if (l0 = 1) and (l1 = 2) then begin
  60. write('Set 1 : '); writeln(s1);
  61. write('Set 2 : '); writeln(t1);
  62. write('Enter which set is heavier (1 or 2) or 0 if same : ');
  63. readln(p);
  64. if p = 0 then begin
  65. number := s0;
  66. sym := 'H';
  67. end else if p = 1 then begin
  68. number := t1;
  69. sym := 'L';
  70. end else if p = 2 then begin
  71. number := s1;
  72. sym := 'L';
  73. end;
  74. end else if (l0 = 2) and (l1 = 1) then begin
  75. write('Set 1 : '); writeln(s0);
  76. write('Set 2 : '); writeln(t0);
  77. write('Enter which set is heavier (1 or 2) or 0 if same : ');
  78. readln(p);
  79. if p = 0 then begin
  80. number := s1;
  81. sym := 'L';
  82. end else if p = 1 then begin
  83. number := s0;
  84. sym := 'H';
  85. end else if p = 2 then begin
  86. number := t0;
  87. sym := 'H';
  88. end;
  89. end else begin
  90. if l0 mod 3 <> 2 then
  91. part0 := l0 div 3
  92. else
  93. part0 := l0 div 3 + 1;
  94. if l1 mod 3 <> 2 then
  95. part1 := l1 div 3
  96. else
  97. part1 := l1 div 3 + 1;
  98. if (l0 mod 3 = 1) and (l1 mod 3 = 1) then
  99. part1 := l1 div 3 + 1;
  100. write('Set 1 :');
  101. show(s0, s0 + part0 - 1);
  102. show(s1 + part1, s1 + 2 * part1 - 1);
  103. writeln;
  104. write('Set 2 :');
  105. show(s0 + part0, s0 + 2 * part0 - 1);
  106. show(s1, s1 + part1 - 1);
  107. writeln;
  108. write('Enter which set is heavier (1 or 2) or 0 if same : ');
  109. readln(p);
  110. if p = 1 then
  111. difball(s0, s0 + part0 - 1, s1, s1 + part1 - 1)
  112. else if p = 2 then
  113. difball(s0 + part0, s0 + 2 * part0 - 1, s1 + part1, s1 + 2 * part1 - 1)
  114. else if p = 0 then
  115. difball(s0 + part0 * 2, t0, s1 + part1 * 2, t1);
  116. end;
  117. end;
  118. procedure sameball(s, t : integer);
  119. var
  120. part, p : integer;
  121. l, l1, l2 : integer;
  122. begin
  123. l := t - s + 1;
  124. l1 := l div 3;
  125. if l mod 3 <> 0 then l2 := l1 + 1 else l2 := l1;
  126. write('Set 1 :');
  127. show(s, s + l1 - 1);
  128. if l2 > l1 then writeln(' 1') else writeln;
  129. write('Set 2 :');
  130. show(s + l1, s + l1 + l2 - 1);
  131. writeln;
  132. write('Enter which set is heavier (1 or 2) or 0 if same : ');
  133. readln(p);
  134. if p = 0 then
  135. sameball(s + l1 + l2, t)
  136. else if p = 1 then
  137. difball(s, s + l1 - 1, s + l1, s + l1 + l2 - 1)
  138. else if p = 2 then
  139. difball(s + l1, s + l1 + l2 - 1, s, s + l1 - 1);
  140. end;
  141. procedure main;
  142. var
  143. part, p : integer;
  144. begin
  145. if n mod 3 = 2 then
  146. part := n div 3 + 1
  147. else
  148. part := n div 3;
  149. write('Set 1 :'); show(1, part); writeln;
  150. write('Set 2 :'); show(part + 1, 2 * part); writeln;
  151. write('Enter which set is heavier (1 or 2) or 0 if same : ');
  152. readln(p);
  153. if p = 0 then
  154. sameball(part * 2 + 1, n)
  155. else if p = 1 then
  156. difball(1, part, part + 1, 2 * part)
  157. else if p = 2 then
  158. difball(part + 1, 2 * part, 1, part);
  159. end;
  160. procedure print;
  161. begin
  162. writeln('The ordinal number of the special ball is : '); writeln(number, '.');
  163. write('It is ');
  164. if sym = 'H' then
  165. writeln('heavier than the others.')
  166. else
  167. writeln('lighter than the others.');
  168. end;
  169. begin
  170. gamerule;
  171. main;
  172. print;
  173. end.