How to solve this iteration in the functional programming way?

Question

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.

Answer 1

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