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'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}}
partitionedAs[a_, b_] := ReplacePart[b, a, Position[b, _, {-1}, Heads
->False], MapIndexed[#2 &, a]]
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
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
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
>>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
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
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
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
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}]