Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.

Dismiss

4 views

Skip to first unread message

May 17, 2006, 3:45:22 AM5/17/06

to

>From time to time I've wanted to partition the first level of one

list, say A, the same way that another list, say B, is partitioned.

One way to do this is

list, say A, the same way that another list, say B, is partitioned.

One way to do this is

copyPartition[A_List, B_List] /; Length@A >= Length@Flatten@B :=

Module[{i = 0}, Map[A[[++i]]&,B,{-1}]]

But all the methods I've thought of have a pointer that functions

something like i in the above code. I'd like to eliminate the pointer,

because in the unlikely event that A contains an unevaluated symbol

that is the same as the name of the pointer with $ appended -- e.g.,

i$, if the pointer is i -- then in the returned list that symbol will

have a numeric value assigned to it. Unique[i] doesn't help. The

only solution I see is the probabilistic one of giving the pointer a

strange (random?) name that hopefully would be very unlikely to show

up as data. But that would be giving up. Does anyone have any ideas?

May 19, 2006, 3:50:33 AM5/19/06

to

Ray Koopman wrote:

> >From time to time I've wanted to partition the first level of one

> list, say A, the same way that another list, say B, is partitioned.

> One way to do this is

>

> copyPartition[A_List, B_List] /; Length@A >= Length@Flatten@B :=

> Module[{i = 0}, Map[A[[++i]]&,B,{-1}]]

> >From time to time I've wanted to partition the first level of one

> list, say A, the same way that another list, say B, is partitioned.

> One way to do this is

>

> copyPartition[A_List, B_List] /; Length@A >= Length@Flatten@B :=

> Module[{i = 0}, Map[A[[++i]]&,B,{-1}]]

Here's a solution, but I'm skeptical that the problem you describe

actually arises. Module should give you a 'local' i that doesn't

duplicate an other symbol in use.

This function will actually copy structure at deeper levels, as you

see, but if you really want to restrict it to the first level of B,

change the {-1} in the partition to a {2}.

In[1]:=

a=Prime/@Range[30]

b={{x,x,x},{x,x,x,x,x},{x,x},{x,x,x}}

c={{x,x,x},{x,{x,x},x},{{x,x},{x,x},{x,x,x}}}

Out[1]=

{2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,\

103,107,109,113}

Out[2]=

{{x,x,x},{x,x,x,x,x},{x,x},{x,x,x}}

Out[3]=

{{x,x,x},{x,{x,x},x},{{x,x},{x,x},{x,x,x}}}

In[4]:=

partitionedAs[a_,b_]:=ReplacePart[b,a,Position[b,_,{-1},Heads\[Rule]False],

{#}&/@Range@Length@Flatten@b]

In[5]:=

a~partitionedAs~b

Out[5]=

{{2,3,5},{7,11,13,17,19},{23,29},{31,37,41}}

In[6]:=

a~partitionedAs~c

Out[6]=

{{2,3,5},{7,{11,13},17},{{19,23},{29,31},{37,41,43}}}

--

Here's the restricted version:

In[9]:=

partitionedAs[a_,b_]:=ReplacePart[b,a,Position[b,_,{2},Heads\[Rule]False],

{#}&/@Range@Length@Flatten@b]

In[11]:=

a~partitionedAs~b

a~partitionedAs~c

Out[11]=

{{2,3,5},{7,11,13,17,19},{23,29},{31,37,41}}

Out[12]=

{{2,3,5},{7,11,13},{17,19,23}}

May 19, 2006, 3:51:34 AM5/19/06

to

Hm, maybe a minor cosmetic improvement:

partitionedAs[a_, b_] := ReplacePart[b, a, Position[b, _, {-1}, Heads

->False], MapIndexed[#2 &, a]]

May 19, 2006, 3:53:36 AM5/19/06

to

Please find hereunder a function that solve the problem of conflicting

local name in the lists.

In[1]:=

copyPartition2[A_List, B_List] /;

Length[A] >= Length[Flatten[B]] :=

Module[{start, end},

start = FoldList[Plus, 1, Length /@ B];

end = start - 1; start = Most[start];

end = Rest[end];

((A[[#1]] & ) /@ Range[First[#1], Last[#1]] & ) /@

Transpose[{start, end}]]

In[2]:=

listA = {1, 2, 3, 4, 5, 6, 7, i$25, i$26, i$27};

listB = {{a, b}, {2, 6, 1.4, 5/3}, {i}, {a, b, c}};

In[4]:=

copyPartition2[listA, listB]

Out[4]=

{{1, 2}, {3, 4, 5, 6}, {7}, {i$25, i$26, i$27}}

Below, you will find some details about how the function works:

In[5]:=

start = FoldList[Plus, 1, Length /@ listB]

Out[5]=

{1, 3, 7, 8, 11}

In[6]:=

end = start - 1

Out[6]=

{0, 2, 6, 7, 10}

In[7]:=

start = Most[start]

Out[7]=

{1, 3, 7, 8}

In[8]:=

end = Rest[end]

Out[8]=

{2, 6, 7, 10}

In[9]:=

Transpose[{start, end}]

Out[9]=

{{1, 2}, {3, 6}, {7, 7}, {8, 10}}

In[10]:=

(Range[First[#1], Last[#1]] & ) /@

Transpose[{start, end}]

Out[10]=

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

In[11]:=

((listA[[#1]] & ) /@ Range[First[#1], Last[#1]] & ) /@

Transpose[{start, end}]

Out[11]=

{{1, 2}, {3, 4, 5, 6}, {7}, {i$25, i$26, i$27}}

Best regards,

Jean-Marc

May 19, 2006, 3:56:39 AM5/19/06

to

Ray Koopman schrieb:Hi Ray,

use Replace[]:

A={a,b,c,d,e};

B={{1},{2,3},{{{4}},5}};

Ap=B/.Thread[Flatten[B]\[Rule]A]

--> {{a},{b,c},{{{d}},e}}

Peter

May 19, 2006, 4:05:48 AM5/19/06

to

On 5/18/06, Ray Koopman <koo...@sfu.ca> wrote:

> Thanks, J-M, but there seems to be a problem:

>

> In[3]:= A = {a, b, c, d};

> B = {1, 2, {3, 4}};

>

> In[5]:= copyPartition[A,B]

> copyPartition2[A,B]

>

> Out[5]= {a,b,{c,d}}

> Out[6]= {{},{},{a,b}}

>

> Regards,

> Ray

> Thanks, J-M, but there seems to be a problem:

>

> In[3]:= A = {a, b, c, d};

> B = {1, 2, {3, 4}};

>

> In[5]:= copyPartition[A,B]

> copyPartition2[A,B]

>

> Out[5]= {a,b,{c,d}}

> Out[6]= {{},{},{a,b}}

>

> Regards,

> Ray

Hi Ray,

That's right. I had not done enough testing before posting. Sorry about

that.

The following version of the function seems to work well as long as

the first list is flat.

In[1]:=

copyPartition3[A_List, B_List] /;

Length[A] >= Length[Flatten[B]] :=

Module[{start, end, lst},

lst = (If[AtomQ[#1], {#1}, #1] & ) /@ B;

start = FoldList[Plus, 1, Length /@ lst];

end = start - 1; start = Most[start];

end = Rest[end];

lst = ((A[[#1]] & ) /@ Range[First[#1],

Last[#1]] & ) /@ Transpose[{start, end}];

MapAt[#1[[1]] & , lst, Position[AtomQ /@ B, True]]]

In[2]:=

A = {a, b, c, d};

B = {1, 2, {3, 4}};

In[4]:=

copyPartition3[A, B]

Out[4]=

{a, b, {c, d}}

In[5]:=

copyPartition[A_List, B_List] /;

Length[A] >= Length[Flatten[B]] :=

Module[{i = 0}, Map[A[[++i]] & , B, {-1}]]

In[6]:=

copyPartition[A, B]

Out[6]=

{a, b, {c, d}}

In[7]:=

A = {a, b, c, d, {e, f}, g, h};

B = {1, {2}, {3, 4}, {5, {6, 7}}};

In[9]:=

copyPartition3[A, B]

Out[9]=

{a, {b}, {c, d}, {{e, f}, g}}

In[10]:=

copyPartition[A, B]

Out[10]=

{a, {b}, {c, d}, {{e, f}, {g, h}}}

Best regards,

Jean-Marc

May 20, 2006, 5:15:01 AM5/20/06

to

On 5/17/06 at 3:29 AM, koo...@sfu.ca (Ray Koopman) wrote:

>>From time to time I've wanted to partition the first level of one

>list, say A, the same way that another list, say B, is partitioned.

>One way to do this is

>copyPartition[A_List, B_List] /; Length@A >= Length@Flatten@B :=

>Module[{i = 0}, Map[A[[++i]]&,B,{-1}]]

>But all the methods I've thought of have a pointer that functions

>something like i in the above code. I'd like to eliminate the

>pointer, because in the unlikely event that A contains an

>unevaluated symbol that is the same as the name of the pointer with

>$ appended -- e.g., i$, if the pointer is i -- then in the returned

>list that symbol will have a numeric value assigned to it. Unique[i]

>doesn't help. The only solution I see is the probabilistic one of

>giving the pointer a strange (random?) name that hopefully would be

>very unlikely to show up as data. But that would be giving up. Does

>anyone have any ideas?

Here is an alternative that has no explicit pointer and avoids the issue you mention

copyPartition[A_List, B_List] :=

((Take[A, #]) & /@ Transpose@{Most@#,

Rest@# - 1}) &[FoldList[Plus, 1, Length /@ B]]

--

To reply via email subtract one hundred and four

May 20, 2006, 5:23:15 AM5/20/06

to

In article <e4jtnn$d02$1...@smc.vnet.net>, Peter Pein <pet...@dordos.net>

wrote:

wrote:

No, that won't work. Try

A={a,b,c,d,a};

B={{1},{2,1},{{{3}},2}};

Ap=B/.Thread[Flatten[B] -> A]

You get

{{a}, {b, a}, {{{d}}, b}}

whereas I think the OP wanted

{{a}, {b, c}, {{{d}}, a}}

Cheers,

Paul

_______________________________________________________________________

Paul Abbott Phone: 61 8 6488 2734

School of Physics, M013 Fax: +61 8 6488 1014

The University of Western Australia (CRICOS Provider No 00126G)

AUSTRALIA http://physics.uwa.edu.au/~paul

May 21, 2006, 12:44:02 AM5/21/06

to

Paul Abbott schrieb:Hi Paul,

well, I recognized this and came to a solution similar to J. Siehler's:

A={a,{b,{c,{d,{e}}}},f};

B={x,{x},{{x,x},x},x};

cpStruct=ReplacePart[##,

Sequence@@(Position[#,_,{-1},Heads->False]&/@{##})]&;

cpStruct[B,A]

--> {a,{b},{{c,d},e},f}

Peter

May 21, 2006, 10:33:53 PM5/21/06

to

Maybe something like this ??

In[1]:=

Clear[list,skeletor]

A={a,b,c,d,e};

B={{1},{3,5},{{{5}},5}};

skeletor[list1_?

ListQ,list2_?ListQ] /;Length@list2=Length@Flatten@list1:=list1/.{

x_?NumberQ\[RuleDelayed]Hold[Part[list1,x]]}/.{list1\[RuleDelayed]list2}

skeletor[B,A]//ReleaseHold

Out[5]=

{{a},{c,e},{{{e}},e}}

Pratik Desai

Wolfram Research, Inc

Technical Support

May 24, 2006, 3:19:32 AM5/24/06

to

Thanks, everybody. That was instructive.

For short lists, with Length@Flatten@B < 100 or so,

a version of J. Siehler's code is clearly fastest:

partitionedAz[A_, B_] /; Length@A >= Length@Flatten@B :=

ReplacePart[B, A, Position[B,_,{-1},Heads->False],

Transpose@{Range@Length@Flatten@B}]

For longer lists, a two-stage version of my code is a little faster:

copyPartishun[A_, B_] /; Length@A >= Length@Flatten@B :=

Map[A[[#]]&, Block[{i=0},Map[++i&,B,{-1}]] ,{-1}]

0 new messages

Search

Clear search

Close search

Google apps

Main menu