8

The following code segment shows what I'd like to do. I'm a procedural programmer trying to learn the Mathematica functional style. Any help on this would be appreciated.

B = {{1, 3}, {1, 5}, {4, 2}, {5, 2}, {5, 5}}

u = SparseArray[{{1, 2} -> 5, {1, 3} -> 9, {1, 4} -> 6, 
    {1, 5} -> Infinity, {3, 2} -> 2, {3, 4} -> 4,
    {4, 2} -> 9, {5, 2} -> Infinity, {5, 3} -> Infinity, 
    {5, 4} ->  Infinity, {5, 5} -> Infinity}];

r = {3, 0, -2, 10, 19}

(*  Want to convert this python-looking code to functional Mathematica code

for {i, j} in B :
    r[i] = r[i] - u[[i, j]]
    r[j] = r[j] + u[[i, j]]
*)
user10831
  • 179
  • 3
  • 3
    Map[({i,j}=#; r[[i]]=r[[i]]-u[[i,j]]; r[[j]]=r[[j]]+u[[i,j]])&, B] – Bill Mar 04 '15 at 15:12
  • @Bill you could use the -= and += operators to shorten the code – Dr. belisarius Mar 04 '15 at 15:27
  • 1
    @belisarius Perhaps first get him to concentrate all his attention on understanding Map, and not distract him with eliminating a few more characters to shorten his code? I considered your change before posting and chose not to. – Bill Mar 04 '15 at 15:57

5 Answers5

6

I don't think this is a good example for learning functional style. Of course it can be done as other answers show, but they are cryptic for two reasons:

(1) Mathematica doesn't accommodate "for {i, j} in B" (though Simon Woods' answer is pretty close)

(2) your code is actually depending on side effects (it is changing r each time the loop iterates)

The following is clear and fairly canonical:

Do[
  With[{i = x[[1]], j = x[[2]]},
    r[[i]] = r[[i]] - u[[i, j]];
    r[[j]] = r[[j]] + u[[i, j]];
  ],
{x, B}]

It translates into a functional style like this:

f[{i_, j_}] :=
  (
   r[[i]] = r[[i]] - u[[i, j]];
   r[[j]] = r[[j]] + u[[i, j]];
  )

(to be clear, f has no output, and only side effects). We then apply f like this

f /@ B

or to make it clearer that we are depending on side effects:

Scan[f, B]
djp
  • 1,493
  • 14
  • 18
5

What Bill posted as a comment, or for example:

{r[[#1]] -= #3, r[[#2]] += #3} & @@@ (Transpose@Join[Transpose@B, {Extract[u, B]}]);
r

(* {-∞, ∞, 7, 1, Indeterminate} *)

The Indeterminate thingy comes from ∞ - ∞

Dr. belisarius
  • 115,881
  • 13
  • 203
  • 453
5

You could also use

Function[{i, j},
   r[[i]] -= u[[i, j]];
   r[[j]] += u[[i, j]]
   ] @@@ B;
r

or

With[{e = Extract[u, B]},
 r[[B[[All, 1]]]] -= e;
 r[[B[[All, 2]]]] += e];
r
Simon Woods
  • 84,945
  • 8
  • 175
  • 324
  • 1
    I like it the most, especially in (r[[#]] -= u[[##]]; r[[#2]] += u[[##]]) & @@@ B; form. – Kuba Mar 04 '15 at 23:12
4

This is just a way to rewrite the data into a - for our purposes - better format:

u = {{1, 2} -> 5, {1, 3} -> 9, {1, 4} -> 6, {1, 5} -> Infinity, {3, 2} -> 2, {3, 4} -> 4, {4, 2} -> 9, {5, 2} -> Infinity, {5, 3} -> Infinity, {5, 4} -> Infinity, {5, 5} -> Infinity}; 
rules = B //. {a___, {i_Integer, j_Integer}, b___} :> {a, {i -> -({i, j} /. u), j -> ({i, j} /. u)}, b}
(* Out: {{1 -> -9, 3 -> 9}, {1 -> -∞, 5 -> ∞}, {4 -> -9, 2 -> 9}, {5 -> -∞, 2 -> ∞}, {5 -> -∞, 5 -> ∞}} *)

Using this set of rules:

replace[r_, rules_] := r + SparseArray[rules, Length@r]
Fold[replace, r, rules]
(* Out: {-∞, ∞, 7, 1, Indeterminate} *)

In one way this is more functional than what belisarius and Bill are proposing because it doesn't update r in place. This is typical for functional programming.

C. E.
  • 70,533
  • 6
  • 140
  • 264
1

Purely functional

func[lastr_, {i_, j_}] := MapAt[# + u[[i, j]] &, MapAt[# - u[[i, j]] &, lastr, i], j]

Fold[func, r, B]

{-∞, ∞, 7, 1, Indeterminate}

or

Fold[Function[{lastr, ind}, MapAt[# + u[[Sequence @@ ind]] &,
 MapAt[# - u[[Sequence @@ ind]] &, lastr, First@ind], Last@ind]], r, B]
Karsten7
  • 27,448
  • 5
  • 73
  • 134