DECLARE FUNCTION Fact! (x!)
DECLARE FUNCTION IC% (n%, k%)
'*************************************************************
'* Evaluate probabilities by parsing a string expression     *
'*        and performing the implied calculations            *
'* --------------------------------------------------------- *
'* SAMPLE RUN:                                               *
'*                                                           *
'* Type expression to be evaluated (no syntax checking).     *
'* Example: 1-c(10,0,0.2)-c(10,1,0.2)                        *
'*                                                           *
'* "c(10,0,.1)+c(10,1,0.1)+c(10,2,0.1)"                      *
'*                                                           *
'* C( 10 , 0 ) = 1                                           *
'* C( 10 , 1 ) = 10                                          *
'* C( 10 , 2 ) = 45                                          *
'* probability = 0.9298                                      *
'*                                                           *
'* --------------------------------------------------------- *
'* Ref.: "Problem Solving with Fortran 90 By David R.Brooks, *
'*        Springer-Verlag New York, 1997".                   *
'*                                                           *
'*                      Basic Release By J-P Moreau, Paris.  *
'*                               (www.jpmoreau.fr)           *
'*************************************************************
'Explanations:
'------------
'   A manufacturer's experience has shown that 10% of all integrated
' circuits (ICs) will be defective. Because of this high failure rate,
' a quality control engineer monitors the manufacturing process by
' testing random samples every day. What is the probability that:
'   (a) exactly two ICs in a sample of 10 will be defective?
'   (b) at least two will be defective?
'   (c) no more than two will be defective?
' Answers:
' (a) the probability that a particular sample of 10 will contain
'                                     2     8
' exactly two defective ICs is:  (0.1) (0.9) = 0.004305. However,
' there are C(10,2)=45 possible combinations of two defective and eight
' good ICs. From probability theory, the number of combinations of n
' things taken k at a time is:  C(n,k) = n!/[k!(n-k)!]  where
' ! indicates the factorial function (n! = 1 x 2 x3 x ....n). Therefore,
' the probability that a sample of 10 will contain exactly two defects
' is:                          2     8
'          P(=2) = C(10,2)(0.1) (0.9)  = 45 x 0.004305 = 0.1937
'
' (b) the probability of finding at least two defective ICs is equal to
'  1 minus the probability of 0 defective IC minus the probability of
'  1 defective IC:              0     10              1     9
'      P(>=2) = 1 - C(10,0)(0.1) (0.9)  - C(10,0)(0.1) (0.9) = 0.2639
'
' (Reemeber that 0! = 1 by definition.)
'
' (c) the probability of finding no more than two defective ICs is:
'                           0     10              1     9
'      P(<=2) = C(10,0)(0.1) (0.9)  + C(10,1)(0.1) (0.9)
'                             2     8
'               + C(10,2)(0.1) (0.9) = 0.9298  
'
' For example, for part (b) of the problem, the user will type the
' string:  '1-c(10,0,.1)-c(10,1,.1)'.
'-----------------------------------------------------------------------
'Program Prob

DEFINT I-N

DIM a AS STRING       'string to be calculated
DIM s AS STRING
DIM s1 AS STRING

' i, j, k, length, n, isign, left: Integer
' probability, proba: Real

  CLS
  PRINT
  PRINT " Type expression to be evaluated (no syntax checking)."
  PRINT " Example: 1-c(10,0,0.2)-c(10,1,0.2)"
  PRINT
  INPUT " ", a

  PRINT

  length = LEN(a)
  probability = 0!
  IF MID$(a, 1, 1) = "1" THEN probability = 1!
  isign = 1   'a leading + sign is optional
  FOR i = 1 TO length
    IF MID$(a, i, 1) = "+" THEN isign = 1
    IF MID$(a, i, 1) = "-" THEN isign = -1
    IF MID$(a, i, 1) = "(" THEN left = i
    IF MID$(a, i, 1) = ")" THEN
      'Read(a(left+1:i-1),*) n, k, prob_a
      s = ""
      FOR j = left + 1 TO i
	s = s + MID$(a, j, 1)
      NEXT j
      s1 = "": j = 1
      WHILE MID$(s, j, 1) <> "," AND MID$(s, j, 1) <> ")"
	s1 = s1 + MID$(s, j, 1): j = j + 1
      WEND
      n = VAL(s1)
      s1 = "": j = j + 1
      WHILE MID$(s, j, 1) <> "," AND MID$(s, j, 1) <> ")"
	s1 = s1 + MID$(s, j, 1): j = j + 1
      WEND
      k = VAL(s1)
      s1 = "": j = j + 1
      WHILE MID$(s, j, 1) <> "," AND MID$(s, j, 1) <> ")"
	s1 = s1 + MID$(s, j, 1): j = j + 1
      WEND
      PRINT
      proba = VAL(s1)
      probability = probability + isign * IC(n, k) * proba ^ k * (1! - proba) ^ (n - k)
      PRINT " C("; n; ","; k; ") = "; IC(n, k)
    END IF
  NEXT i
  F$ = "##.####"
  PRINT " probability = ";
  PRINT USING F$; probability

END 'of main program



FUNCTION Fact (x)
' Calculate x!
  prod = 1!
  ix = INT(x)
  FOR i = 2 TO ix
    prod = prod * i
  NEXT i
  Fact = prod
END FUNCTION

FUNCTION IC (n, k)
' Calculate combinations of n things taken k at a time
  denom = Fact(1! * k) * Fact(1! * (n - k))
  temp = Fact(1! * n) / denom
  IC = INT(temp)
END FUNCTION