home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / QBNWS301.ZIP / BALLS.ZIP / WINNERS.BAS < prev   
Encoding:
BASIC Source File  |  1992-01-04  |  6.2 KB  |  148 lines

  1. DIM ball(12), attribute$(12)      'Set up 12 balls and attributes
  2. RANDOMIZE TIMER                   'Seed the RND function
  3. '
  4. begin:                            '
  5. FOR x = 1 TO 12                   'Give each ball an initial
  6.     ball(x) = 1                   ' weight of 1 and an initial
  7.     attribute$(x) = " equal"      ' attribute of "equal"
  8. NEXT x                            '
  9. oddball = INT(RND * 12) + 1       'Pick the odd ball randomly
  10. IF RND < .5 THEN                  'Pick the odd ball's weight:
  11.     oddweight = .9                ' a little less
  12. ELSE                              ' or
  13.     oddweight = 1.1       ' a little more
  14. END IF                    ' than the others
  15. ball(oddball) = oddweight 'Give the odd ball its odd weight
  16. '
  17. 'Not very elegant but functional solution from
  18. 'Jim Eccleston
  19. '241 East 19th Street
  20. 'North Vancouver, BC
  21. 'V7L 2Z1  CANADA
  22. '604-988-7597
  23. '
  24. sw1 = ball(1) + ball(2) + ball(3) ' composite weights for comparison
  25. sw2 = ball(9) + ball(10) + ball(11)
  26. sw3 = ball(5) + ball(6) + ball(7)
  27. sw4 = ball(2) + ball(3) + ball(4)
  28. sw5 = ball(10) + ball(11) + ball(12)
  29. w1 = sw3 + ball(8): w2 = sw2 + ball(12)
  30. w3 = sw2 + ball(5): w4 = sw1 + ball(12)
  31. w5 = sw3 + ball(9): w6 = sw1 + ball(8)
  32. '
  33. '
  34. IF w1 > w2 THEN 100       'Do 1st level weigh
  35. IF w2 > w1 THEN 200
  36.                           'Bad penny not on scale with w1 and w2
  37. IF sw4 > sw5 THEN 40      'Do 2nd level weigh for equal 1st level
  38. IF sw5 > sw4 THEN 60
  39.                           'Bad penny not on scale with sw4 and sw5
  40.                           ' - must be 1,2,3 or 4
  41.                           'Check 1 first for overweight
  42.                           '
  43. IF ball(1) > ball(12) THEN id = 1: GOTO 2000
  44.                           '
  45.                           'Check 1 for underweight
  46.                           '
  47. IF ball(12) > ball(1) THEN id = 1: GOTO 1000
  48.                           '
  49.                           'Bad penny is overweight 2,3 or 4
  50.                           '
  51. 40 IF ball(3) > ball(4) THEN id = 3: GOTO 2000
  52. IF ball(4) > ball(3) THEN id = 4: GOTO 2000
  53.         id = 2: GOTO 2000
  54.                           'Bad penny is underweight 2,3 or 4
  55.                           '
  56. 60 IF ball(3) > ball(4) THEN id = 4: GOTO 1000
  57. IF ball(4) > ball(3) THEN id = 3: GOTO 1000
  58.         id = 2: GOTO 1000
  59.                           'Here if original left side was heavier
  60.                           'Change weight sets and re-weigh
  61.                           '
  62. 100 IF w3 > w4 THEN 140   '2nd level weigh for heavy left 1st weigh
  63. IF w4 > w3 THEN 160
  64. IF ball(7) > ball(8) THEN id = 7: GOTO 2000
  65. IF ball(8) > ball(7) THEN id = 8: GOTO 2000
  66.         id = 6: GOTO 2000
  67.                           '
  68.                           'Here if new left side is heavier
  69.                           '
  70.                           '
  71.                           '3rd level weigh here
  72. 140 IF ball(5) > ball(1) THEN id = 5: GOTO 2000
  73. IF ball(1) = ball(5) THEN id = 12: GOTO 1000
  74.                           '
  75.                           '
  76.                           '3rd level weigh here
  77. 160 IF ball(10) > ball(11) THEN id = 11: GOTO 1000
  78. IF ball(11) > ball(10) THEN id = 10: GOTO 1000
  79.         id = 9: GOTO 1000
  80.                           'Here if new right side is heavier
  81.                           '
  82.                           'change weight sets and re-weigh
  83.                           '
  84. 200 IF w5 > w6 THEN 240   '2nd level weigh for right heavy 1st weigh
  85. IF w6 > w5 THEN 260
  86. IF ball(11) > ball(12) THEN id = 11: GOTO 2000
  87. IF ball(12) > ball(11) THEN id = 12: GOTO 2000
  88.         id = 10: GOTO 2000
  89.                           '
  90.                           'Here if new left side is heavier
  91.                           '
  92.                           '
  93.                           '3rd level weigh here
  94. 240 IF ball(9) > ball(1) THEN id = 9: GOTO 2000
  95. IF ball(1) = ball(9) THEN id = 8: GOTO 1000
  96.                           '
  97.                           'Here if new right side is heavier
  98.                           '
  99.                           '
  100.                           '3rd level weigh here
  101. 260 IF ball(6) > ball(7) THEN id = 7: GOTO 1000
  102. IF ball(7) > ball(6) THEN id = 6: GOTO 1000
  103.         id = 5: GOTO 1000
  104.                           ' 
  105.                           'Print results and loop
  106.                           '
  107. 1000 PRINT "Oddball= "; oddball; " Ball"; id; " weighed LO "; ball(id)
  108.         GOTO begin:
  109. '
  110. 2000 PRINT "Oddball= "; oddball; " Ball"; id; " weighed HI "; ball(id)
  111.         GOTO begin:
  112. '
  113. '
  114. 'Flowchart for weighing sequence structure above follows, with balls
  115. 'represented by alpha characters A thru L. ( I was less confused! )
  116. '
  117. 'Letters shown in the balance pans. Outcome is Left, Balanced, Right
  118. 'L suffix in letter pairs = underweight, H suffix = overweight
  119. '
  120. '1st Level Weighing   
  121. '                               +------+------+
  122. '                               | EFGH | IJKL |
  123. '                               +------+------+
  124. '                                      |
  125. '                  +-------------------+---------------------+
  126. '2nd Level         |                   |                     |
  127. '           +------+------+      +-----+-----+        +------+------+
  128. '           | IJKE | LABC |      | BCD | JKL |        | EFGI | HABC |
  129. '           +------+------+      +-----+-----+        +------+------+
  130. '            |     |     |        |    |    |          |     |     |
  131. '3rd Level   |     |     |        |    |    |          |    /      |
  132. '        +---+---+ | +---+---+    |    |    |    +---+---+ | +---+---+
  133. '        | J | K | | | E | A |    |    |    |    | F | G | | | I | A |
  134. '        +---+---+ | +---+---+    |    |    |    +---+---+ | +---+---+
  135. '        KL IL JL  |  EH LL *     |    |    |    GL EL FL  |  IH HL  *
  136. '                  |             /     |     \              \
  137. '              +---+---+        /      |      \          +---+---+
  138. '              | G | H |       /       |       \         | K | L |
  139. '              +---+---+      /        |        \        +---+---+
  140. '             GH  FH  HH     |         |         |       KH  JH  LH
  141. '                     +---+---+    +---+---+    +---+---+
  142. '                     | C | D |    | A | L |    | C | D |
  143. '                     +---+---+    +---+---+    +---+---+
  144. '                     CH BH DH     AH  *  AL    DL BL CL
  145. ' * = Innaplicable
  146. '
  147.  
  148.