home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / praxis / chancen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-04  |  2.3 KB  |  80 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     CHANCEN.PAS                        *)
  3. (*        (c) 1989  Heinz Hagemeyer  &  TOOLBOX           *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM Chancen_im_Lotto;
  6.  
  7. USES Crt;
  8.  
  9. PROCEDURE Eingabe (VAR n, k : LONGINT);
  10. BEGIN
  11.   ClrScr;
  12.   WriteLn ('Dieses Programm berechnet n über k. ',
  13.            'Diese Berechnung wird z.B. benötigt, um');
  14.   WriteLn ('die Chancen im Lotto zu ermitteln');
  15.   WriteLn;
  16.   Write   ('Geben Sie n (Anzahl der Felder) ein : ');
  17.   ReadLn (n);
  18.   Write   ('Geben Sie k (Anzahl der Kreuze) ein : ');
  19.   ReadLn (k);
  20. END;
  21.  
  22. FUNCTION N_ueber_K (n, k : LONGINT) : LONGINT;
  23. VAR
  24.   i, Ergebnis, Teiler : LONGINT;
  25. BEGIN
  26.   Ergebnis := 1;
  27.   Teiler   := 2;
  28.   FOR i    := n - k + 1 TO n DO BEGIN
  29.     IF Ergebnis > MaxLongInt DIV i THEN BEGIN
  30.       WriteLn;
  31.       Writeln ('Zahlenbereich überschritten, ',
  32.                'Programm wird abgebrochen !');
  33.       Halt ;
  34.     END;
  35.     Ergebnis := Ergebnis *i;
  36.     WHILE (Ergebnis MOD Teiler = 0) AND
  37.           (Teiler <= k) DO BEGIN
  38.       Ergebnis := Ergebnis DIV Teiler;
  39.       Inc (Teiler, 1);
  40.     END;
  41.   END;
  42.   N_ueber_K := Ergebnis;
  43. END;
  44.  
  45. CONST Nmax   = 6;
  46.  
  47. VAR Ergebnis            : ARRAY [0 .. Nmax] OF LONGINT;
  48.     Summe, k, n, i,
  49.     Gewinn, Hauptgewinn : LONGINT;
  50. BEGIN
  51.  
  52.        { Test für Abbruch bei Zahlenbereichsüberschreitung }
  53.        { WriteLn(n_ueber_k (100,30));                      }
  54.  
  55.   Eingabe (n, k);
  56.   FOR i := 0 TO k DO
  57.     Ergebnis [i] := n_ueber_k (6,i) * n_ueber_k (43,6-i);
  58.   WriteLn;  WriteLn;
  59.  
  60.   WriteLn ('Es gibt bei diesem Spiel');  WriteLn;
  61.   FOR i := 0 TO k DO
  62.     WriteLn (Ergebnis [i]:15, ' mal', i:3, ' Richtige');
  63.   WriteLn;
  64.   HauptGewinn := n_ueber_k (n,k);
  65.  
  66.   Write ('Bei wieviel Richtigen erfogt ein Gewinn? : ');
  67.   ReadLn (Gewinn);
  68.  
  69.   Summe := 0;
  70.   FOR i := Gewinn TO k DO Summe := Summe + Ergebnis [i];
  71.   WriteLn;  WriteLn;
  72.   WriteLn ('Ihre Chancen, etwas zu gewinnen, betragen 1 : ',
  73.             HauptGewinn / Summe :6:2);
  74.   WriteLn;
  75.   WriteLn ('Die Chancen des Hauptgewinns liegen bei 1 : ',
  76.             HauptGewinn);
  77. END.
  78. (* ------------------------------------------------------ *)
  79. (*                 Ende von CHANCEN.PAS                   *)
  80.