Entwickler-Ecke
Algorithmen, Optimierung und Assembler - Binominalverteilung
MisterAHA - Di 28.10.08 23:41
Titel: Binominalverteilung
Hallo Leute,
ich bin auf ein "Problemchen" gestoßen, dass ich nun schon seit fast 2 Wochen versuche zu lösen, ich aber einfach nicht voran komme.
Ich versuche rechentechnisch alle Kombination einer Binominalverteilung zu bekommen. Dabei interessiert mich weniger der Binominalkoeffizient, sondern alle möglichen Kombinationen die dabei entstehen.
zb. A B C => A,B,C,AB,AC,BC,ABC ...ihr versteht?
ich bin echt am verzweifeln :-/
Vielleicht habt ihr ja einen guten Vorschlag!?
mfg Andreas
BenBE - Mi 29.10.08 04:25
Da Du wie es scheint, alle Kombinationen haben willst, ohne Beachtung der Reihenfolg, kann man das recht kurz etwa so skizzieren:
Python-Style Pseudo-Code:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
| Betrachte alle möglichen Buchstaben A,B,C als String 'ABC'
Für alle Längen:
Z[0] = 0;
P = 0;
Solange Z[0] == 0
Solange P < Länge && Z[P] + (Länge-P) <= Länge
P++;
Z[P] = Z[P-1] + 1;
Wenn P = Länge
Kombination ausgeben (Z[1]..Z[Länge])
Z[P]++;
Wenn Z[P] > AnzahlZeichen && P > 0
P--;
Z[P]++; |
Das Übersetzen in ausführbaren Delphi-Code überlass ich mal dem Fragesteller ;-)
MisterAHA - Mi 29.10.08 21:28
ich hab mich jetzt mal mit meinem kollegen hingesetzt, und deinen vorschlag ausprogrammiert.
leider ohne erfolg. es wird nur eine kombination ausgeben. wir brauchen aber dringen alle kombinationen.
Jann1k - Mi 29.10.08 21:48
| Zitat: |
ich hab mich jetzt mal mit meinem kollegen hingesetzt, und deinen vorschlag ausprogrammiert.
leider ohne erfolg. es wird nur eine kombination ausgeben. wir brauchen aber dringen alle kombinationen. |
Dann wäre jetzt der richtige Zeitpunkt, um uns den relevanten Abschnitt aus eurem Quelltext vorzustellen. Ohne Quelltext kann man nur schwer sagen woran es liegt. Wäre auch interessant zu wissen, wie die Ausgabe erfolgen soll (in ein array, eine Tstringlist...).
MisterAHA - Mi 29.10.08 22:21
..ich habe gerad in einem anderem forum einen entsprechenden code gefunden:
nur wie müsste der ausschauen, wenn die bildung der permuationen OHNE zurücklegen funktionieren soll?
:-/
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
| procedure CombiStrings(const Values: array of String; Permutation: Boolean = True); overload;
type
PPCharArray = array of PChar;
var
Patterns: PPCharArray;
procedure DoPrint;
var
I: Integer;
begin
for I := 0 to High(Patterns) -1 do Write(Patterns[I], ',');
WriteLn(Patterns[High(Patterns)]);
end;
procedure DoCombi(Start, Stop: Integer);
var
Pos: Integer;
Tmp: PChar;
Last: String;
begin
if Start >= Stop then
begin
DoPrint;
Exit;
end;
Last := '';
Pos := Start;
while Pos <= Stop do
begin
Tmp := Patterns[Pos];
Patterns[Pos] := Patterns[Start];
Patterns[Start] := Tmp;
if not Permutation or (AnsiCompareText(Tmp, Last) > 0) then
begin
DoCombi(Start +1, Stop);
Last := Tmp;
end;
Inc(Pos);
end;
Tmp := Patterns[Start];
while Start < Stop do
begin
Patterns[Start] := Patterns[Start +1];
Inc(Start);
end;
Patterns[Start] := Tmp;
end;
procedure DoCreate;
var
I,J,K: Integer;
begin
SetLength(Patterns, Length(Values));
for I := 0 to High(Values) do
begin
J := 0;
while (J < I) and (AnsiCompareText(Values[I], Patterns[J]) > 0) do
Inc(J);
for K := I -1 downto J do
Patterns[K +1] := Patterns[K];
Patterns[J] := PChar(Values[I]);
end;
end;
begin
DoCreate;
DoCombi(0, High(Patterns));
end; |
Moderiert von 
Christian S.: Delphi-Tags hinzugefügt
Jann1k - Mi 29.10.08 22:24
Pack den Quelltext bitte in delphi-tags (delphi) Quelltext (/delphi) (Eckige Klammern statt runde) so kann/will den nämlich kaum jemand lesen
MisterAHA - Mi 29.10.08 22:27
sorry, ich vergaß ;-)
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
| procedure CombiStrings(const Values: array of String; Permutation: Boolean = True); overload;
type
PPCharArray = array of PChar;
var
Patterns: PPCharArray;
procedure DoPrint;
var
I: Integer;
begin
for I := 0 to High(Patterns) -1 do Write(Patterns[I], ',');
WriteLn(Patterns[High(Patterns)]);
end;
procedure DoCombi(Start, Stop: Integer);
var
Pos: Integer;
Tmp: PChar;
Last: String;
begin
if Start >= Stop then
begin
DoPrint;
Exit;
end;
Last := '';
Pos := Start;
while Pos <= Stop do
begin
Tmp := Patterns[Pos];
Patterns[Pos] := Patterns[Start];
Patterns[Start] := Tmp;
if not Permutation or (AnsiCompareText(Tmp, Last) > 0) then
begin
DoCombi(Start +1, Stop);
Last := Tmp;
end;
Inc(Pos);
end;
Tmp := Patterns[Start];
while Start < Stop do
begin
Patterns[Start] := Patterns[Start +1];
Inc(Start);
end;
Patterns[Start] := Tmp;
end;
procedure DoCreate;
var
I,J,K: Integer;
begin
SetLength(Patterns, Length(Values));
for I := 0 to High(Values) do
begin
J := 0;
while (J < I) and (AnsiCompareText(Values[I], Patterns[J]) > 0) do
Inc(J);
for K := I -1 downto J do
Patterns[K +1] := Patterns[K];
Patterns[J] := PChar(Values[I]);
end;
end;
begin
DoCreate;
DoCombi(0, High(Patterns));
end; |
Kha - Mi 29.10.08 22:41
Solange es nicht mehr als 64 Elemente sind, sollte es sich kurz auch mit Delphis Set-Interpretation lösen lassen: Jedem Element wird ein Bit eines Int64 zugeordnet. Den dann von 1 bis 2^n-1 laufen lassen, fertig.
F#
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
| #light
open System
let charCombinations (s:String) =
let n = s.Length
seq {
for i in 1..(1<<<n)-1 do
yield seq {
for j in 0..n-1 do
if (1<<<j) &&& i <> 0 then
yield s.[j]
}}
> charCombinations "ABCD"
|> Seq.map (fun a -> String(Seq.to_array a)) |> Seq.to_list;;
val it : String list
= ["A"; "B"; "AB"; "C"; "AC"; "BC"; "ABC"; "D"; "AD"; "BD"; "ABD"; "CD"; "ACD";
"BCD"; "ABCD"] |
Die Übersetzung wird dem geneigten Leser überlassen :zwinker: .
[add]
Gut, der allgemeine Fall lässt sich mit Rekursion fast noch schöner lösen:
F#
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
| let combinations xs =
let rec loop acc = function
| [] -> Seq.singleton acc
| x::xs -> Seq.append (loop acc xs) (loop (x::acc) xs)
loop [] xs |> Seq.skip 1
> combinations (Seq.to_list "ABCD")
|> Seq.map (fun a -> String(Seq.to_array a)) |> Seq.to_list;;
val it : String list
= ["D"; "C"; "DC"; "B"; "DB"; "CB"; "DCB"; "A"; "DA"; "CA"; "DCA"; "BA"; "DBA";
"CBA"; "DCBA"] |
Ggf. das Ergebnis noch umdrehen :mrgreen: .
BenBE - Mi 29.10.08 23:13
Das Delphi-Set sollte bis 255 Elemente schaffen.
Aber der Source von dem Kollegen was ihr da gebaut hattet, würd mich auch mal interessieren. Weil das ist wesentlichen nmlich meine Lösung zu einem der letzten Paranussrätsel gewesen ... Nur, dass es da um ein TSP ging ;-)
Kha - Mi 29.10.08 23:27
BenBE hat folgendes geschrieben  : |
| Das Delphi-Set sollte bis 255 Elemente schaffen. |
Kann schon sein, aber da man noch eine Schleifenvariable braucht, wird man ohne große Umwege bei 64 Bit stecken bleiben. Und mittlerweile gefällt mir mein Rekursionsansatz sowieso viel besser ;) .
| BenBE hat folgendes geschrieben : |
| Aber der Source von dem Kollegen was ihr da gebaut hattet, würd mich auch mal interessieren. Weil das ist wesentlichen nmlich meine Lösung zu einem der letzten Paranussrätsel gewesen ... |
Irgendeine Chance, dass ich von deinem Algo mehr als [leere Menge] verstehe :mrgreen: ?
Thorsten83 - Do 30.10.08 01:26
Letztendlich entspricht das der Suche nach allen Teilmengen der Menge {A, B, ..., X}, oder?
Das sollte doch relativ leicht rekursiv zu lösen sein...
Bis auf die Laufzeit halt :D
BenBE - Do 30.10.08 03:05
Erledige nichts rekursiv, dessen Rekursionstiefe mit der Problem-Komplexität korrelliert ;-)
Thorsten83 - Do 30.10.08 13:40
| BenBE hat folgendes geschrieben : |
| Erledige nichts rekursiv, dessen Rekursionstiefe mit der Problem-Komplexität korrelliert ;-) |
Prinzipiell stimme ich dir da zu, z.B. einfache QuickSort-Implementierungen sind böse :)
Aber in diesem Fall bedeutet eine Rekursionstiefe von 30 schon eine Milliarde Ergebnisse, ich glaub da liegt das Problem dann woanders... ;)
BenBE - Do 30.10.08 13:46
Bei QucikSort heißt das aber u.U. auch, dass das Teil quadratisch ist ;-) Dann doch lieber garantiert langsam - wie z.B. MergeSort ;-)
Thorsten83 - Fr 31.10.08 16:44
| BenBE hat folgendes geschrieben : |
| Bei QucikSort heißt das aber u.U. auch, dass das Teil quadratisch ist ;-) Dann doch lieber garantiert langsam - wie z.B. MergeSort ;-) |
Oder Radix, wobei der ja auch wieder rekursiv arbeitet :)
Zum Thema: seid ihr weitergekommen?
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!