3
$\begingroup$

My problem is the following:

Consider a list of elements. To better understanding my following explanations, I would take this example:

ListA = {{a, b, c}, {d, e, f}, {g, h, i}};
ListB = {{{a, b}, {c}}, {{d, e, f}}, {{g}, {h, i}}};

Whatever the used list, I want to take an element only from the position of the previous.

To illustrate (for ListA):

An other program give me the position {1,3} which means the element c in ListA (ListA[[1,3]]). So I would take the element d (ListA[[2,1]]).

I sketched a procedure:

step1

pos1 = {1, 3};
ListA[[ pos1[[1]] ]][[ pos1[[2]] ]]; (* c *)

step2

Listofposition =
                 Flatten[
                         Table[
                               {i, j},
                               {i, 1, Length@ListA, 1},
                               {j, 1, Length@ListA[[i]], 1}
                              ],
                         1
                        ];

step3

interpos1 = Position[Listofposition, {1, 3}] + 1

step4

pos2 = Flatten[Listofposition[ [interpos1[[1]] ]], 1]

final step

ListA[[ pos2[[1]] ]][[ pos2[[2]] ]] (* d *)


We can not really say that this solution is elegant. Do you have any other solution? Knowing that most of the lists that I have to deal with have irregular dimensions as ListB. And this is, I think, the main difficulty.



Edit


Firstly thank you for your fast answer. I wrote some code from it.
(With using Block to improve performance)

Methode n°1 (Karsten 7 and Mr.Wizard) :

Index[x_] := Position[x, _, {Depth[x] - 1}, Heads -> False];

NextE1[x_, y_] := x[[Sequence @@ 
                  Index[x][[Sequence @@ Flatten[Position[Index[x], y] + 1]]]]];

TheNextE1[x_, y_] :=
  Block[
        {step1, Res},
        step1 = Index[x];
        Res = x[[Sequence @@ 
              step1[[Sequence @@ Flatten[Position[step1, y] + 1]]]]]
       ];

Method n°2 (Mr.Wizard) :

Index[x_] := Position[x, _, {Depth[x] - 1}, Heads -> False];
Lookup[x_] := Dispatch@Rule @@@ Partition[Index[x], 2, 1, 1, "EOF"];
NextP2[x_, y_] := y /. Lookup[x]
NextE2[x_, y_] := x[[ Sequence @@ NextP2[x, y] ]];

TheNextE2[x_, y_] :=
  Block[
        {step1, step2, step3, Res},
         step1 = Index[x];
         step2 = Dispatch@Rule @@@ Partition[step1, 2, 1, 1, "EOF"];
         step3 = y /. step2;
         Res = x[[ Sequence @@ step3]]
       ]; 

Method n°3 (Mr.Wizard) (No modification) :

NextE3[expr_, pos_] :=
  Module[
         {f},
         f[_, pos] := f[x_, _] := Return[x, MapIndexed];
         MapIndexed[f, expr, {Length@pos}]
        ];

NextP3[expr_, pos_] :=
  Module[
         {f},
         f[_, pos] := f[_, p_] := Return[p, MapIndexed];
         MapIndexed[f, expr, {Length@pos}]
        ];

Method n°4 (Algohi) :

Index2[x_] := Cases[MapIndexed[f, x, {-1}], f[y__] :> {y}, {0, -1}]
NextP4[x_, y_] := Last@Index2[x][[Position[Index2[x], First@Cases[Index2[x], {_, y}]]
                  [[1, 1]] + 1]] ;
NextE4[x_, y_] := x[[ Sequence @@ NextP4[x, y] ]];

TheNextE4[x_, y_] :=
  Block[
        {step1, step2, Res},
        step1 = Index2[x];
        step2 = Last@step1[[Position[step1, First@Cases[ step1, {_, y}]][[1, 1]] + 1]];
        Res = x[[ Sequence @@ step2]]
       ];



Performance


NextE3 > TheNextE1 > TheNextE2 > TheNextE4

$\endgroup$
3
  • $\begingroup$ If you could add an example of ListE, this question would be more clear. $\endgroup$
    – Karsten7
    Jul 23, 2014 at 7:48
  • $\begingroup$ I made some corrections. Thank for your attention ! $\endgroup$
    – Doedalos
    Jul 23, 2014 at 8:14
  • $\begingroup$ This question actually has deep and interesting implications and I think it highlights a gap in the tools available in Mathematica. $\endgroup$
    – Mr.Wizard
    Jul 23, 2014 at 9:32

5 Answers 5

2
$\begingroup$

With

listA={{a,b,c},{d,e,f},{g,h,i}};
listB={{{a,b},{c}},{{d,e,f}},{{g},{h,i}}};

and the assumption that

Flatten/@listB

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

always matches the dimensions of listA. One can create a lookup list for the positions

posList=Flatten[
        Table[{n,m},{n,1,Length@listA},{m,1,Length@listA[[1]]}]
        ,1]

For positions specified in the form of

 pos1 = {1, 3}

functions to find the element at a special position can be defined as

elemA[p_] := listA[[Sequence @@ p]]
elemB[p_]:=(Flatten/@listB)[[Sequence@@p]]

And finally as the function to find the next positon in listB

nextB[p_]:=elemB@posList[[Sequence@@Flatten[Position[posList,p]+1]]]

will provide the desired output

nextB[pos1]

d

for any input in this format.
For a list of positons, e.g.

positions={{1,3},{2,2}}

this function can be applied in the following way

nextB/@positions

{d,f}

$\endgroup$
2
$\begingroup$

First, some observations on your code itself:

  1. There is a much more concise way to use Part (with Apply and SlotSequence):

    ListA[[##]] & @@ pos1
    
    c
    

    More directly you can use Extract:

    Extract[ListA, pos1]
    
    c
    
  2. Your Flatten/Table code could done with Position:

    Position[ListA, _, {2}, Heads -> False]
    
    {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}
    

On to the problem itself, it would help to have a sense of why you need this behavior; that is: what is the context of this problem?

For the moment I will address it "at face value" rather than attempting to provide alternatives. In your example lists all of the elements are at the same level:

Level[ListA, {2}]
Level[ListB, {3}]
{a, b, c, d, e, f, g, h, i}

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

I shall assume that is representative of your application.

If you are going to be performing this operation repeatedly it probably makes sense to construct a look-up table rather than having to compute the next position each time. You could do something like this:

all = Position[ListA, _, {2}, Heads -> False]

rules = Rule @@@ Partition[all, 2, 1, 1, "EOF"]
{{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}

{{1, 1} -> {1, 2}, {1, 2} -> {1, 3}, {1, 3} -> {2, 1}, {2, 1} -> {2, 2}, {2, 2} -> {2, 3},
 {2, 3} -> {3, 1}, {3, 1} -> {3, 2}, {3, 2} -> {3, 3}, {3, 3} -> "EOF"}

Here I chose "EOF" as value when there is no additional position.
You can optimize the use of these rules with Dispatch:

lookup = Dispatch[rules];

Now you can find the next position with:

{1, 3} /. lookup
{2, 1}

I await your description of the context of your problem as there may be better approaches such as working on a flat list and then reconstructing the tree structure later.

$\endgroup$
2
$\begingroup$

My first answer became a bit of a ramble so here is a second answer for a cleaner method.

If speed is not a priority or if your expressions are not large you could use this:

next[expr_, pos_] :=
  Module[{f},
    f[_, pos] := f[x_, _] := Return[x, MapIndexed];
    MapIndexed[f, expr, {Length @ pos}]
  ]

Examples:

next[ListB, {1, 1, 2}]
next[ListB, {1, 2, 1}]
c

d

If you want the position rather than the element:

nextPos[expr_, pos_] :=
  Module[{f},
    f[_, pos] := f[_, p_] := Return[p, MapIndexed];
    MapIndexed[f, expr, {Length @ pos}]
  ]

nextPos[ListB, {1, 1, 2}]
{1, 2, 1}

These functions are not efficient as they rescan the entire expression from the beginning with each call. However they are fairly clean and could easily be extended to fully irregular tree structures.

$\endgroup$
1
$\begingroup$

Here is yet another attempt. If you want to take the next element many times, or take the second to next element, or the previous element, this may have an advantage.

First, build an index between position and flattened position:

index = Module[{cnt = 1}, 
  Association @ Flatten @ MapIndexed[#2 -> (cnt++) &, ListB, {-1}]]

<|{1, 1, 1} -> 1, {1, 1, 2} -> 2, {1, 2, 1} -> 3, {2, 1, 1} -> 4, {2, 1, 2} -> 5, {2, 1, 3} -> 6, {3, 1, 1} -> 7, {3, 2, 1} -> 8, {3, 2, 2} -> 9|>

And flatten the list:

flatten = Flatten @ ListB

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

position = Keys[index]

{{1, 1, 1}, {1, 1, 2}, {1, 2, 1}, {2, 1, 1}, {2, 1, 2}, {2, 1, 3}, {3, 1, 1}, {3, 2, 1}, {3, 2, 2}}

For a fixed list, one only needs to do the above step once. Then this gives the next element:

flatten[[index[{2, 1, 2}] + 1]]

f

This gives the position of the next element:

position[[index[{2, 1, 2}] + 1]]

{2, 1, 3}

$\endgroup$
1
  • $\begingroup$ Thank you for your solution but I have not Mathematica 10 yet. $\endgroup$
    – Doedalos
    Jul 23, 2014 at 14:02
0
$\begingroup$

Try this:

ind = Cases[MapIndexed[f, ListA, {-1}], f[x__] :> {x}, {0, -1}];
pos2 = Position[ind, First@Cases[ind, {_, pos1}]][[1, 1]] + 1;
postionnext = Last@ind[[pos2]];
ListA[[Sequence @@ postionnext]]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.