home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol243 / autocomp.pqs / AUTOCOMP.PAS
Encoding:
Pascal/Delphi Source File  |  1986-02-10  |  3.9 KB  |  99 lines
  1. { PROGRAM AUTHOR: Mark Aldon Weiss  PROGRAM DONATED TO PUBLIC DOMAIN }
  2.  
  3. VAR
  4.  
  5. CollectionSize,NumAcquired,MaxNumAcquired: Integer;    Probability: Real;
  6.  
  7. FileName: String[12];   CollectorsResults: Text;
  8.  
  9.  
  10.  
  11.  
  12. FUNCTION  ProbComplete(NumInCollection,NumTook: integer): REAL;
  13.  
  14. Var
  15.  
  16. i,k,SumIndex,sign,bigger,smaller: Integer;
  17.  
  18. ratio,CombCoeff,PowerFactor,PartProb: Real;
  19.  
  20.  
  21. Begin  {ProbComplete}
  22. PartProb := 0;
  23. IF NumTook <  NumInCollection THEN ProbComplete := 0;
  24. IF NumTook >= NumInCollection THEN
  25.    Begin
  26.    FOR SumIndex := 1 TO (NumInCollection-1) DO
  27.        Begin
  28.        If (SumIndex MOD 2 = 0) Then sign := -1 Else sign := 1;
  29.        If ( SumIndex < (NumInCollection - SumIndex) ) THEN
  30.           begin
  31.           smaller := SumIndex;   bigger := NumInCollection - SumIndex
  32.           end
  33.        Else
  34.           begin
  35.           smaller := NumInCollection - SumIndex;   bigger := SumIndex
  36.           end;
  37.        IF  bigger = NumInCollection THEN CombCoeff := 1;
  38.        IF bigger <> NumInCollection THEN
  39.           Begin
  40.           CombCoeff := 1;
  41.           For k := 1 to smaller Do CombCoeff := CombCoeff * ( (NumInCollection - k + 1) / k )   {See Numerical Math Book}
  42.           End;
  43.        ratio := (NumInCollection - SumIndex) / NumInCollection;
  44.        PowerFactor := ratio;
  45.        For i := 1 To ( NumTook - 1 ) Do  PowerFactor := PowerFactor * ratio;
  46.        PartProb := PartProb + ( sign * CombCoeff * PowerFactor)
  47.        End;
  48.        ProbComplete := 1 - PartProb
  49.    End
  50. End;   {ProbComplete}
  51.  
  52.  
  53.  
  54.  
  55. BEGIN  { M A I N    P R O G R A M }
  56. Writeln;
  57. Writeln('This is a program to calculate the probabilities in "The Collectors Problem."');
  58. Writeln('The question posed is the following:  given so many different items in a set,');
  59. Writeln('what is the probability of getting a complete set having acquired a given');
  60. Writeln('number of items?  The assumption is that the items are randomly acquired and');
  61. Writeln('the identity of each item is independent of the previous acquisition.');
  62. Writeln;
  63. Writeln('Please give the name of a file to record the results; you may print the file.');
  64. Write('What will be the name for this file?   ');  Readln(FileName);
  65. ASSIGN(CollectorsResults,FileName);
  66. REWRITE(CollectorsResults);
  67. Writeln;
  68. Writeln(CollectorsResults);
  69. Writeln(CollectorsResults,'This is a program to calculate the probabilities in "The Collectors Problem."');
  70. Writeln(CollectorsResults,'The question posed is the following:  given so many different items in a set,');
  71. Writeln(CollectorsResults,'what is the probability of getting a complete set having acquired a given');
  72. Writeln(CollectorsResults,'number of items?  The assumption is that the items are randomly acquired and');
  73. Writeln(CollectorsResults,'the identity of each item is independent of the previous acquisition.');
  74. Writeln(CollectorsResults);    Writeln(CollectorsResults);
  75. REPEAT
  76.   Writeln;
  77.   Write(' Give number in collection [zero to stop] ----->   ');
  78.   Readln(CollectionSize);
  79.   IF CollectionSize <> 0 THEN Write(' Give maximum number of aquistions ------------>   ');
  80.   IF CollectionSize <> 0 THEN Readln(MaxNumAcquired);
  81.   Writeln;     Writeln(CollectorsResults);
  82.   FOR NumAcquired := CollectionSize to MaxNumAcquired DO
  83.     Begin
  84.     IF CollectionSize > 0 THEN Probability := ProbComplete(CollectionSize,NumAcquired) ELSE Probability := 0;
  85.     IF CollectionSize > 0 THEN
  86.        Begin
  87.        Write(CollectorsResults,' FOR:  ',CollectionSize,' IN COLLECTION, ',NumAcquired,' ACQUISITIONS;  PROBABILITY =');
  88.        Writeln(CollectorsResults,Probability);
  89.        Write(' FOR:  ',CollectionSize,' IN COLLECTION, ',NumAcquired,' ACQUISITIONS;  PROBABILITY =');
  90.        Writeln(Probability)
  91.        End
  92.   End;
  93. Writeln;  Writeln;
  94. UNTIL CollectionSize = 0;
  95. CLOSE(CollectorsResults)
  96. END.   { M A I N    P R O G R A M }
  97.  
  98.  
  99.