# List manipulation challenge

It's necessary to get

from

list = {{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3},{a4, b4, c4}, {a5, b5, c5}};


I'd like to do this with ReplaceList. Is it feasible? Or, maybe, you know a better way?

• If you do it only once, just write it directly as you want: it will be the simplest. If you will apply it to many lists of the same structure, try ReplacePart . Commented Jul 17, 2015 at 9:34
• Don't post pictures in lieu of actual code/lists/etc. Why should a reader have to manually copy/type?
– ciao
Commented Jul 17, 2015 at 9:41
• Shouldn't the first element in your resulting list be {a1, b1, c2/a1}? Commented Jul 17, 2015 at 9:59
• No, it's {a1,b1,c2/c1} Commented Jul 17, 2015 at 10:13
• @vudum I have posted an approach which, though not having the form of your answer, does replicate the desired manipulations of list (with Mathematica rearrangements) Commented Jul 17, 2015 at 10:24

Written for brevity:

list = {{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3}, {a4, b4, c4}, {a5, b5, c5}};

f[x_][n_] := {Tr@#, Sqrt@Tr[#2^2], x[[3, n + 1]] Tr@# / #.#3} & @@ x[[All, ;; n]]

f[list\[Transpose]] ~Array~ 4

{{a1, Sqrt[b1^2], c2/c1},
{a1 + a2, Sqrt[b1^2 + b2^2], ((a1 + a2) c3)/(
a1 c1 + a2 c2)},
{a1 + a2 + a3, Sqrt[b1^2 + b2^2 + b3^2], ((a1 + a2 + a3) c4)/(
a1 c1 + a2 c2 + a3 c3)},
{a1 + a2 + a3 + a4, Sqrt[b1^2 + b2^2 + b3^2 + b4^2],
((a1 + a2 + a3 + a4) c5)/(a1 c1 + a2 c2 + a3 c3 + a4 c4)}}


Sqrt[b1^2] remains in the output rather than b1 but I think this is reasonable.

• Shortest so far, I like it. +1 Commented Jul 17, 2015 at 13:16
• @LLlAMnYP Thanks! Commented Jul 17, 2015 at 13:17
– xyz
Commented Jul 17, 2015 at 13:31
• @ShutaoTang Mine will not fare well due to the repetitive sums so I'll leave performance testing for someone who took a different emphasis. Commented Jul 17, 2015 at 13:33
• @Mr.Wizard +1 much neater and I like the way dealt with indexing...as usual I learn a lot :) Commented Jul 17, 2015 at 13:42

As ciao comments code facilitates answers rather than pictures. As the base list is small I post the following. There will almost certainly be better ways and I have not simplified Sqrt:

 dat = {{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3}, {a4, b4, c4}, {a5, b5, c5}}
func[u_] := FoldList[Append, {u[[1]]}, u[[2 ;; -2]]]
col1 = Accumulate[Most@dat[[All, 1]]];
col2 = Sqrt[#.#] & /@ func[dat[[All, 2]]];
col3 =
#1/#2 &,
{Rest@dat[[All, 3]],
#1.#2/Plus @@ #2 &,
{func[dat[[All, 3]]], func[dat[[All, 1]]]}]}
];
Transpose[{col1, col2, col3}]


this yields:

(*{{a1, Sqrt[b1^2], c2/c1}, {a1 + a2, Sqrt[
b1^2 + b2^2], ((a1 + a2) c3)/(a1 c1 + a2 c2)}, {a1 + a2 + a3, Sqrt[
b1^2 + b2^2 + b3^2], ((a1 + a2 + a3) c4)/(
a1 c1 + a2 c2 + a3 c3)}, {a1 + a2 + a3 + a4, Sqrt[
b1^2 + b2^2 + b3^2 + b4^2], ((a1 + a2 + a3 + a4) c5)/(
a1 c1 + a2 c2 + a3 c3 + a4 c4)}}*)

• That's not the OP example... :-| I'll venture the picture has pictypos...second term has Sqrt[b1^2+b1^2] there. But +1 for putting up with it !
– ciao
Commented Jul 17, 2015 at 10:17
• @ciao I am sorry if I have misunderstood...my cursory view suggested this was the same just with just some rearrangement...if the form was required I guess I did not do that...just thought posting something would either help or clarify...:-/ Commented Jul 17, 2015 at 10:22

Not very efficient, but this brute force approach has the advantage of being very easy to code.

data = {{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3}, {a4, b4, c4}, {a5, b5, c5}};
{aa, bb, cc} = Transpose @ data;
as = Most @ Accumulate[aa];
bs = Most @ Sqrt @ Accumulate[bb^2];
cs =
Table[
Module[{as = aa[[;; i]], cs = cc[[;; i]]}, cc[[i + 1]] Total[as]/(as.cs)],
{i, Length @ cc - 1}]
result = Transpose @ {as, bs, cs}

{{a1, Sqrt[b1^2], c2/c1},
{a1 + a2, Sqrt[b1^2 + b2^2], ((a1 + a2)*c3)/(a1*c1 + a2*c2)},
{a1 + a2 + a3, Sqrt[b1^2 + b2^2 + b3^2],
((a1 + a2 + a3)*c4)/(a1*c1 + a2*c2 + a3*c3)},
{a1 + a2 + a3 + a4, Sqrt[b1^2 + b2^2 + b3^2 + b4^2],
((a1 + a2 + a3 + a4)*c5)/(a1*c1 + a2*c2 + a3*c3 + a4*c4)}}

• FYI: Sqrt[b1 + b2 + b3] should be Sqrt[b1^2 + b2^2 + b3^2] etc. Commented Jul 17, 2015 at 13:29
• @Mr.Wizard. Thanks for pointing out my error. I've repaired my code Commented Jul 17, 2015 at 14:46
l[n_, x_] := Transpose[list[[;; n]]][[x]]
{Tr@l[#, 1], Norm@l[#, 2], Last@l[# + 1, -1]/l[#, 1].l[#, 3]  Tr@l[#, 1]} & /@ Range@4

• Abs was not called for. Commented Jul 17, 2015 at 13:34
• @Mr.Wizard Neither Sqrt[b1^2]:) Commented Jul 17, 2015 at 13:35
• I suppose, but I think my change is the logical result whereas this is a different operation. Commented Jul 17, 2015 at 13:37
• @Mr.Wizard Well, the word "logical" has a few meanings. Here is a nice one I was reading right now. Commented Jul 17, 2015 at 13:50
• +1 for your cheeky answer as well as the interesting article you sidetracked me with. Commented Jul 17, 2015 at 14:20

My take (but the fractions in the third element are always converted from a/(b/c) to ac/b, such is life).

transform =
{Total@#1[[1 ;; -2, 1]],
Sqrt[Total@(#1[[1 ;; -2, 2]]^2)],
#1[[-1, 3]]/((#1[[1 ;; -2, 1]]).(#1[[1 ;; -2, 3]])/Total@#1[[1 ;; -2, 1]])
} &

transform[list[[1;;#]]]&/@Range[2,Length@list]


Alternatively, because First, Rest, Most, and Last are better than Part:

transform =
{Total@(First /@ Most@#),
Sqrt[Total@(Most@#^2)][[2]],
Last@Last@#/((First /@ Most@#).(Last /@ Most@#)/Total@(First /@ Most@#))
} &

• I see that your method is quite similar to my own, so +1 for you too. Commented Jul 17, 2015 at 13:25
• @Mr.Wizard thank you too. Cleaned the code up a bit as well. Commented Jul 17, 2015 at 13:47

And here's a different enough approach to merit a separate answer.

ListCorrelate[
{1, 1},
Accumulate@list,
{1, -1}, {}, #2 &
{#[[1]], Sqrt@Total@({Sequence @@ #1[[2]]}^2),
#2[[-1, -1]] #[[1]]/{Sequence @@ #[[1]]}.{Sequence @@ Last@#}} &, 1]


Before programming, you should analyse the construction of the formula.

For the first column, you could construct the following list

{{a1},
{a1, a2},
{a1, a2, a3},
{a1, a2, a3, a4}}


For the second column

{{b1},
{b1, b2},
{b1, b2, b3},
{b1, b2, b3, b4}}


For the last column, constructing the list as follow

{{{a1}, {c1}},
{{a1, a2}, {c1, c2}},
{{a1, a2, a3}, {c1, c2, c3}},
{{a1, a2, a3, a4}, {c1, c2, c3, c4}}}

{c2, c3, c4, c5}


Implementation

data = {{a1, b1, c1}, {a2, b2, c2}, {a3, b3, c3}, {a4, b4, c4}, {a5, b5, c5}}
{lstA, lstB, lstC} = Transpose@data;
len = Length@data;


Then

col1 = Plus @@@ (lstA[[1 ;; #]] & /@ Range[len - 1])
(*col1 = Accumulate[Most@lstA]*)
col2 = Sqrt[#.#] & /@ (lstB[[1 ;; #]] & /@ Range[len - 1])
col3 =
(Plus @@ #1/#1.#2 &) @@@ ({lstA[[1 ;; #]], lstC[[1 ;; #]]} & /@
Range[len - 1]) lstC[[2 ;;]]


Lastly, you can transpose the three columns.

Transpose[{col1, col2, col3}]