Antal mulig kombinationer

Jeg har en tilsvarende funktion i PHP. Kender ikke Delphi, men måske kan du selv omskrive denne.

<?php
    function combi($values, &$results = array(), $result = "", $level = 0, $used = array())
    {
        if (!is_array($values)) $values = split("[,]", $values);
        if ($result != "") $result .= ",";
        for ($i = 0; $i < count($values); $i++)
        {
            if ($level == 0) $used = array();
            if (!in_array($values[$i], $used))
            {
                combi($values, $results, $result . $values[$i], $level + 1, array_merge($used, array($values[$i])));
                if ($level == count($values) - 1) $results[count($results)] = $result . $values[$i];
            }
        }
        if ($level == 0) return $results;
    }
   
    $arr = combi("A,B,C,D");
   
    for ($i = 0; $i < count($arr); $i++)
    {
        echo($arr[$i] . "\n");
    }
?>

Der er ingen sløsning, Borrisholt finder en løsning ;o) Her er en imlementering af en algoritme der kan liste samtlige permutationer ...

Det er ikke verdens hurtigste algoritme, men til kortere strenge virker den fint !!!

// Simple integer factorial handles 12! = 479,001,600 max
// Doesn't complain if n negative, just returns 1

function Factorial(N: Integer): Integer;
var
  I, X: Integer;
begin
  X := 1;
  if N > 1 then
    for I := 2 to N do
      X := X * I;

  Result := X;
end;

// Number of permutations = length! / product of (  (count of unique characters)! )

function NumberOfPermutations(theWord: string): Integer;
var
  char1, char2: string[1];
  len, I, J: Integer;
  maxPermutations: Integer; // If no characters duplicated
  prodOfCharCount: Integer; // Product of count Factorial
  posCounted: array of boolean; // Mark counted positions
  countOfChar: array of Integer; // Count of unique characters
  upWord: string; // theWord in all caps
begin
  upWord := upperCase(theWord); // Ignore differences in case
  len := length(upWord);
  setLength(posCounted, len); // Allocate memory for array
  setLength(countOfChar, len); // Allocate memory for array

  // Initialize the arrays for marking and counting
  for I := 0 to len - 1 do
  begin
    posCounted[I] := False;
    countOfChar[I] := 1; //  Product of these must not be zero
  end;

  // Go thru the word and count appearances of each letter
  for I := 0 to len - 1 do
  begin // Get a letter
    char1 := copy(upWord, I + 1, 1);
    for J := I + 1 to len - 1 do
    begin // Check remaining letters
      char2 := copy(upWord, J + 1, 1);
      if not posCounted[J] then // Skip if previously matched
        if char1 = char2 then
        begin // Found match to count
          Inc(countOfChar[I]); // Count the character
          posCounted[J] := True; // Mark as counted to avoid recount
        end;
    end;
  end;

  // Replace character counts by Factorials of character counts
  for I := 0 to len - 1 do
    countOfChar[I] := Factorial(countOfChar[I]);

  prodOfCharCount := 1; // Initialize
  for I := 0 to len - 1 do
    prodOfCharCount := prodOfCharCount * countOfChar[I];

  maxPermutations := Factorial(len);

  NumberOfPermutations := maxPermutations div prodOfCharCount;
end;

// Returns str with the last i characters rotated j times
// Needed by permute procedure below

function SubRotate(I, J: Integer; const Str: string): string;
var
  RotStrPos, RotChrPos: Integer;
begin
  RotStrPos := length(Str) - I + 1; // First char to rotate
  RotChrPos := RotStrPos + J; // New first char after rotation
  Result := Str;
  Result[RotStrPos] := Str[RotChrPos];
  Result[RotChrPos] := Str[RotStrPos];
end;

// Fills ResultList with all permutations of aWord

procedure Permute(const aWord: string; const ResultList: TStrings);
// Algorithm:
// Put wordIn into ResultList
// For i = 2 to length(wordIn)
//  For each item in the ResultList
//    For j = 1 to i-1
//      Add R(i,j, item) to ListToAdd
//    Next j
//  Next item
//  Add ListToAdd to ResultList
// Next i

// R(i,j,item) returns the item string with the last i characters rotated j times
//  R(3,2, abcd) = adbc
var
  ListToAdd: TStringList;
  I, J, K, len: Integer;
begin
  ResultList.BeginUpdate;
  ResultList.clear; // Clear global var for reuse
  len := length(aWord);

  ListToAdd := TStringList.Create;
  ListToAdd.duplicates := dupIgnore;
  ListToAdd.sorted := True;

  ResultList.Append(aWord); // See Algorithm comments above
  for I := 2 to len do
  begin
    for J := 0 to ResultList.Count - 1 do
      for K := 1 to I - 1 do
        ListToAdd.append(subRotate(I, K, ResultList[J]));

    ResultList.AddStrings(ListToAdd);
    ListToAdd.clear;
  end;

  ListToAdd.Free;
  ResultList.EndUpdate;
end;

procedure TForm23.FormCreate(Sender: TObject);
begin
  Permute('Borrisholt', Memo1.Lines);
end;



Jens Borrisholt

Ellers må du google dig lidt frem :
http://www.google.com/search?num=100&hl=da&rls=com.microsoft%3Ada%3AIE-SearchBox&rlz=1I7ADBF&q=permutation+%22source+code%22+fast&lr=

Jens B

How goes JB

martinlind>> Goes fint ..Jeg er en del mere aktiv på Eksperten end jeg har været lægen ... JEg bor i Nordjylland, arbejder i Randers og en hel masse mere ... Men I stedet for at forstyre en masse mennesker på privat snak, kan du jo tilføje mig på messenger jens@borrisholt.com eller skrive til mig ...

Hvad var det med dig og It Gruppen ?

Jens B

Gammelt spørgsmål.

Men jeg vil mene at rekursion er den rigtige løsning på problemet.

I Delphi:

type
  chararray = array of char;
  booleanarray = array of boolean;

procedure genhelp(letters : chararray; prefix : string; ix : integer;
                  used: booleanarray; reslist : TStrings);

var
  i : integer;

begin
  if ix <= high(letters) then begin
    for i := low(letters) to high(letters) do begin
      if not used[i] then begin
        used[i] := true;
        genhelp(letters, prefix + letters[i], ix + 1, used, reslist);
        used[i] := false;
      end;
    end;
  end else begin
    reslist.Add(prefix);
  end;
end;

procedure gen(word: string; reslist: TStrings);

var
  i : integer;
  letters : chararray;
  used : booleanarray;

begin
  SetLength(letters, length(word));
  for i := low(letters) to high(letters) do letters[i] := word[i-low(letters) + 1];
  SetLength(used, length(word));
  genhelp(letters, '', 0, used, reslist);
end;