1
$\begingroup$

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.

Improve this question
$\endgroup$
1
  • $\begingroup$ Large overhaul in OP. $\endgroup$
    – Titus
    Nov 28, 2018 at 18:33

2 Answers 2

Reset to default
1
$\begingroup$

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}

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Titus
    Nov 28, 2018 at 9:04
  • $\begingroup$ @Titus updated. Is that the output you want? $\endgroup$
    – ZaMoC
    Nov 28, 2018 at 11:28
1
$\begingroup$

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[1]
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[1]
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}$

Original answer:

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[1]
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

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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! $\endgroup$
    – Titus
    Nov 28, 2018 at 9:12
  • $\begingroup$ @Titus, updated with your new example. $\endgroup$
    – kglr
    Nov 28, 2018 at 9:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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