# How to solve this iteration in the functional programming way?

I am trying to come up with a functional programming method to calculate a list of replacements, that depend on previous replacements. Since there is always a finite number of steps, I would like to use Fold, Nest, ComposeList or any related function in an elegant way. Now I only have the the following procedural code:

Given an initial list of assignments (temp), an empty set for storing replacement rules (rules) and an arbitrary function f of one argument:

temp = {d -> {d}, c -> {c, d}, a -> {a, c, d}, b -> {b, d}}
rules = {};
f[_[x_, {x_}]] := RandomReal[]; (* if input rule is x -> {x}, evaluate... *)
f[_[x_, {x_, y__?NumberQ}]] := RandomReal[]; (* if input rule is x -> {x, num.1, num.2, ...}, evaluate... *)

Do[
rules = Append[rules, temp[[i, 1]] -> f@temp[[i]]];
temp = Replace[temp, rules, {3}];
(* {3} is needed to replace only at the rhs of rules in temp *)
, {i, Length@temp}]


the output is:

rules

(*
==> {d -> 0.236483, c -> 0.998187, a -> 0.818906, b -> 0.819079}
*)

temp

(*
==> {d -> {0.236483}, c -> {0.998187, 0.236483},
a -> {0.818906, 0.998187, 0.236483}, b -> {0.819079, 0.236483}}
*)


This problem might be considered as an entertaining code golfing example, but believe me, this is not entertaining for me at all.

Edit:

Note, that f in reality is such a function that evaluates only if the right hand side of its input rule has already been evaluated (i.e. it is a list of random reals in this example). I have modified f accordingly: now it evaluates only if the input rule has the same element on lhs and rhs (rhs is wrapped in List) OR if the rhs contains elements that already have numeric values. Since numeric values depend on previous evaluations, therefore it is required that the algorithm processes the initial list from left to right. The initial temp list is always such that at the end all right-hand-sides are evaluated.

Edit 2:

This algorithm would do the synchronous update of a Bayesian network, which is a direct acyclic graph. That's why the sorting of nodes is not according to lexicographic order: nodes in temp are sorted according to topological order, and each member is a *node* -> *parents_of_node* pair. The actual f function (not the simple one above) assigns the output state to the node given the states of its parents and the present state of itself. Since I don't know of any ready-made package available to deal with Bayesian inference and co., I started to do it from scratch. It is also good to code things to understand the concepts of a new field.

-
If I execute this with f undefined, I see that it's called like this f[d -> {d}]. Is this what you wanted? – acl Jan 28 '12 at 17:37
@acl: As a matter of fact, f is a quite complicated function, but it has no relevance to the problem here. I only kept it to show that there must be a function applied at each iteration to the assignment rules. So the answer is: yes, this is what I wanted. – István Zachar Jan 28 '12 at 17:44
OK thanks, I simply needed to make sure it's to be applied to the rule itself – acl Jan 28 '12 at 17:44
Does replacement need to be done one by one? Is this equivalent for your real problem as well? --> Do[ rules = Append[rules, temp[[i, 1]] -> f@temp[[i]]], {i, Length@temp} ]; temp = Replace[temp, rules, {3}] If this latter form is acceptable, it should be easy. Otherwise not. – Szabolcs Jan 28 '12 at 17:49
@Szabolcs: No, because f is such a function that evaluates only if the rhs of its input rule has already been evaluated (i.e. it is a list of random reals in this example). A good point though, I include it in the post. – István Zachar Jan 28 '12 at 18:02

## 1 Answer

If I now understand your code this should do what you want. I am using my own f function for concise repeatability.

f = Tr@ToCharacterCode@ToString@# &;

temp = {d -> {d}, c -> {c, d}, a -> {a, c, d}, b -> {b, d}};

rules = Fold[Append[#, #2[[1]] -> f@Replace[#2, #, {2}]] &, {}, temp]

temp = Replace[temp, rules, {3}]

{d -> 619, c -> 853, a -> 1085, b -> 851}

{d -> {619},
c -> {853, 619},
a -> {1085, 853, 619},
b -> {851, 619}}


This is orders of magnitude faster than your original code on long rules lists because the complete rules list is not continually reprocessed:

f = Tr@ToCharacterCode@ToString@# &;

syms = RandomSample@Array[var, 1000];
dat = # -> {#, Sequence @@ RandomSample[syms, RandomInteger[5]]} & /@ syms;

(temp = dat;
rules = {};
Do[rules = Append[rules, temp[[i, 1]] -> f@temp[[i]]];
r1 = temp = Replace[temp, rules, {3}];, {i,
Length@temp}]) // Timing // First

39.219

(temp = dat;
rules =
Fold[Append[#, #2[[1]] -> f@Replace[#2, #, {2}]] &, {}, temp];
r2 = temp = Replace[temp, rules, {3}]) // Timing // First

 0.14

r1 === r2

True

-
I added some extra criteria, see edit. – István Zachar Jan 28 '12 at 18:06
Unfortunately, I don't think this does the job. The OP's code does repeated replacement, and RandomReal will hide those effects. Try using Accumulate in his code instead. – rcollyer Jan 28 '12 at 18:08
@István please try my new code – Mr.Wizard Jan 28 '12 at 19:06
@Spartacus: It works now, and is a bit faster than mine. I am going to wait some for others to post alternatives, as this problem - I think - gives a lot of room to experiment. – István Zachar Jan 28 '12 at 19:25
@Istvan this is actually potentially must faster than yours; please see my edit. – Mr.Wizard Jan 28 '12 at 20:07