Multiplikative Partition

Horst_H · Verfasst: Sa 31.05.14 16:22

Hallo,

es gibt tatsächlich Video's zu sowas.Ich suchte nach Schröderzahlen == Alle möglichen Klammerungen in der Hoffnung, dass die Bestimmung leichter und Doppelte nicht im Faktor 100 auftreten.
EDIT: Jetzt direkt Hassediagram gesucht:
www.youtube.com/watch?v=nD8ErWgj5Ac
Hassediagramme (Teil 1) von Prof. Christian Spannagel an der PH Heidelberg
//Lecture 22 . Enumerative Combinatorics (Federico Ardila) www.youtube.com/watch?v=te9xsrQ6q7U
//( ich habe mal Minute 12 geklickt, Abteilung blindes Huhn ;-)

) da folgt auch die Aufstellung mit Potenzen<> 1. am Beispiel 84=2*2*3*7

user profile icon

Mathematiker und user profile icon

Xion können sicher sofort was damit anfangen.

Gruß Horst

Xion · Verfasst: Sa 31.05.14 16:55

Er schreibt halt das Hasse-Diagramm auf...finde ich wenig spektakulär, das war bei unsrem Prof. nicht anders (nur auf Deutsch und ohne Kappe :mrgreen:

)

Horst_H hat folgendes geschrieben :

Dann nur noch alle Wege bis 84 zählen?

Aufzählen sollte wie an meinem letzten Beispiel im Hasse-Diagramm ohne Duplikate klappen, indem du jeweils nur durch Faktoren teilst, die kleinergleich den vorherigen Faktoren sind (weil dann sind deine Zerlegungen nach Größe sortiert, da kann es keine Doppelten geben).
Wenn du sie nur zählen willst, dann bestimmt es sich vermutlich aus den Primzahlpotenzen...da müsste man dann mit Kombinatorik ran.

_________________
a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)

Xion · Verfasst: Sa 31.05.14 21:10

So, hab jetzt meine Idee doch mal ausprogrammiert :lol:

Für den Testdatensatz 2*3*5*7*11*13*17*19*23 $2*3*5*7*11*13*17*19*23$ erhalte ich folgende Ausgabe:

Eingabezahl: 223092870 (Primzahlfaktoren gegeben)
Knoten im Hassediagramm: 512
Berechnung des Hasse-Diagramms: 0ms
Berechnung des Zerlegung-Baumes: 141ms
21147 Zerlegungen ermittelt
Zerlegungen aufgezählt: 21147 in 115975 Iterationen
Zeitbedarf für Aufzählen: 15ms

Gesamtlaufzeit inklusive Ausgabe in Memo: 1453 ms

Wenn man sie dann noch ausgeben will, kann man das gerne tun (im Code enthalten), aber eigentlich ist das unfassbar unübersichtlich. Eine grafische Baumdarstellung wäre auf jeden Fall zu bevorzugen (entsprechend der Datenstruktur, die mein Programm anlegt).

Als Beweis für die Qualität des Algorithmus bei hohen Potenzen die Werte des Testdatensatzes 2^4*3^4*5^4*7^4 $2^4*3^4*5^4*7^4$
Eingabezahl: 1944810000
Knoten im Hassediagramm: 625
Berechnung des Hasse-Diagramms: 0ms
Berechnung des Zerlegung-Baumes: 2984ms
911838 Zerlegungen ermittelt
Zerlegungen aufgezählt: 911838 in 6950247 Iterationen
Zeitbedarf für Aufzählen: 313ms

und der Testdatensatz 2^{60} $2^{60}$
Eingabezahl: 1152921504606846976
Knoten im Hassediagramm: 61
Berechnung des Hasse-Diagramms: 0ms
Berechnung des Zerlegung-Baumes: 625ms
966467 Zerlegungen ermittelt
Zerlegungen aufgezählt: 966467 in 15959618 Iterationen
Zeitbedarf für Aufzählen: 953ms

Abschließend noch der (zugegeben, quick & very dirty) Quellcode, aber ich muss sagen, wenn ich C++ programmiere und mir viel Mühe gebe ist es unübersichtlicher :mrgreen:

markieren

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:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  type THasseDiagrammKnoten = record
    potenz: array of integer;
    wert: int64;
  end;

  type TPartitionTreeNode = record
    pred: integer;
    faktor: int64;
    minHasseIdx: integer;
    wertHasseIdx: integer;
  end;

  const DOLOGGING = true;
        PRED_ROOTNODE = -1;
        PRED_PRUNEDNODE = -2;

var
  Form1: TForm1;
  HasseDiagramm: array of THasseDiagrammKnoten;
  Primzahl: array of integer;
  PartitionenBaum: array of TPartitionTreeNode;


implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
var A,B,C: integer;
    potenzProd: array of integer;
    i: Int64;
    S: String;
    time: cardinal;
    nextToDo: integer;
    nextEmpty: integer;
    nextEmptyBuf: integer;
    leafCount: integer;
    partitionCount: integer;
    bitmask: array of boolean;
    pred: integer;

    fullTime: cardinal;
begin
  fullTime := GetTickCount;
          
  Memo1.Visible := false;
              
  //--- input-Zahl mit Primfaktorzerlegung
  SetLength( HasseDiagramm, 1 );
  SetLength( HasseDiagramm[0].potenz, 4 );
  SetLength( Primzahl, 4);

  Primzahl[0]                := 2;
  HasseDiagramm[0].potenz[0] := 4;

  Primzahl[1]                := 3;
  HasseDiagramm[0].potenz[1] := 4;

  Primzahl[2]                := 5;
  HasseDiagramm[0].potenz[2] := 4;

  Primzahl[3]                := 7;
  HasseDiagramm[0].potenz[3] := 4;
{
  Primzahl[4]                := 11;
  HasseDiagramm[0].potenz[4] := 1;

  Primzahl[5]                := 13;
  HasseDiagramm[0].potenz[5] := 1;

  Primzahl[6]                := 17;
  HasseDiagramm[0].potenz[6] := 1;

  Primzahl[7]                := 19;
  HasseDiagramm[0].potenz[7] := 1;  

  Primzahl[8]                := 23;
  HasseDiagramm[0].potenz[8] := 1;  }

  HasseDiagramm[0].wert := 1;
  for A:= 0 to High(HasseDiagramm[0].potenz) do
    begin
      HasseDiagramm[0].wert := HasseDiagramm[0].wert * round( power(primzahl[A], HasseDiagramm[0].potenz[A]) );
    end;

  Memo1.Lines.Add('--- Eingabezahl: ' + inttostr(HasseDiagramm[0].wert) );

  //--- berechne Anzahl der Hasse-Diagramm-Knoten
  SetLength(potenzProd, Length(HasseDiagramm[0].potenz));
  C := 1;
  for A:= 0 to High(HasseDiagramm[0].potenz) do
    begin
      potenzProd[A] := C;
      C := C*(HasseDiagramm[0].potenz[A]+1);
    end;

  Memo1.Lines.Add('--- Knoten im Hassediagramm: ' + inttostr(C) );

  //--- erzeuge Hasse-Diagramm-Knoten (Prinzip binäres Inkrement)
  time := GetTickCount;
  SetLength(HasseDiagramm,C);

  for A:= High(HasseDiagramm) downto 0 do
    begin
      C := A;
      SetLength(HasseDiagramm[A].potenz, Length(primzahl));
      HasseDiagramm[A].Wert := 1;
      for B:= High(Primzahl) downto 0 do
        begin
          HasseDiagramm[A].potenz[B] := C div potenzProd[B];
          C := C mod potenzProd[B];
          HasseDiagramm[A].Wert := HasseDiagramm[A].Wert * round(power(Primzahl[B],HasseDiagramm[A].potenz[B]));
        end;
    end;
  time := GetTickCount-time;

  if DOLOGGING then
  for A:= 0 to High(HasseDiagramm) do
    begin
      S := '(';
      for B:= 0 to High(Primzahl) do
        S := S + inttostr(HasseDiagramm[A].potenz[B])+',';
      S:= Copy(S, 1, Length(S)-1);
      S:= S + ' = '+inttostr(HasseDiagramm[A].wert)+')';
      Memo1.Lines.Add(S);
    end;
  Memo1.Lines.Add('--- Berechnung des Hasse-Diagramms: '+inttostr(time)+'ms');

  //--- generiere Zerlegungen
  time := GetTickCount;

  SetLength(PartitionenBaum,1);
  PartitionenBaum[0].minHasseIdx  := High(HasseDiagramm); //maxValue
  PartitionenBaum[0].faktor       := 1;
  PartitionenBaum[0].pred         := PRED_ROOTNODE; //root node
  PartitionenBaum[0].wertHasseIdx := High(HasseDiagramm);//maxValue

  nextToDo := 0;
  nextEmpty := 1;

  while nextToDo < nextEmpty do
    begin

      //batch resize
      if High(PartitionenBaum) < nextEmpty + PartitionenBaum[nextToDo].minHasseIdx + 1 then
        SetLength(PartitionenBaum,nextEmpty + PartitionenBaum[nextToDo].minHasseIdx + 2 + 1000);

      nextEmptyBuf := nextEmpty;
      for B:= PartitionenBaum[nextToDo].minHasseIdx downto 1 do
        begin
          PartitionenBaum[nextEmpty].minHasseIdx  := B; //maxValue
          PartitionenBaum[nextEmpty].faktor       := HasseDiagramm[B].wert;
          PartitionenBaum[nextEmpty].pred         := nextToDo; //source node
          PartitionenBaum[nextEmpty].wertHasseIdx := PartitionenBaum[nextToDo].wertHasseIdx;
          for A:= 0 to High(HasseDiagramm[B].potenz) do
            begin
              if HasseDiagramm[B].potenz[A] > HasseDiagramm[ PartitionenBaum[nextToDo].wertHasseIdx ].potenz[A] then
                begin
                  nextEmpty := nextEmpty - 1; //zugegeben, etwas unsauberer Programmierstil :P
                  Break; //negative Potenz, kein Baumknoten auffüllen
                end;
              PartitionenBaum[nextEmpty].wertHasseIdx := PartitionenBaum[nextEmpty].wertHasseIdx - potenzProd[A]*HasseDiagramm[B].potenz[A];
            end;
          nextEmpty := nextEmpty + 1;
        end;

      if (nextEmptyBuf = nextEmpty) then
        if (PartitionenBaum[nextToDo].wertHasseIdx > 0) then
          PartitionenBaum[nextToDo].pred := PRED_PRUNEDNODE - PartitionenBaum[nextToDo].pred //pruned node
        else
          leafCount := leafCount + 1; //leaf node
      nextToDo := nextToDo + 1;
    end;
  SetLength(PartitionenBaum, nextEmpty);

  time := GetTickCount - time;
  Memo1.Lines.Add('--- Berechnung des Zerlegung-Baumes: '+inttostr(time)+'ms');
  Memo1.Lines.Add(inttostr(leafCount)+' Zerlegungen ermittelt');
       
  //--- gebe Zerlegungen aus
  time := GetTickCount;
  SetLength(bitmask, Length(PartitionenBaum));
  for A:= 0 to High(PartitionenBaum) do
    begin
      bitmask[A] := true;
      if PartitionenBaum[A].pred >= 0 then
        bitmask[PartitionenBaum[A].pred] := false
      else
        begin
          bitmask[A] := false;
          if PartitionenBaum[A].pred <= PRED_PRUNEDNODE then
            bitmask[PRED_PRUNEDNODE-PartitionenBaum[A].pred] := false
        end;
    end;

  C := 0;
  for A:= 0 to High(PartitionenBaum) do
    if bitmask[A] = true then
      begin
        partitionCount := partitionCount + 1;
        S := '';
        pred := A;
        while pred>-1 do
          begin
            if DOLOGGING then
              S := S + inttostr(PartitionenBaum[pred].faktor)+'*';
            pred := PartitionenBaum[pred].pred;
            C := C+1;
          end;

        if DOLOGGING then
          begin
            S := Copy(S,1,Length(S)-3);
            Memo1.Lines.Add('='+S);
          end;
      end;
  time := GetTickCount - time;
  Memo1.Visible := true;
  Memo1.Lines.Add('--- Zerlegungen aufgezählt: ' + inttostr(partitionCount) + ' in ' + inttostr(C) + ' Iterationen' );
  Memo1.Lines.Add('--- Zeitbedarf für Aufzählen: '+ inttostr(time)+'ms');
  fullTime := GetTickCount - fullTime;
  ShowMessage(inttostr(fullTime)+'ms');
end;

end.

Edit:
Verbesserung möglich: Es ist garnicht nötig die Knoten im Hasse-Diagramm (und damit die Faktoren in der Zerlegung zu sortieren). Denn jede beliebige Reihenfolge ist eine ausreichende Sortierung. Es ist ja nur notwendig, dass nicht einmal 2*3*5 und ein anderes mal 5*2*3 bestimmt wird. Wenn ich definiere, die Reihenfolge ist [5,2,3], dann ist die Zerlegung in jedem Fall eindeutig.

Im Anhang jetzt noch das Delphi-Projekt. Seltsamerweise meckert mein Bug-verseuchtes Delphi 2005 plötzlich, er kann den Code nicht kompilieren und findet deshalb die "Project1.exe" nicht. Jeden Tag ein neuer Bug oder wie? :nixweiss:

Edit2:
Noch einen kleinen Bug gefixed (im Code oben und im Anhang). Leider weigert sich mein Delphi eine .exe zu erzeugen, wenn ich das Logging deaktiviere (auch nach PC-Neustart). Von daher konnte ich es nicht ordentlich testen.

Edit3:
Compilieren klappt, wenn ich die Überlaufprüfung und Bereichsprüfung ausschalte...

Einloggen, um Attachments anzusehen!

_________________
a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)

Horst_H · Verfasst: So 01.06.14 11:01

Hallo,

ich bin erlöst ;-)

Ich habe Dein Programm geändert. Lazarus konnte auch kompilieren, aber onFormShow brachte nichts.
Scheinbar waren die Memo noch nicht fertig.
Also ganz klassisch Button und für DoLogging ein Radiobutton.
Für die Hasse Knoten habe ich ein zweites Memo verwendet.Das war mir dann doch zu Quick und dirty.
Bei Speichern habe hin und herschieben habe ich es gelöscht...

Da wird sich auch user profile icon

Mathematiker freuen,

Gruß Horst

Horst_H · Verfasst: So 01.06.14 16:07

Hallo,

ich habe es mal als Konsolenprogramm geschrieben, weil Lazarus mir einen Fehler meldete innerhalb seines intern genutzten AVL-Tree.
Edit: Neue Version, TreeNode Speicherbedarf gesenkt auf 12 Byte statt 24.
IntToStr eingespart durch einmaliges ausführen für jeden HasseKnoten.
Den Wert kann man über die Hasse-Knoten.Wert erhalten.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

Beispiel >>MaxLongInt,Cardinal 260e9
Voreingestellte Anzahl Knoten =4778596
(2,2,2,2,2,2,2 = 260620460100) 2*2 *3*3 *5*5 *7*7 *11*11 *13*13 *17*17
--- Zerlegungen aufgezaehlt: 4659138 in 28613155 Iterationen
--- Berechnung des Hasse-Diagramms : 1ms
--- Berechnung des Zerlegung-Baumes: 8527 ms
--- Zeitbedarf fuer Aufzaehlen     : 304 ms
--- Zeitbedarf fuer Alles          : 8839 ms
Speicherbedarf Knoten =379663500
Anzahl Knoten =31638625
Weiter mit <ENTER>-Taste

markieren

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:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:

program MulPart;
//Als MulPartHasse.dpr speichern
//Alá Xion: Umsetzung des Haase Diagrammes
{$IFnDef FPC}
  {$APPTYPE Console}
{$ELSE}
  {$MODE Delphi}
  {$OPTIMIZATION On}
  {$OPTIMIZATION Peephole}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
{$ENDIF}
uses
  SysUtils ;
 const
    PRED_ROOTNODE = -1;
    PRED_PRUNEDNODE = -2;
 type

  THasseDiagrammKnoten = record
    wert: Uint64;
    potenz: array of integer;
  end;

  type TPartitionTreeNode = record
    pred: integer;
    minHasseIdx: integer;
    wertHasseIdx: integer;
//    dummy: integer;
  end;
var
  HasseDiagramm: array of THasseDiagrammKnoten;
  HasseSWert : array of String;
  Primzahl: array of integer;
  PartitionenBaum: array of TPartitionTreeNode;

function DeltaTime( dt:TDateTime): Cardinal;
const
  cTimeToMs = 86400*1000;
begin
  DeltaTime := round(dt*cTimeToMs);
end;

function IntPower(a,b : integer):Int64;
// a ^ b
var
  erg: Int64;
begin
  IF b <0 then
    erg := 0
  else
  begin
    erg := 1;
    repeat
      iF b AND 1 = 1 then
        erg := erg*a;
      a:= a*a;
      b := b shr 1;
    until b = 0;
  end;
  IntPower:= erg;
end;

procedure Button1Click(DOLOGGING: boolean = true);//false;//;//TForm1.Button1Click(Sender: TObject);
var
  partTime,
  HasseTime,
  SearchTime,
  fullTime: TDateTime;
  PrimCnt:integer;
  A,B,C: integer;
  S: String;
  nextToDo: integer;
  nextEmpty: integer;
  nextEmptyBuf: integer;
  leafCount: integer;
  partitionCount: integer;
  pred: integer;
  potenzProd: array of integer;
  bitmask: array of boolean;

begin
  fullTime := time;
  leafCount := 0;
  partitionCount := 0;
  //--- input-Zahl als Primfaktorzerlegung
  SetLength( HasseDiagramm, 1 );
  // Bestimmt die Anzahl der Primzahl von maximal 12
  PrimCnt := 7;

  SetLength( Primzahl, 12);
  SetLength( HasseDiagramm[0].potenz, 12);

  Primzahl[0]                := 2;
  HasseDiagramm[0].potenz[0] := 2;

  Primzahl[1]                := 3;
  HasseDiagramm[0].potenz[1] := 2;

  Primzahl[2]                := 5;
  HasseDiagramm[0].potenz[2] := 2;

  Primzahl[3]                := 7;
  HasseDiagramm[0].potenz[3] := 2;

  Primzahl[4]                := 11;
  HasseDiagramm[0].potenz[4] := 2;

  Primzahl[5]                := 13;
  HasseDiagramm[0].potenz[5] := 2;

  Primzahl[6]                := 17;
  HasseDiagramm[0].potenz[6] := 2;

  Primzahl[7]                := 19;
  HasseDiagramm[0].potenz[7] := 1;

  Primzahl[8]                := 23;
  HasseDiagramm[0].potenz[8] := 1;

  Primzahl[9]                := 29;
  HasseDiagramm[0].potenz[9] := 1;

  Primzahl[10]                := 31;
  HasseDiagramm[0].potenz[10] := 1;

  Primzahl[11]                := 37;
  HasseDiagramm[0].potenz[11] := 1;

  HasseDiagramm[0].wert := 1;
  B := 1;
  With HasseDiagramm[0] do
  begin
    for A:= PrimCnt-1 downto 0 do
      B := B* IntPower(primzahl[A],potenz[A]);
    end;
  HasseDiagramm[0].wert := B;
  writeln('--- Eingabezahl: ' + inttostr(B) );

  //--- berechne Anzahl der Hasse-Diagramm-Knoten
  SetLength(potenzProd, PrimCnt);
  C := 1;
  for A:= 0 to PrimCnt-1 do
    begin
      potenzProd[A] := C;
      C := C*(HasseDiagramm[0].potenz[A]+1);
    end;

  writeln('--- Knoten im Hassediagramm: ' + inttostr(C) );

  //--- erzeuge Hasse-Diagramm-Knoten (Prinzip binäres Inkrement)
  parttime := time;
  SetLength(HasseDiagramm,C);
  SetLength(HasseSWert,C);
  for A:= High(HasseDiagramm) downto 0 do
    begin
      C := A;
      SetLength(HasseDiagramm[A].potenz, PrimCnt);
      With HasseDiagramm[A] do
      begin
        Wert := 1;
        for B:=   PrimCnt-1 downto 0 do
        begin
          potenz[B] := C div potenzProd[B];
          C := C mod potenzProd[B];
          Wert := Wert * IntPower(Primzahl[B],potenz[B]);
        end;
        HasseSWert[A] := IntToStr(Wert)+'*';
      end;
    end;
  HasseTime := time-parttime;

  if DOLOGGING then
  for A:= 0 to High(HasseDiagramm) do
    begin
      S := '(';
      for B:= 0 to PrimCnt-1 do
        S := S + inttostr(HasseDiagramm[A].potenz[B])+',';
      setlength(S,Length(S)-1);
      S:= S + ' = '+inttostr(HasseDiagramm[A].wert)+')';
      writeln(S);
    end;

  //--- generiere Zerlegungen
  SetLength(PartitionenBaum,sqr(High(HasseDiagramm)));
  writeln('Voreingestellte Anzahl Knoten =',Length(PartitionenBaum));

  Searchtime := time;
  PartitionenBaum[0].minHasseIdx  := High(HasseDiagramm); //maxValue
  PartitionenBaum[0].pred         := PRED_ROOTNODE; //root node
  PartitionenBaum[0].wertHasseIdx := High(HasseDiagramm);//maxValue

  nextToDo := 0;
  nextEmpty := 1;

  while nextToDo < nextEmpty do
    begin
      //batch resize
      if High(PartitionenBaum) < nextEmpty + PartitionenBaum[nextToDo].minHasseIdx + 1 then
        SetLength(PartitionenBaum,nextEmpty + PartitionenBaum[nextToDo].minHasseIdx + sqr(High(HasseDiagramm)));

      nextEmptyBuf := nextEmpty;
      for B:= PartitionenBaum[nextToDo].minHasseIdx downto 1 do
        begin
          with PartitionenBaum[nextEmpty] do
          begin
            minHasseIdx  := B; //maxValue
            //faktor       := HasseDiagramm[B].wert;
            pred         := nextToDo; //source node
            wertHasseIdx := PartitionenBaum[nextToDo].wertHasseIdx;
          end;
          for A:= 0 to High(HasseDiagramm[B].potenz) do
            begin
              if HasseDiagramm[B].potenz[A] > HasseDiagramm[ PartitionenBaum[nextToDo].wertHasseIdx ].potenz[A] then
                begin
                  nextEmpty := nextEmpty - 1; //zugegeben, etwas unsauberer Programmierstil :P
                  Break; //negative Potenz, kein Baumknoten auffüllen
                end;
              DEC(PartitionenBaum[nextEmpty].wertHasseIdx,potenzProd[A]*HasseDiagramm[B].potenz[A]);
            end;
          nextEmpty := nextEmpty + 1;
        end;

      if (nextEmptyBuf = nextEmpty) then
        if (PartitionenBaum[nextToDo].wertHasseIdx > 0) then
          PartitionenBaum[nextToDo].pred := PRED_PRUNEDNODE - PartitionenBaum[nextToDo].pred //pruned node
        else
          leafCount := leafCount + 1; //leaf node
      nextToDo := nextToDo + 1;
    end;
  SearchTime := time-partTime;
  SetLength(PartitionenBaum, nextEmpty);


  //--- gebe Zerlegungen aus
  partTime := Time;
  SetLength(bitmask, Length(PartitionenBaum));
  for A:= 0 to High(PartitionenBaum) do
    begin
      bitmask[A] := true;
      if PartitionenBaum[A].pred >= 0 then
        bitmask[PartitionenBaum[A].pred] := false
      else
      begin
        bitmask[A] := false;
        if PartitionenBaum[A].pred <= PRED_PRUNEDNODE then
          bitmask[PRED_PRUNEDNODE-PartitionenBaum[A].pred] := false
        end;
    end;

  s :='=';
  C := 0;
  IF leafCount > 25000 then
    doLogging := false;
  for A:= 0 to High(PartitionenBaum) do
    if bitmask[A] = true then
      begin
        partitionCount := partitionCount + 1;
        pred := A;
        while pred>0 do
          begin
            if DOLOGGING then
              S := S + HasseSWert[PartitionenBaum[pred].minHasseIdx];
//              S := S + inttostr(HasseDiagramm[PartitionenBaum[pred].minHasseIdx].wert)+'*';
            pred := PartitionenBaum[pred].pred;
            C := C+1;
          end;

        if DOLOGGING then
          begin
            setlength(S,Length(S)-1);
            writeln(S);
            s :='=';
          end;
      end;
  partTime := time-partTime;
  fullTime := time - fullTime;
  writeln(HasseSWert[High(HasseSWert)]);
  writeln(inttostr(leafCount)+' Zerlegungen ermittelt');
  writeln('--- Zerlegungen aufgezaehlt: ' + inttostr(partitionCount) + ' in ' + inttostr(C) + ' Iterationen' );
  writeln('--- Berechnung des Hasse-Diagramms : ',DeltaTime(Hassetime),'ms');
  writeln('--- Berechnung des Zerlegung-Baumes: ',DeltaTime(SearchTime),' ms');
  writeln('--- Zeitbedarf fuer Aufzaehlen     : ',Deltatime(parttime),' ms');
  writeln('--- Zeitbedarf fuer Alles          : ',Deltatime(fulltime),' ms');
  writeln('Speicherbedarf Knoten =',Length(PartitionenBaum)*SizeOF(TPartitionTreeNode));
  writeln('Anzahl Knoten =',Length(bitmask));

  Writeln('Weiter mit <ENTER>-Taste');
  READln;
end;

begin
 Button1Click;
end.

Gruß Horst

Xion · Verfasst: So 01.06.14 18:31

Was den Speicherbedarf angeht, lasse dir mal Length(PartitionenBaum) ausgeben. Das record pro Element sind immerhin 6*32bit, da kommt schon etwas an Speicherbedarf zusammen. (Abhängig von der Anzahl Zerlegungen!)
Dann fällt mir auf, dass du das record als "packet record" definiert hast, was durchaus Zeit kosten kann, weil diese Records den Kern des Algorithmus ausmachen.
Und dann kannst du noch das Array anders/schneller vergrößern. Ersetze z.B. einfach mal in Zeile 180 die 1000 durch 1000000. Vielleicht ist Lazarus nicht so gut im realloiziieren

_________________
a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)

Horst_H · Verfasst: So 01.06.14 19:03

Hallo,

ich bin entsetzt, moralisch enttäuscht!
Mit dem passenden setlength in Zeile 180 sind es nur noch 931 ms .
Wahrscheinlich war die Speicherverwaltung von Lazarus mittels AVL-Tree an Ihre Grenzen gekommen.
packed kompacktiert nur innerhalb des records ( wäre bei allen Daten n*32 Bit aber egal gewesen ).Array wird soweit ich weiß lückenlos angelegt.
Dann kann ich ja nochmal Motorradfahren :-)

Gruß Horst
Edit:
Neue Version oben.
Treenode braucht nur noch die Hälfte an Platz.
Das Beispiel 2⁴*3⁴*5⁴*7⁴ dauert jetzt etwa 620 ms.

Horst_H · Verfasst: Mi 04.06.14 21:52

Hallo,

etwas erstaunliches ist mir gerade aufgefallen.
Wenn man nur Potenzen von 1 bei den Primzahlen hat ( 2*3*5*7*11 ...)
Dann ist die Anzahl der Knoten( n Primzahlen ) = Anzahl der Zerlegungen (n+1-Primzahlen)

markieren

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:

Anzahl Primfaktoren 1 =2 
--- Zerlegungen aufgezaehlt: 1 in 1 Iterationen
--- Zeitbedarf fuer Alles          : 7 ms
Anzahl Knoten =2
Anzahl Primfaktoren 2 =2*3 
--- Zerlegungen aufgezaehlt: 2 in 3 Iterationen
--- Zeitbedarf fuer Alles          : 7 ms
Anzahl Knoten =5
Anzahl Primfaktoren 3 =2*3*5 
--- Zerlegungen aufgezaehlt: 5 in 10 Iterationen
--- Zeitbedarf fuer Alles          : 7 ms
Anzahl Knoten =15
Anzahl Primfaktoren 4 =2*3*5*7 
--- Zerlegungen aufgezaehlt: 15 in 37 Iterationen
--- Zeitbedarf fuer Alles          : 7 ms
Anzahl Knoten =52
Anzahl Primfaktoren 5 =2*3*5*7*11 
--- Zerlegungen aufgezaehlt: 52 in 151 Iterationen
--- Zeitbedarf fuer Alles          : 6 ms
Anzahl Knoten =203
Anzahl Primfaktoren 6 =2*3*5*7*11*13 
--- Zerlegungen aufgezaehlt: 203 in 674 Iterationen
--- Zeitbedarf fuer Alles          : 5 ms
Anzahl Knoten =877
Anzahl Primfaktoren 7 =2*3*5*7*11*13*17 
--- Zerlegungen aufgezaehlt: 877 in 3263 Iterationen
--- Zeitbedarf fuer Alles          : 6 ms           
Anzahl Knoten =4140                      
Anzahl Primfaktoren 8 =2*3*5*7*11*13*17*19 
--- Zerlegungen aufgezaehlt: 4140 in 17007 Iterationen
--- Zeitbedarf fuer Alles          : 9 ms             
Anzahl Knoten =21147                     
Anzahl Primfaktoren 9 =2*3*5*7*11*13*17*19*23 
--- Zerlegungen aufgezaehlt: 21147 in 94828 Iterationen
--- Zeitbedarf fuer Alles          : 32 ms             
Anzahl Knoten =115975                     
Anzahl Primfaktoren 10 =2*3*5*7*11*13*17*19*23*29 
--- Zerlegungen aufgezaehlt: 115975 in 562595 Iterationen
--- Zeitbedarf fuer Alles          : 212 ms              
Anzahl Knoten =678570                      
Anzahl Primfaktoren 11 =2*3*5*7*11*13*17*19*23*29*31 
--- Zerlegungen aufgezaehlt: 678570 in 3535027 Iterationen
--- Zeitbedarf fuer Alles          : 1742 ms              
Anzahl Knoten =4213597                      
Anzahl Primfaktoren 12 =2*3*5*7*11*13*17*19*23*29*31*37 
--- Zerlegungen aufgezaehlt: 4213597 in 23430840 Iterationen
--- Zeitbedarf fuer Alles          : 15394 ms               
Anzahl Knoten =27644437

Ich suchte nach einer Formel für die passende Vorab-Speicherbelegung, weil die bei mir so langsam ist.
Nebenbei wurde es etwas schneller, aber undurchschaubarer.

Gruß Horst

Horst_H · Verfasst: Do 05.06.14 19:03

Hallo,

ich habe Turbo-Delphi bemüht und es hat sich bequemt.
Die Umstellung aus Lazarus, war nicht aufwendig, weil es auch nichts spezielles beinhaltet.
Ich habe dort die Ausgabe auf 22000 Zeilen begrenzt, das dauert ja ewig. ( linux/wine )
Die Ausgabe habe ich aber dennoch in eine Stringliste gepackt, damit man sieht, dass dies recht flott ist.
MulPart

Was fehlt ist die Eingabe einer Zahl und deren Aufteilung in Primfaktoren und deren Potenzen, aber das ist ja eine leichte Übung, für Zahlen < MaxLongInt für den Bereich darüber gibt es sicher auch etwas.
Dank user profile icon

Xion saust es nur so dahin.

Gruß Horst
P.S
Video geändert
www.youtube.com/watch?v=nD8ErWgj5Ac Hassediagramme (Teil 1) von Prof. Christian Spannagel an der PH Heidelberg
Irgendwas läuft noch grundlegend falsch :-(

Ich will nicht so viele unnötige Knoten anlegen lassen.
Man muss ja bei der Teilbarkeit immer abwärts gehen.Wie man aber an der Ausgabe sieht, wird das nicht eingehalten:
Produkt der ersten 9 Primzahlen
2*3*5..*19*.23 :[ meine Güte 34 Sekunden unter linux/wine für die Ausgabe ins Memo... ]
....
=746130*299
=4199*53130
=8398*26565
=12597*17710
=25194*8855
=20995*10626
=41990*5313
=62985*3542
=125970*1771
...

Irgendwo , muss man noch einbauen, das der vorherige Faktor > war. Die Jetzige Positoin ist scheinbar nicht optimal.
Vielleicht müsste ein Zähler an jeden Teiler, wie oft er benutzt wurde.Möglicherweise gibt es da eine Rechnenvorschrift, diese Anzahl vorab zu bestimmen.

Einloggen, um Attachments anzusehen!

Mathematiker · Verfasst: So 08.06.14 21:56

Hallo,
ich bin wieder "online" und habe angefangen, Eure vielen Beiträge zu verstehen.
Und wie oft verstehe ich erst einmal wieder sehr wenig. Aber ich kämpfe mich durch.

Erst einmal Danke an user profile icon

Horst_H und user profile icon

Xion.

Beste Grüße
Mathematiker

Horst_H · Verfasst: Di 17.06.14 22:22

Hallo,

ich grübele immer noch über eine Vereinfachung nach, ohne dieses Knotenungetüm aufbauen zu müssen.
Es ist ja ein leichtes alle Teiler zu ermitteln, wenn man die Primfaktorzerlegung hat, noch schneller.
Was ich suche, ist eine Abbruchbedingung, das ich nicht doppelte Produkte erzeuge.
Dazu mal dieser Ansatz:
Ich spalte einen kleiner oder gleichen Faktor ab und zerlege dann nur noch vorderen größeren.

//Schönerweise sind die Teiler der Teiler ebenso darin enthalten und
//man kann die Position in der Teilerliste aus den Potenzen berechnen
//weshalb man die Teilerliste nicht einfach sortieren kann.
// user profile icon

Xion berechnet so auch die Knotenpositionen.

Als Beispiel 36 = 3^2 x 2^2.

markieren

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:

         Prim-Potenz
Prim->    3      2   
Zahl 
36        2      2
18        2      1
 9        2      0
12        1      2
 6        1      1
 3        1      0
 4        0      2
 2        0      1
 1        0      0
Aufteilen der 36 in Faktoren: 
36 = 36x1
jetzt 36 aufteilen
36 = 18 x 2 -> eine Lösung
  jetzt 18 aufteilen
        9x2 x2 -> eine Lösung
    jetzt 9 aufteilen
        3x3 x2x2 -> eine Lösung
  nächste von 18 ist 6
        6 x3 x2 -> eine Lösung
    jetzt 6 aufteilen 
        3 x2  x3 x2  
      der kleinere Faktor vorne ist kleiner als der zuvor,
      also geht es nicht.Kommt auch schon 
      bei der Aufteilung der 9 vor
18 ist jetzt abgeschlossen, jetzt käme als nächstes in der Liste 9
36 = 9 x 4 -> eine Lösung
  jetzt 9 aufteilen
   3x3 x4 ; 3 < 4 also hier keine Lösung
 9 ist jetzt abgeschlossen, jetzt käme als nächstes in der Liste 12
36 = 12 x 3 -> eine Lösung
  jetzt 12 aufteilen
    4x3 x 3 das geht,  -> eine Lösung, bei 9 zuvor nicht
  jetzt 4 aufteilen
    2x2 x3x3 2<3 also keine Lösung
 12 ist jetzt abgeschlossen, jetzt käme als nächstes in der Liste 6
36 = 6  x 6  -> eine Lösung
  jetzt vordere 6 aufteilen
    3x2 x6  Faktoren kleiner als Faktor folgend, also keine Lösung.
Die folgenden Teiler von 36 < sqrt(36) -> habe fertig
Lösungen:
36  x1
18  x 2
9   x 2 x 2
3x3 x 2 x 2
6x3 x 2 

9 x 4

12 x 3
4x3 x 3 

6  x 6

das passt zu den Lösungen per Hassediagramm:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

)
=36
=2*18
=4*9
=3*12
=6*6
=2*2*9
=2*3*6
=4*3*3
=2*2*3*3

Jetzt sollte ich das mal im Programm umsetzen.Ich weiß nicht, ob die Bedingung hinwendig oder nur notreichend ist ;-)

Gruß Horst
EDIT:
Funktinioniert nicht :-(

16 = 2^4, dann erzeuge ich immer alles nochmals, weil die Abbruchbedingung nie greifen kann.

Horst_H · Verfasst: Mi 18.06.14 15:02

Hallo,

ein neuer Ansatz, der zu banal ist.
Man fügt einfach( multipliziert ) immer eine Primzahl zu allen Faktoren hinzu, insbesondere die 1
2*3*5*7 = 210 hat nur Primzahlen in der Potenz 1.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

erst 
2x1
jetzt 3 hinzu, dazu jeden Faktor des vorangegangen Produktes multiplizieren 
ergibt
(3x2)x1 sowie 
2x(3x1) 
1x6,2x3 = 2 Aufteilungen

die 5 
1x6 -> 5x6 und 1x30
1x2x3 -> 5x2x3 ,1x10x3 und 1x2x15 
1x30
15x2
10x3
6x5
5x3x2x1  = 5 Aufteilungen

die 7 
30x1   ->  7x30,  1x210
15x2x1  -> 105x2, 15x14,15x2 
10x3x1->   70x2, 10x21,10x3x7
6x5x1 ->   42x5,  6x35,6x5x7
5x3x2x1->35x3x2,5x21x2,5x3x14 und 5x3x2x7   = 15 Aufteilungen

Erschreckend simpel ;-)

Gruß Horst

Horst_H · Verfasst: Fr 20.06.14 18:54

Gelöscht
Edit:
Der Gedanke, es würden unnötig viele Knoten erzeugt, ist falsch.
Wenn 2^60 ~ 900000 Partitionen vorhanden sind bestehen diese ja aus unterschiedlicher Anzahl an Faktoren. Diese sind ja in den Knoten gespeichert.
6 Mio Knoten ist ja dann nicht so viel, es gibt doch von 1 bis 60 Faktoren einer Partition.
Irgendwie hänge ich an dem Gedanken fest, das von unten nach oben aufzubauen, eben Faktor für Faktor hinzuzufügen.
36 wäre dann 2-> 2 ,2->2,2,3 -> 2,2,3,3

Gruß Horst
user profile icon

Xion hätte bessere Namen wählen sollen:
Statt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

  type TPartitionTreeNode = record
    pred: integer;
    faktor: int64;
    minHasseIdx: integer;
    wertHasseIdx: integer;
  end;

lieber:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

  type TPartitionTreeNode = record
    pred: integer; // im Vorgänger steht die Nummer des Hasseknotens des Dividenden
    faktor: int64;
    KnNrDivisor : integer;// Nummer des Hasseknotens Divisor
    KnNrQuotient:integer;// Nummer des Hasseknotens Quotient
  end;

Dann erkennt man auch viel leichter, das man enorm viel einsparen kann.
Wenn ich 2^4x3^4 habe kommt sicher sehr oft 2^2x3^2 auf dem Weg der Teibarkeit vor( etwa .2^(4-2)x3^(4-2) = 36 mal ).
Wenn ich einmal die Aufteilung von 2^2x3^2 habe, dann sollte das wohl reichen.
Aber wie geht man dann richtig vor?

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme