Re: Re[6]: Aufgabe::tupledDivisors

["Udo und Susanne Krause" <su.krause@XXXXXXX.ch>]

Hallo,

durch Beseitigung der nächsten Redundanz (in branch[]) spart man erneut um  
die 10% der Laufzeit

Remove[tupledDivisors, branch, generatorQ, leaf]
leaf[o_Integer /; PrimeQ[o]] := leaf[o] = {{1, o}}
leaf[o_Integer /; ! PrimeQ[o]] := leaf[o] =(* Skip {1,o} terms *)
  Rest[Take[Transpose[{#, Reverse[#]} &[#]], Ceiling[Length[#]/2]] &[
    Divisors[o]]]
(* divisor generator ist ein sortiertes m-tupel {Subscript[f, \
1],Subscript[f, 2],...,Subscript[f, m-1],x} genau dann, wenn eine \
Zerlegung x = Subscript[f, Subscript[x, 1]] Subscript[f, Subscript[x, \
2]]mit Subscript[f, Subscript[x, 1]]>= Subscript[f, m-1] und \
Subscript[f, Subscript[x, 2]]>= Subscript[f, m-1] existiert. *)
generatorQ[l_List] := If[Length[l] < 2,
  True,
  (First[l] >
     1) && (Or @@ (LessEqual[l[[-2]], #] & /@
       First[Transpose[leaf[Last[l]]]]))
  ]
branch[l_List] := (* das letzte Element von l *)
 Sort /@ MapThread[
   Flatten[ReplacePart[#1,
      Rule @@ #2]] &, {Table[l, {Length[#]}], #} &[
    Thread[{Length[l], leaf[Last[l]]}]]]
tupledDivisors[A_Integer?Positive, P_Integer?Positive] :=
 Nest[((Join[{1}, #] & /@ #) \[Union]
     Select[Flatten[branch /@ Select[#, generatorQ], 1],
      First[#] > 1 &]) &, {{P}}, A - 1]

Length[tupledDivisors[12, 8 5 7 18 36]] // Timing
{0.39, 6756}

Gruss
Udo.

> durch Beobachtung der Abläufe kann man noch knapp die Hälfte der  
> Laufzeit sparen

> In[7]:= Length[tupledDivisors[12, 8 5 7 18 36]] // Timing
> Out[7]= {0.483, 6756}