Dot products and For-loops

Question

I'm taking a class where we're working with matrix applications inside of Mathematica. In this case, we're analyzing senatorial votes that have been numericized so that a value of 1 corresponds to "aye," -1 corresponds to "nay," and 0 corresponds to no vote/abstain.

Taking the dot products of these values, I'm trying to find, for each senator, the senator(s) with the most and least similar voting patterns (largest and smallest dot products) and plot these in a chart.

This may not be the most efficient code to accomplish this, but given that it's for a class, I am supposed to modify what's below:

closestvoter[n_] := 
  Module[{max = 0, k = 0, close = 0},
    For[i = 1, i < 100, i++,
      k = senatorvote[n] . senatorvote[i];
      If[k >= max && i != n, close = i; max = k];
    ]; 
  close
  ]

The way the code works right now, it will only give me a single value of i when sometimes there is more than one senator that produces the same dot product. How can I get the loop to check and print all values of i that satisfy this?

Answer 1

I recommend you make close a list in which you can accumulate values of i that give the same k. The test for updating close and max will have to more elaborate.

Clear[closestvoter]
closestvoter[n_, maxn_] :=
  Module[{max = 0, k = 0, close = {}},
    For[i = 1, i <= maxn, i++,
      If[i != n,
        k = senatorvote[n].senatorvote[i];
        Which[
          k == max, AppendTo[close, i],
          k > max, close = {i}; max = k]]];
    {max, close}]]

Note this version of closestvoter reports max as well as the all the indexes for which k == max.

Contrived test data.

SeedRandom[42]; Clear[senatorvote]; 
Do[senatorvote[i] = RandomInteger[{-1, 1}, 30], {i, 25}];

Here is the results for the contrived data.

Column @ Table[Join[{i}, closestvoter[i, 25]], {i, 25}]

We see that only the first senator has the same maximum score with more than one other senator.

Answer 2

Define the votes as lists instead of a function:

SeedRandom[1234];
senatorvote = RandomInteger[{-1, 1}, {25, 30}];

closestvoters[n_] := MaximalBy[Delete[Range[Length[senatorvote]], n], 
  senatorvote[[n]].senatorvote[[#]] &]

farthestvoters[n_] := MinimalBy[Range[Length[senatorvote]], 
  senatorvote[[n]].senatorvote[[#]] &]

test:

closestvoters[1]

{13, 20}

farthestvoters[1]

{5}

Answer 3

In addition to Roman's post, here is a method to compute all closest and farthest voters to all senators at once as follows; this should be about to 2 orders of magnitude faster than Roman's code.

SeedRandom[1234];
senatorvote = RandomInteger[{-1, 1}, {2500, 3000}];

A = senatorvote.senatorvote\[Transpose];

closestvoters = Flatten[Position[#, Max[#]]] & /@ (A - 2 DiagonalMatrix[Diagonal[A]]);
farthestvoters = Flatten[Position[#, Min[#]]] & /@ A;

By computing A first, you can take greatest advantage of the linear algebra capabilities of your hardware. Afterwards, you have to find only the minimum and maximum positions per row. So the closest voters to senator n will be written into closestvoters[[n]].

Since Position is somewhat slow in finding positions of integers in a vector (notice that Position can do a lot more than that which comes at a cost), here a faster implementation utilizing an undocumented function:

closestvoters = Random`Private`PositionsOf[#, Max[#]] & /@ (A - 2 DiagonalMatrix[Diagonal[A]]);
farthestvoters = Random`Private`PositionsOf[#, Min[#]] & /@ A;