# 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, 2012 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. Jan 28, 2012 at 17:44
• OK thanks, I simply needed to make sure it's to be applied to the rule itself
– acl
Jan 28, 2012 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. Jan 28, 2012 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. Jan 28, 2012 at 18:02

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[] -> 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]} & /@ 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[] -> 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. Jan 28, 2012 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. Jan 28, 2012 at 18:08
• @István please try my new code Jan 28, 2012 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. Jan 28, 2012 at 19:25
• @Istvan this is actually potentially must faster than yours; please see my edit. Jan 28, 2012 at 20:07