2
$\begingroup$

I have the following problem and obviously I need help

1) a list of choices --- in fact journals but this doesn't matter

votes = { {ff, tt, ii, "-", "-", "-"}, {ii, tt, gg, dd, hh, ff}, {ii, tt, gg, "-", "-", "-"}, {ff, tt, ii, gg, dd, hh}, {hh, ii, gg, "-", "-", "-"}, {hh, ff, ii, "-", "-", "-"}, {ff, tt, ii, hh, dd, gg}, {tt, ff, "-", "-", "-", "-"}, {gg, ii, "-", "-", "-", "-"}, {dd, ii, tt, "-", "-", "-"}, {gg, dd, tt, "-", "-", "-"}, {ff, hh, ii, gg, tt, dd}, {ff, ii, gg, hh, "-", "-"}, {ff, gg, hh, tt, "-", "-"}, {tt, "-", "-", "-", "-", "-"}, {ii, dd, gg, ff, "-", "-"}, {ii, hh, gg, tt, dd, ff}, {ii, hh, tt, gg, "-", "-"}, {tt, dd, ii, hh, gg, ff}, {ii, hh, gg, "-", "-", "-"}, {ff, gg, ii, "-", "-", "-"}, {hh, tt, ii, gg, ff, dd}, {ii, tt, dd, "-", "-", "-"}, {ii, tt, gg, "-", "-", "-"}, {dd, tt, ii, gg, ff, hh}, {tt, dd, ii, gg, hh, ff}, {gg, dd, ii, tt, ff, hh}, {ii, tt, gg, dd, "-", "-"}, {ff, tt, ii, "-", "-", "-"}, {hh, ff, tt, "-", "-", "-"}, {tt, ii, hh, gg, "-", "-"}, {ii, gg, ff, tt, dd, hh} };

I have constructed a table

tab = Table[{dd, ff, gg, hh, ii, tt}, {i, 1, 33}]

The two tables seem to have the same structure but votes is about the preferences and tab about the ranking of the journals.

I want to substitute in tab, for each line, the true position of each item in the corresponding line of votes. For instance as the line 2 of votes is ii, tt, gg, dd, hh, ff in tab the second line must be 4, 3, 6, 5, 1, 2.

I have tried some thing like that

ReplacePart[tab, {6, 2} -> Position[votes[[6, All]], ff][[1, 1]]]

which, according to what I think to have understood, replaces the second element of the line 6 of tab by the position of ff in the line 6 of votes. But, I have not found how to iterate --- by functional programming --- or to loop by --- procedural programming --- on all elements of the table. For undocumented answers --- "-" ---, one can set a very large number.

Thanks for the help

Improve this question
$\endgroup$
3
  • $\begingroup$ Superb, it works but now how can I iterate ? $\endgroup$ Commented Dec 20, 2016 at 10:29
  • $\begingroup$ I think there is a error in your example. Do you really mean that the result shoul be 4,3,6,5,1,2 ? $\endgroup$ Commented Dec 20, 2016 at 11:30
  • $\begingroup$ Of course Andre, I have typeset too quickly its 463512 $\endgroup$ Commented Dec 20, 2016 at 15:07

4 Answers 4

Reset to default
3
$\begingroup$

This can be done without explicitly creating tab for replacement.

tab = Function[{row}, FirstPosition[row, #, #] & /@ {dd, ff, gg, hh, ii, tt} // Flatten] /@ votes

{{dd,1,gg,hh,3,2},{4,6,3,5,1,2},{dd,ff,3,hh,1,2},{5,1,4,6,3,2},{dd,ff,3,1,2,tt},{dd,2,gg,1,3,tt},{5,1,6,4,3,2},{dd,2,gg,hh,ii,1},{dd,ff,1,hh,2,tt},{1,ff,gg,hh,2,3},{2,ff,1,hh,ii,3},{6,1,4,2,3,5},{dd,1,3,4,2,tt},{dd,1,2,3,ii,4},{dd,ff,gg,hh,ii,1},{2,4,3,hh,1,tt},{5,6,3,2,1,4},{dd,ff,4,2,1,3},{2,6,5,4,3,1},{dd,ff,3,2,1,tt},{dd,1,2,hh,3,tt},{6,5,4,1,3,2},{3,ff,gg,hh,1,2},{dd,ff,3,hh,1,2},{1,5,4,6,3,2},{2,6,4,5,3,1},{2,5,1,6,3,4},{4,ff,3,hh,1,2},{dd,1,gg,hh,3,2},{dd,2,gg,1,ii,3},{dd,ff,4,3,2,1},{5,3,2,6,1,4}}

In the above the default when the position is not found has been set the symbol being searched for. In Mma Missing is generally used for missing values and most (if not all) of the functions know to ignore Missing values. For example, you could use Missing["NoVote"] as the default. Setting a default is optional.

Hope this helps.

Improve this answer
$\endgroup$
4
$\begingroup$

ReplacePart works with named pattern, for example you can do : 

ReplacePart[tab, {i_, 2} :> Position[votes[[i, All]], ff][[1, 1]]]

So, once you will have corrected the question, the definitve answer is :

res = ReplacePart[tab, {i_, j_} :> (If[# =!= {}, #[[1, 1]], tab[[i, j]] ] & @ Position[votes[[i, All]], tab[[i, j]]])]; res // Grid

enter image description here

Do not forget to use a delayed rule (:> instead of -> )

ReplacePart is not memory/speed optimal. It may be slow and memory consuming with large data sets.

I have followed your inital idea to use ReplacePart, but ReplacePart may not be the best approach.

Improve this answer
$\endgroup$
1
  • $\begingroup$ Four nice answers that demonstrate the versatility of MA. $\endgroup$ Commented Dec 21, 2016 at 21:45
1
$\begingroup$ 
alts = {dd, ff, gg, hh, ii, tt}; ranks = Replace[alts, x_ :> (Position[votes[[#]], x]/. {{} -> x, {{n_}} :> n}), 1]& /@ Range[Length@votes]; Grid[Join[{alts}, ranks], Dividers -> All, Background -> {None, {Yellow}}]

Mathematica graphics

Improve this answer
$\endgroup$
1
$\begingroup$

Iterative use of Position as used by others is rarely the most efficient approach.(1)

Here is a method that avoids Position (or FirstPosition) entirely.

fW[votes_, key_] := Module[{z, RL = Range@*Length}, z = ConstantArray[0, Dimensions @ votes]; DeleteCases[votes, "-", {2}] /. AssociationThread[key, RL @ key] // MapIndexed[(z[[#2, #]] = RL[#];) &]; z ]

Existing answer code as functions for comparison: 

fEdmund[votes_, key_] := Function[{row}, FirstPosition[row, #, #] & /@ key // Flatten] /@ votes fkglr[votes_, alts_] := Replace[alts, x_ :> (Position[votes[[#]], x] /. {{} -> x, {{n_}} :> n}), 1] & /@ Range[Length@votes]; fandre[votes_, key_] := Module[{tab}, tab = ConstantArray[key, Length@votes]; ReplacePart[ tab, {i_, j_} :> (If[# =!= {}, #[[1, 1]], tab[[i, j]]] &@ Position[votes[[i, All]], tab[[i, j]]])] ]

Timings:

First @ RepeatedTiming @ #[votes, {dd, ff, gg, hh, ii, tt}] & /@ {fEdmund, fkglr, fandre, fW} 
0.000741 0.0014 0.00114 0.000147

So my code is five times faster than the next best method.

Note:

I chose to output zeros in the place of blank votes because this makes more sense to me. If you prefer to have the vote items in the blanks you may replace the line 

z = ConstantArray[0, Dimensions @ votes];

With: 

z = ConstantArray[key, Length @ votes];
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.