home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / procs / weighted.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  88 lines
  1. ############################################################################
  2. #
  3. #       File:     weighted.icn
  4. #
  5. #       Subject:  Procedure to shuffle list with randomness
  6. #
  7. #       Author:   Erik Eid
  8. #
  9. #       Date:     May 23, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #     WeightedShuffle returns the list "sample" with only a portion of the
  18. # elements switched.  Examples:
  19. #
  20. #     L := WeightedShuffle (X, 100)   - returns a fully shuffled list
  21. #     L := WeightedShuffle (X, 50)    - every other element is eligible to
  22. #                                       be switched
  23. #     L := WeightedShuffle (X, 25)    - every fourth element is shuffled
  24. #     L := WeightedShuffle (X, 0)     - nothing is changed
  25. #
  26. #     The procedure will fail if the given percentage is not between 0 and
  27. # 100, inclusive, or if it is not a numeric value.
  28. #
  29. ############################################################################
  30.  
  31. procedure WeightedShuffle (sample, percentage)
  32. local lcv, pairs, weight, size, newlist, legal, illegal
  33.   numeric(percentage) | fail
  34.   (0 <= percentage <= 100) | fail
  35.   newlist := copy(sample)                  # Start with a copy of the
  36.                                            # original list.
  37.   size := *newlist
  38.   legal := list()                          # This list will hold which
  39.                                            # indices are valid choices for
  40.                                            # the shuffle, amounting to the
  41.                                            # selected percentage of all
  42.                                            # elements.
  43.   
  44. # There are two very similar methods used here.  I found that using only the
  45. # first one created some odd values for 50 < percentage < 100, so I mirrored
  46. # the technique to create a list of "bad" indices instead of a list of 
  47. # "good" indices that the random switch can choose from.
  48.  
  49.   if ((percentage <= 50) | (percentage = 100)) then {
  50.     pairs := integer (size * percentage / 100)
  51.                                            # Number of pairs to be switched.
  52.     if pairs > 0 then {                    # Makes sure to avoid division by
  53.                                            # zero- occurs when there is no
  54.                                            # need to shuffle.
  55.       weight := integer ((real(size) / pairs) + 0.5)        
  56.                                            # Holds increment used in
  57.                                            # selective shuffling, rounded up.
  58.       lcv := 1
  59.       until lcv > size do {
  60.         put (legal, lcv)                   # These indices may be used in
  61.                                            # the shuffle.
  62.         lcv +:= weight
  63.       }
  64.     }
  65.   }  
  66.   else { # percentage > 50
  67.     pairs := integer (size * (100 - percentage) / 100)
  68.                                            # Avoid switching this many pairs.
  69.     if pairs > 0 then {
  70.       weight := integer (size / pairs)     # Increment, rounded down.
  71.       illegal := set ([])                  # Which indices can't be used?
  72.       lcv := 1
  73.       until lcv > size do {
  74.         illegal ++:= set([lcv])            # Compile the list of invaild
  75.                                            # indices.
  76.         lcv +:= weight
  77.       }
  78.       every lcv := 1 to size do            # Whatever isn't bad is good.
  79.         if not member (illegal, lcv) then put (legal, lcv)
  80.     }
  81.   }
  82.   every newlist[!legal] :=: newlist[?legal]
  83.                                            # Shuffle elements only from
  84.                                            # legal indices.
  85.   return newlist
  86. end
  87.  
  88.