Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

RE: Getting hierarchies of partitions (correction & continue)

  • To: mathgroup at smc.vnet.net
  • Subject: [mg36531] RE: [mg36511] Getting hierarchies of partitions (correction & continue)
  • From: "DrBob" <drbob at bigfoot.com>
  • Date: Wed, 11 Sep 2002 03:27:52 -0400 (EDT)
  • Reply-to: <drbob at bigfoot.com>
  • Sender: owner-wri-mathgroup at wolfram.com

I don't know about elegance or simplicity, but I do have a FASTER
solution, incidentally using combinations code that often comes in handy
for me.  Here's that code:

<< DiscreteMath`Combinatorica`;
ClearAll[combinations];
r = Range[1, 9];
combinations::usage = "combinations[list,n:{__Integer}] lists the 
    combinations of list taken n at a time";
combinations[r_List, n_Integer, {}] := If[n > Length@r, {}, \
DiscreteMath`Combinatorica`KSubsets[r, n]];
combinations[r_List, n_Integer, e_?VectorQ] := Join[e, #] & /@ \
DiscreteMath`Combinatorica`KSubsets[Complement[r, e], n];
combinations[r_List, n_Integer, e : {__?VectorQ}] :=
Flatten[combinations[r, 
    n, #] & /@ e, 1];
combinations[r_List, n : {__Integer}] := Which[Plus @@ n == Length@r,
 Join[#, Complement[r, #]] & /@ combinations[r, Drop[n, -1]], Plus @@ n
> \
Length@r, {}, True, Fold[combinations[r, #2, #1] &, {}, n]]

The following duplicates your fLPartitions function, but is about 40%
faster and uses about 15% less memory (for this example):

Quit

<< "DiscreteMath`Combinatorica`"
fLPartition[ksN_, r_] := 
  With[{ks = KSubsets[      Range[r], ksN], 
    ks1 = Partition[Range[r], 1]}, MapThread[
    Complement[Append[#1,        #2], (Sequence @@ 
         {#1} & ) /@        Partition[#2, 1]] & , 
    {Array[ks1 & , Length[       ks]], ks}]]
fHierarchy[r_] := 
  Module[{ksN = 2},    While[ksN < r + 1, 
    s = fLPartition[ksN, r];      ksN = ksN + 1; Print[s]]]

Timing[fLPartition[3, 80]; ]

{11.389999999999999*Second,   Null}

MaxMemoryUsed[]

233956264

Quit

wantCombinations (* this loads my cominations function definition *)

ClearAll[mine]
mine[k_, n_] := 
  (Join[List /@ Complement[       Range[n], #1], 
     {#1}] & ) /@    combinations[Range[n], {k}]

Timing[mine[3, 80]; ]

{6.734999999999999*Second,   Null}

MaxMemoryUsed[]

195828264

However, I would change the storage structure to replace
{{1},{2},...,{7}} with just {1,2,...7}.  That cuts memory usage by 85%
from your method for this example:

Quit

wantCombinations

ClearAll[mySecond]
mySecond[k_, n_] := 
  (Join[Complement[Range[n], #1], {#1}] & ) /@ combinations[Range[n],
{k}]

Timing[mySecond[3, 80]; ]

{2.922*Second, Null} (* versus 11.485 with your code, 6.7 with my other
code *)

MaxMemoryUsed[]

43996408 (* 44MB versus 234MB with your code, 196 MB with my other code
*)

Those comparisons include memory used during code execution; byte counts
for that example are 134,742,424 for my storage method and 287,560,024
for yours.

If you sometimes have to have a partition in your format, its easy
enough to temporarily convert it from mine with the following function:

f = Join[List /@ Drop[#1,-1], {Last[#1]}] & ;

First[mySecond[2, 10]]
f[%]

{3, 4, 5, 6, 7, 8, 9, 10,   {1, 2}}

{{3}, {4}, {5}, {6}, {7},   {8}, {9}, {10}, {1, 2}}

First[fLPartition[2, 10]]

{{3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}, {1, 2}}

Bobby Treat

-----Original Message-----
From: Emilio Martin-Serrano [mailto:EMartinSerrano at houston.sns.slb.com] 
To: mathgroup at smc.vnet.net
Subject: [mg36531] [mg36511] Getting hierarchies of partitions (correction &
continue)


Group,
Sorry for the previous posting. The following solves (to some extent my 
problem)

<<DiscreteMath`Combinatorica`

fLPartition[ksN_,r_]:=With[{ks=KSubsets[Range[r],ksN],ks1=Partition[Rang
e[r],1]},MapThread[Complement[Append[#1,#2],(Sequence@@{#}&/@Partition[#
2,1])]&,{Array[ks1&,Length[ks]],ks}]]

fHierarchy[r_]:=Module[{ksN=2},While 
[ksN<(r+1),s=fLPartition[ksN,r];ksN=ksN+1;Print[s]]]

fHierarchy[10], gives the structure for 10 elements, and so on.
However, I do not like this solution since to my taste is to complex and
rather inelegant. Nest or Fold would do better. Any Idea?
Just an additional remark.
Besides, I do not need the whole taxonomy, but a subset satisfying a
minimizing condition on connectivity implied by some relationships among
the elements. This condition is satisfied by one and only one element,
or
class of equivalence in each level of the hierarchy. So it is that very
class which matter and consequently the procedure should give control on
each class as the total structure is being generated. Once it is known
which
class satisfies the condition it is possible to avoid generating the
whole
structure and the subsequent combinatorial explosion. With just

fHierarchy[100] a Dell Latitude, 1 GH, 256 MB RAM runs out of memory.

This an addition to the previous posting

In fact, the thing is even worst. These are the CPU times  for the 
following computations

times1=First[Timing[fLPartition[3,10];]]/. Second->1
0.02
times2=First[Timing[fLPartition[3,20];]]/. Second->1
0.18
times3=First[Timing[fLPartition[3,30];]]/. Second->1
0.701
times4=First[Timing[fLPartition[3,40];]]/. Second->1
1.913
times5=First[Timing[fLPartition[3,50];]]/. Second->1
4.236
times6=First[Timing[fLPartition[3,60];]]/. Second->1
8.222
times7=First[Timing[fLPartition[3,70];]]/. Second->1
14.39
times8=First[Timing[fLPartition[3,80];]]/. Second->1
23.563

So far so good. But for

times9=First[Timing[fLPartition[3,90];]]/. Second->1

The computation does not always end. Some times it ends some times it
does 
not (I aborted the process four times after 1 hour  of computing and 
running out of,  2Gbites of,  virtual memory)

Emilio Martin-Serrano



___________________________________

Emilio Martin-Serrano
Schlumberger
Oil & Gas Business Consulting Principal
1325 South Dairy Ashford Road
Houston, TX  77077
Tel. +1 (281) 285 1223
Fax +1 (281) 285 1626






  • Prev by Date: Re: Profiler for Mathematica
  • Next by Date: Re: RE: Why is my Implementation of Sorted Trees So Slow?
  • Previous by thread: Getting hierarchies of partitions (correction & continue)
  • Next by thread: Error in BinCounts function?