position with multidimensional array

Question

I have this code:

names = {"a", "b", "c", "d", "e", "f", "g"};
extr = {{{"a", "c"}, "q"}, {{"b", "e", "f"}, "r"}, {{"a", "b"}, "s"}};
data = {{{1}, {1.5`, 1.5`}, {2, 2, 2}}, {{2}, {2.5`, 2.5`}, {3, 3, 
     3}}, {{3}, {3.5`, 3.5`}, {4, 4, 4}}, {{4}, {4.5`, 4.5`}, {5, 5, 
     5}}, {{5}, {5.5`, 5.5`}, {6, 6, 6}}, {{6}, {6.5`, 6.5`}, {7, 7, 
     7}}, {{7}, {7.5`, 7.5`}, {8, 8, 8}}};

I want to find positions of extr[[All,1]] in names and I would like the result to be in format:

{{1, 3}, {2, 5, 6},{1, 2}}

The problem is that Position does not work with arrays so well so Position[names,extr] does not work, neither does Position[names, #] & /@ extr[[All, 1]]. What works though is

Position[names, #] & /@ Flatten[extr[[All, 1]]]
{{{1}}, {{3}}, {{2}}, {{5}}, {{6}}, {{1}}, {{2}}}

But the format of the output is all wrong. So I was thinking:

Partition[Flatten[Position[names, #] & /@ Flatten[extr[[All, 1]]]], Length /@ extr[[All, 1]]]

But besides this looking really horrible, it does not work as Partition creates the same dimensions only and I cannot find any command such that it would reshape the array in the way needed.

I would certainly prefer something more straightforward than Partition[Flatten[Position[... However, if that cannot be done, any help with this way would be appreciated.

The ultimate goal is to extract those rows whose numbers would be given by the above (let's call it pos=Partition[Flatten[Position[names, #] & /@ Flatten[... and sum them like that

Total[data[[#]]] & /@ pos

If i just manually write those rows, it is:

Total[data[[#]]] & /@ {{1, 3}, {2, 5, 6}, {1, 2}}
{{{4}, {5., 5.}, {6, 6, 6}}, {{13}, {14.5, 14.5}, {16, 16, 
   16}}, {{3}, {4., 4.}, {5, 5, 5}}}

Also I should mention, the output of the position does not necessarily be {{1, 3}, {2, 5, 6}, {1, 2}} as long as it can be used to get the total above. Thank you.

Answer 1

How about

(* Solution 1 *)
pos = extr\[Transpose][[1]] /. Thread[names -> Range@Length@names]
(* Solution 2 *)
pos = extr\[Transpose][[1]] /. MapIndexed[# -> #2[[1]] &, names]

Answer 2

You could use Associations. In particular, PositionIndex:

names = {"a", "b", "c", "d", "e", "f", "g"};
extr = {{{"a", "c"}, "q"}, {{"b", "e", "f"}, "r"}, {{"a", "b"}, "s"}};

Flatten /@ Map[PositionIndex@names, extr[[All, 1]], {2}]
(* {{1, 3}, {2, 5, 6}, {1, 2}} *)

Answer 3

pos = 
  Flatten /@ ((Map[Position[names, #] &, extr[[All, 1]][[#]]]) & /@
     Range@Length@extr)

{{1, 3}, {2, 5, 6}, {1, 2}}

Total@data[[#]] & /@ pos // MatrixForm

Or

Flatten /@ Map[ToCharacterCode, list, {2}] - 96

{{1, 3}, {2, 5, 6}, {1, 2}}

Answer 4

Please see a potential solution below:

Code:

(*Data sample*)
names = {"a", "b", "c", "d", "e", "f", "g"};
extr = {{{"a", "c"}, "q"}, {{"b", "e", "f"}, "r"}, {{"a", "b"}, "s"}};
data = {{{1}, {1.5`, 1.5`}, {2, 2, 2}}, {{2}, {2.5`, 2.5`}, {3, 3, 
 3}}, {{3}, {3.5`, 3.5`}, {4, 4, 4}}, {{4}, {4.5`, 4.5`}, {5, 5, 
 5}}, {{5}, {5.5`, 5.5`}, {6, 6, 6}}, {{6}, {6.5`, 6.5`}, {7, 7, 
 7}}, {{7}, {7.5`, 7.5`}, {8, 8, 8}}};

(*Operation*)
Total@data[[#]] & /@ (extr /. Association[Table[#[[i]] -> i, {i, Length@#}] &[names]])[[All, 1]]

Output:

{{{4}, {5., 5.}, {6, 6, 6}}, {{13}, {14.5, 14.5}, {16, 16, 16}}, {{3}, {4., 4.}, {5, 5, 5}}}

Reference:
Association
Table
/. | @ | # | & etc.