Mondial.pas

Un article de Wikipedia.

Version du 10 mars 2008 à 11:34 par Ziglooadmin (Discuter | Contributions)
(diff) ← Version précédente | voir la version courante (diff) | Version suivante → (diff)
  1. program Mondial;
  2. type resultat=(perdu,nul,gagne);
  3. dataptr = ^data;
  4. data =record
  5. valeur:integer;
  6. suivant:dataptr;
  7. quantite:integer;
  8. end;
  9.  
  10. var ab,ac,ad,bc,bd,cd:resultat;
  11. a,b,c,d,n:integer;
  12. scores:dataptr;
  13. ensemble:dataptr;
  14. function dataaddsort(premier:dataptr;d:integer;distinct:boolean):dataptr;
  15. var precedent,actuel,tempptr:dataptr;
  16. begin
  17. if premier = nil then
  18. begin
  19. new(premier);
  20. with premier^ do
  21. begin
  22. valeur:=d;
  23. quantite:=1;
  24. suivant:=nil;
  25. end;
  26. end
  27. else
  28. begin
  29. precedent:=nil;
  30. actuel:=premier;
  31. while (actuel^.suivant <> nil) and (d <= actuel^.valeur) do
  32. begin
  33. precedent:=actuel;
  34. actuel:=actuel^.suivant;
  35. end;
  36. if d < actuel^.valeur then
  37. begin
  38. new(actuel^.suivant);
  39. with actuel^.suivant^ do
  40. begin
  41. valeur:=d;
  42. quantite:=1;
  43. suivant:=nil;
  44. end;
  45. end
  46. else if d = actuel^.valeur then
  47. begin
  48. if distinct = true then
  49. begin
  50. new(actuel^.suivant);
  51. with actuel^.suivant^ do
  52. begin
  53. valeur:=d;
  54. quantite:=1;
  55. suivant:=nil;
  56. end;
  57. end
  58. else
  59. with actuel^ do
  60. quantite:=quantite+1;
  61. end
  62. else // d>actuel^.valeur
  63. begin
  64. if precedent = nil then
  65. begin
  66. new(precedent);
  67. with precedent^ do
  68. begin
  69. valeur:=d;
  70. quantite:=1;
  71. suivant:=actuel;
  72. end;
  73. premier:=precedent;
  74. end
  75. else if d = precedent^.valeur then
  76. begin
  77. if distinct = true then
  78. begin
  79. new(tempptr);
  80. with tempptr^ do
  81. begin
  82. valeur:=d;
  83. quantite:=1;
  84. suivant:=actuel;
  85. end;
  86. precedent^.suivant:=tempptr;
  87. end
  88. else
  89. with precedent^ do
  90. quantite:=quantite+1;
  91. end
  92. else
  93. begin
  94. new(tempptr);
  95. with tempptr^ do
  96. begin
  97. valeur:=d;
  98. quantite:=1;
  99. suivant:=actuel;
  100. end;
  101. precedent^.suivant:=tempptr;
  102. end;
  103. end;
  104. end;
  105. dataaddsort:=premier;
  106. end;
  107. function datasize(premier:dataptr):integer;
  108. var size:integer;
  109. actuel:dataptr;
  110. begin
  111. if premier = nil then
  112. datasize:=0
  113. else
  114. begin
  115. size:=1;
  116. actuel:=premier;
  117. while actuel^.suivant <> nil do
  118. begin
  119. actuel:=actuel^.suivant;
  120. size:=size+1;
  121. end;
  122. datasize:=size;
  123. end;
  124. end;
  125. function dataclear(premier:dataptr):dataptr;
  126. var actuel,precedent:dataptr;
  127. begin
  128. if premier <> nil then
  129. begin
  130. actuel:=premier;
  131. while actuel^.suivant <> nil do
  132. begin
  133. precedent:=actuel;
  134. actuel:=actuel^.suivant;
  135. dispose(precedent);
  136. end;
  137. dispose(actuel);
  138. end;
  139. dataclear:=nil;
  140. end;
  141. function dataconvert(premier:dataptr):integer;
  142. var resultat:integer;
  143. actuel:dataptr;
  144. begin
  145. if premier <> nil then
  146. begin
  147. resultat:=0;
  148. actuel:=premier;
  149. while actuel^.suivant <> nil do
  150. begin
  151. resultat:=10*resultat+actuel^.valeur;
  152. actuel:=actuel^.suivant;
  153. end;
  154. resultat:=10*resultat+actuel^.valeur;
  155. dataconvert:=resultat;
  156. end
  157. else
  158. dataconvert:=-1;
  159. end;
  160. procedure dataprint(premier:dataptr);
  161. var actuel:dataptr;
  162. n:integer;
  163. begin
  164. if premier <> nil then
  165. begin
  166. n:=0;
  167. actuel:=premier;
  168. while actuel^.suivant <> nil do
  169. begin
  170. with actuel^ do
  171. begin
  172. write(valeur,' [',quantite:3,'] ');
  173. end;
  174. if n mod 3 = 2 then
  175. writeln;
  176. actuel:=actuel^.suivant;
  177. n:=n+1;
  178. end;
  179. with actuel^ do
  180. begin
  181. writeln(valeur,' [',quantite:3,']');
  182. end;
  183. end;
  184. end;
  185. function point(r:resultat):integer;
  186. begin
  187. case r of
  188. perdu:point:=0;
  189. nul:point:=1;
  190. gagne:point:=3;
  191. end;
  192. end;
  193. function pointadv(r:resultat):integer;
  194. begin
  195. case r of
  196. perdu:pointadv:=point(gagne);
  197. nul:pointadv:=point(nul);
  198. gagne:pointadv:=point(perdu);
  199. end;
  200. end;
  201. begin
  202. n:=0;
  203. for ab:=perdu to gagne do
  204. for ac:=perdu to gagne do
  205. for ad:=perdu to gagne do
  206. for bc:=perdu to gagne do
  207. for bd:=perdu to gagne do
  208. for cd:=perdu to gagne do
  209. begin
  210. a:=point(ab)+point(ac)+point(ad);
  211. b:=pointadv(ab)+point(bc)+point(bd);
  212. c:=pointadv(ac)+pointadv(bc)+point(cd);
  213. d:=pointadv(ad)+pointadv(bd)+pointadv(cd);
  214. scores:=dataaddsort(scores,a,true);
  215. scores:=dataaddsort(scores,b,true);
  216. scores:=dataaddsort(scores,c,true);
  217. scores:=dataaddsort(scores,d,true);
  218. ensemble:=dataaddsort(ensemble,dataconvert(scores),false);
  219. scores:=dataclear(scores);
  220. n:=n+1;
  221. end;
  222. writeln('Scores possibles au Mondial 2006');
  223. writeln('--------------------------------');
  224. writeln;
  225. dataprint(ensemble);
  226. writeln;
  227. writeln('Nombre de scores possibles : ',datasize(ensemble));
  228. end.