Quick cursoring and replacement over a list

I have an initial list which is partitioned as follows.

data = {1, 2, 3, 4, 5, 6, 7, 8}
part = {{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}}

The partition puts element i of data in a sublist {i-1,i,i+1}, e.g. the fourth element in data (4) appears in the third, fourth and fifth elements in part in positions 3,2,1 respectively. I want to cursor across part and if a test suceeds I want to replace

1) the ith element in data 2) the elements in part that correspond to it

This code does what I want, with one error that does not affect me.

list := {1, 2, 3, 4, 5, 6, 7, 8}
part := {{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}}
func[{a_, b_, c_}] := (a + b + c)/3
func[{a_, b_}] := (a + b)/2
func[{b_, c_}] := (b + c)/2

Do[{Print[part[[i]]];
test = RandomVariate[NormalDistribution[func[part[[i]]], 1]];
If[list[[i]] > test, {list = ReplacePart[list, i -> test];
part = ReplacePart[part, {{i - 1, 3} -> test, {i, 2} -> test, {i + 1, 1}-> test}]}, Nothing];
}, {i, 1, 8}]
part
list

To make things as clear as possible, I print the input to test and in the end I call the output. I use SetDelayed to store the updated lists in each step. The Do loop does not break for i=1, i=8, which is very useful.

{1,2}

{-0.149498,2,3}

{2,3,4}

{3,4,5}

{3.64625,5,6}

{3.69681,6,7}

{6,7,8}

{7,8}

(part output, as intended)

{{1, -0.149498}, {-0.149498, 2, 3}, {2, 3, 3.64625}, {3, 3.64625, 3.69681}, {3.64625, 3.69681, 6}, {3.69681, 6, 7}, {6, 7, 7.7758}, {7, 7.7758}}

(list output, as intended)

{-0.149498, 2, 3, 3.64625, 3.69681, 6, 7, 7.7758}

The error is in the first element of part, which should be {-0.149498,2}. Since I won't be needing this I can live with the issue. The last element is updated correctly, on the other hand.

I keep the question about efficiency open. Transpose does not cover me because part must be updated in parallel with list (one step at a time), and Table constructs a new list every time which is time consuming (I use ReplacePart to avoid that). Because ReplacePart is slow, possible candidates are MapAt/ Apply, or even NestList.

Again, thank you all for your patience and good will. Hopefully this explains what I am aiming for, which is a dynamic sequence.

• Large overhaul in OP. – Titus Nov 28 '18 at 18:33

is this what you are looking for?
Here is the result after applying the operation to all elements

ClearAll[data, list, k, l]
list = {1, 2, 3, 4, 5, 6, 7, 8};
l = Length@list;
data[x_] := Partition[x, 3, 1, {-2, 2}, {}]
Table[test = RandomReal[{1, 8}];
If[list[[i]] > test, list = ReplacePart[list, i -> test]];
data@list, {i, l}]

list

{{{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 3.51974}, {3, 3.51974, 5}, {3.51974, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 3.51974}, {3, 3.51974, 5}, {3.51974, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 3.51974}, {3, 3.51974, 5}, {3.51974, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 3.51974}, {3, 3.51974, 5}, {3.51974, 5, 6}, {5, 6, 6.08169}, {6, 6.08169, 8}, {6.08169, 8}},
{{1, 2}, {1, 2, 3}, {2, 3, 3.51974}, {3, 3.51974, 5}, {3.51974, 5, 6}, {5, 6, 6.08169}, {6, 6.08169, 5.86203}, {6.08169, 5.86203}}}

{1, 2, 3, 3.51974, 5, 6, 6.08169, 5.86203}

• Thank you very much, this does indeed wht I described but with one difference: Because part is actually input for the actual test (e.g. test =Mean[part[[i]]]), I need to Table a list at every iteration so that the i+1 element in part will have been updated before the cursoring reaches it. I updated the OP. – Titus Nov 28 '18 at 9:04
• @Titus updated. Is that the output you want? – J42161217 Nov 28 '18 at 11:28

Update: to do conditional replacements iteratively:

ClearAll[tstF, replaceAndPartition]
replaceAndPartition = Module[{d = #, p = partition@#, tf = #2},
Table[d[[i]] = Min[d[[i]], tf[p[[i]]]]; p = partition[d]; {d, p}, {i, 1, Length@d}]] &;

Examples:

SeedRandom
tstF = RandomVariate[NormalDistribution[Mean[#], 1]] &;
Grid[replaceAndPartition[data, tstF] /. x_Real :> Round[x, .01],
Dividers -> All] // TeXForm

$$\tiny\begin{array}{|c|c|} \hline \{1,2,3,4,5,6,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,2,3,4,5,6,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,2,3,4,5,6,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,2,3,4,5,6,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,2,3,4,4.58,6,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,4.58\},\{4,4.58,6\},\{4.58,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,2,3,4,4.58,5.85,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,4.58\},\{4,4.58,5.85\},\{4.58,5.85,7\},\{5.85,7,8\},\{7,8\}\} \\ \hline \{1,2,3,4,4.58,5.85,6.97,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,4.58\},\{4,4.58,5.85\},\{4.58,5.85,6.97\},\{5.85,6.97,8\},\{6.97,8\}\} \\ \hline \{1,2,3,4,4.58,5.85,6.97,7.58\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,4.58\},\{4,4.58,5.85\},\{4.58,5.85,6.97\},\{5.85,6.97,7.58\},\{6.97,7.58\}\} \\ \hline \end{array}$$

SeedRandom
tf= Mean[#] + RandomReal[{-.5, .5}] &;
Grid[replaceAndPartition[data, tf] /. x_Real :> Round[x, .1], Dividers -> All] // TeXForm

$$\tiny\begin{array}{|c|c|} \hline \{1,2,3,4,5,6,7,8\} & \{\{1,2\},\{1,2,3\},\{2,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,1.6,3,4,5,6,7,8\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,1.6,3,4,5,6,7,8\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,4\},\{3,4,5\},\{4,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,1.6,3,3.7,5,6,7,8\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,3.7\},\{3,3.7,5\},\{3.7,5,6\},\{5,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,1.6,3,3.7,4.6,6,7,8\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,3.7\},\{3,3.7,4.6\},\{3.7,4.6,6\},\{4.6,6,7\},\{6,7,8\},\{7,8\}\} \\ \hline \{1,1.6,3,3.7,4.6,5.4,7,8\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,3.7\},\{3,3.7,4.6\},\{3.7,4.6,5.4\},\{4.6,5.4,7\},\{5.4,7,8\},\{7,8\}\} \\ \hline \{1,1.6,3,3.7,4.6,5.4,6.9,8\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,3.7\},\{3,3.7,4.6\},\{3.7,4.6,5.4\},\{4.6,5.4,6.9\},\{5.4,6.9,8\},\{6.9,8\}\} \\ \hline \{1,1.6,3,3.7,4.6,5.4,6.9,7.2\} & \{\{1,1.6\},\{1,1.6,3\},\{1.6,3,3.7\},\{3,3.7,4.6\},\{3.7,4.6,5.4\},\{4.6,5.4,6.9\},\{5.4,6.9,7.2\},\{6.9,7.2\}\} \\ \hline \end{array}$$

ClearAll[partition]
partition = Partition[#, 3, 1, {-2, 2}, {}] &;

data = {1, 2, 3, 4, 5, 6, 7, 8};
part = partition[data]

{{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}}

SeedRandom
tests = RandomVariate[NormalDistribution[Mean[#], 1]] & /@ part

{1.98568, 2.26188, 4.5443, 4.1307, 4.58325, 5.98513, 7.02065, 7.59776}

data2 = Min /@ Transpose[{data, tests}]

{1, 2, 3, 4, 4.58325, 5.98513, 7, 7.59776}

part2 = partition @ data2

{{1, 2}, {1, 2, 3}, {2, 3, 4}, {3, 4, 4.58325}, {4, 4.58325, 5.98513}, {4.58325, 5.98513, 7}, {5.98513, 7, 7.59776}, {7, 7.59776}}

Note: Whenever part i of data is replaced with, say, xx, appropriate parts of part are also replaced with xx.

i = 3;
modifieddata = ReplacePart[data, i -> xx]

{1, 2, xx, 4, 5, 6, 7, 8}

modifiedpart = ReplacePart[part, {{i - 1, 3} -> xx, {i, 2} -> xx, {i + 1, 1} -> xx}]

{{1, 2}, {1, 2, xx}, {2, xx, 4}, {xx, 4, 5}, {4, 5, 6}, {5, 6, 7}, {6, 7, 8}, {7, 8}}

Instead of using ReplacePart on part you can partition modifieddata using the function partition and get the same result:

partition @ modifieddata == modifiedpart

True

• That is a very neat solution but it does not quite do what I need. I used part=ReplacePart[etc] in my code because part is input for the test, so elem. i+1 needs to be updated before the test uses it. As I said, it is a cursoring, not something done in parallel. I updated my OP with 'test=Mean[part[[i]]]` to make this clearer. Still, thank you very much! – Titus Nov 28 '18 at 9:12
• @Titus, updated with your new example. – kglr Nov 28 '18 at 9:41