PureBoard

Verfasst: **20.11.2004 20:46**

Folgender Code erzeugt sämtliche Permutationen mit den Zahlen 1 bis p_numElems und ruft für jede Permutation die übergebene Funktion *p_callbackProc auf, welche mit den permutierten Zahlen dann alles mögliche anstellen kann. (siehe z.B. example 2 für Stringkonkatenation)

Dabei können beliebig viele Elemente permutiert werden, selbst wenn die Anzahl ihrer Permutationen die 2^31-Grenze überschreitet.

[Anm: Permutation = Aneinanderreihung von Elementen der Ausgangsmenge (hier der Zahlen 1..p_numElems), wobei jedes genau einmal und an einer beliebigen Position auftaucht]

Code: Alles auswählen

;/ PermutationCaller(p_numElems.l, *p_callbackProc.l)
;/ >> generates all permutations of numbers 1..p_numElems and calls *p_callbackProc on
;/ >> each permutation to use it for any purpose
;/ 
;/ p_numElems:       the number of elements to permutate (1..)
;/ *p_callbackProc:    pointer to function to call each time a new permutation
;/                   was generated. This function has to be of the form:
;/                   ProcName (*p_array.l, p_numElems.l, p_counter.l)
;/                   where [*p_array] will hold a pointer to an array
;/                   of [p_numElems] permutated long-values each in
;/                   range 1..[p_numElems]
;/                   p_counter just counts from 1..
;/                   This callbackfunction has to return 0 (or nothing) to let
;/                   PermutationCaller() continue,
;/                   or may return anything <> 0 to let PermutationCaller()
;/                   stop immediately.
;/
;/ by Froggerprogger, 20.11.2004
Procedure.l PermutationCaller(p_numElems.l, *p_callbackProc.l)
  Dim Permutation.l (p_numElems - 1) ; holds the actual permutation
  Dim TempFreedValues.l (p_numElems - 1) ; entry 0=used, 1=(temporarily) not used value
   
  Protected resume.l : resume = 1
  Protected runPos.l : runPos = p_numElems - 2
  Protected tempL.l
  Protected lastVal.l
  Protected counter.l
  
  ; nothing to permutate with p_numElems <= 1
  If p_numElems <= 1
    ProcedureReturn 0
  EndIf
  
  ; fill in the first permutation
  For i=0 To p_numElems - 1
    Permutation(i) = i+1 
  Next

  Repeat
    counter + 1
    ; call the custom function
    tempL = CallFunctionFast(*p_callbackProc, @Permutation(), p_numElems, counter)
    If tempL <> 0  
      ProcedureReturn tempL
    EndIf
    
    ; free all entries from runPos to end
    descending = 1
    lastVal = Permutation(runPos)
    TempFreedValues(lastVal - 1) = 1
    For i = runPos + 1 To p_numElems - 1
      tempL = Permutation(i)
      TempFreedValues(tempL - 1) = 1
      If descending And tempL > lastVal
        descending = 0
      ElseIf descending
        lastVal = tempL
      EndIf 
    Next

    While descending
      ; if at runPos the local maximum is, then free it and go one more left to increase it
      runPos - 1
      ; quit if this was the most left position
      If runPos < 0 : ProcedureReturn counter : EndIf
      tempL = Permutation(runPos)
      TempFreedValues(tempL-1) = 1
      lastVal = Permutation(runPos+1)
      If tempL < lastVal
        descending = 0
      EndIf
    Wend

    ; write nearest greater value to runPos
    i = Permutation(runPos)
    Repeat 
      i+1
    Until TempFreedValues(i-1) = 1
    TempFreedValues(i-1) = 0
    Permutation(runPos) = i
    
    ; write back the other freed values in descending order
    j = runPos + 1
    For i=0 To p_numElems - 1
      If TempFreedValues(i) = 1
        TempFreedValues(i) = 0
        Permutation(j) = i+1
        j+1
      EndIf
    Next
    runPos = p_numElems - 2
  ForEver
EndProcedure

;-
;- 2 Examples
;-
;/ example 1 - simple number permutation
#max1 = 4
Debug "example 1: simple number permutation"
Procedure SimpleDebugArray(*p_array.l, p_numElems.l, p_counter.l)
  ;( >>sniff<< there are no arrays as parameters in PB)
  Protected res.s
  res = ""
  For i=0 To p_numElems-1
    res + Str(PeekL(*p_array + 4*i)) + "  |  "
  Next
  Debug res
  ProcedureReturn 0
EndProcedure

Debug Str(PermutationCaller(#max1, @SimpleDebugArray())) + " permutations"
Debug "" : Debug ""

;/ example 2 - using permutationcaller for another purepose (strings' combination here)
#max2 = 5
Dim MyStringArray.s(#max2 - 1)

Debug "example 2: using permutationcaller() for strings' combination"
Procedure DebugStrings(*p_array.l, p_numElems.l, p_counter.l)
  ;( >>sniff<< there are no arrays as parameters in PB)
  Protected res.s
  res = ""
  For i=0 To p_numElems-1
    res + MyStringArray(PeekL(*p_array + 4*i)-1) + " "
  Next
  Debug res
  ProcedureReturn 0
EndProcedure

; fill some strings into an array

For i=0 To #max2-1
  MyStringArray(i) = Chr(65 + i) + Str(i) + Chr(97 + i)
Next

Debug Str(PermutationCaller(#max2, @DebugStrings())) + " permutations"

PureBoard

Permutationen erzeugen

Permutationen erzeugen