8
$\begingroup$

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]]
*)
$\endgroup$
3
  • 3
    $\begingroup$ Map[({i,j}=#; r[[i]]=r[[i]]-u[[i,j]]; r[[j]]=r[[j]]+u[[i,j]])&, B] $\endgroup$ – Bill Mar 4 '15 at 15:12
  • $\begingroup$ @Bill you could use the -= and += operators to shorten the code $\endgroup$ – Dr. belisarius Mar 4 '15 at 15:27
  • 1
    $\begingroup$ @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. $\endgroup$ – Bill Mar 4 '15 at 15:57
6
$\begingroup$

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]
$\endgroup$
5
$\begingroup$

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 ∞ - ∞

$\endgroup$
5
$\begingroup$

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
$\endgroup$
1
  • 1
    $\begingroup$ I like it the most, especially in (r[[#]] -= u[[##]]; r[[#2]] += u[[##]]) & @@@ B; form. $\endgroup$ – Kuba Mar 4 '15 at 23:12
4
$\begingroup$

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.

$\endgroup$
1
$\begingroup$

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]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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