6
$\begingroup$

It's necessary to get

Out:

from

In:

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?

Improve this question
$\endgroup$
5
  • $\begingroup$ 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 . $\endgroup$
    – Alexei Boulbitch
    Commented Jul 17, 2015 at 9:34
  • 3
    $\begingroup$ Don't post pictures in lieu of actual code/lists/etc. Why should a reader have to manually copy/type? $\endgroup$
    – ciao
    Commented Jul 17, 2015 at 9:41
  • $\begingroup$ Shouldn't the first element in your resulting list be {a1, b1, c2/a1}? $\endgroup$
    – m_goldberg
    Commented Jul 17, 2015 at 9:59
  • $\begingroup$ No, it's {a1,b1,c2/c1} $\endgroup$
    – vudum
    Commented Jul 17, 2015 at 10:13
  • $\begingroup$ @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) $\endgroup$
    – ubpdqn
    Commented Jul 17, 2015 at 10:24

7 Answers 7

Reset to default
6
$\begingroup$

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.

Improve this answer
$\endgroup$
6
  • $\begingroup$ Shortest so far, I like it. +1 $\endgroup$
    – LLlAMnYP
    Commented Jul 17, 2015 at 13:16
  • $\begingroup$ @LLlAMnYP Thanks! $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 13:17
  • $\begingroup$ You could add a performance test for all answers :-) $\endgroup$
    – xyz
    Commented Jul 17, 2015 at 13:31
  • $\begingroup$ @ShutaoTang Mine will not fare well due to the repetitive sums so I'll leave performance testing for someone who took a different emphasis. $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 13:33
  • $\begingroup$ @Mr.Wizard +1 much neater and I like the way dealt with indexing...as usual I learn a lot :) $\endgroup$
    – ubpdqn
    Commented Jul 17, 2015 at 13:42
5
$\begingroup$

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 =
   MapThread[
    #1/#2 &,
    {Rest@dat[[All, 3]],
     MapThread[
      #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)}}*)
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ 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 ! $\endgroup$
    – ciao
    Commented Jul 17, 2015 at 10:17
  • $\begingroup$ @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...:-/ $\endgroup$
    – ubpdqn
    Commented Jul 17, 2015 at 10:22
3
$\begingroup$

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)}}
Improve this answer
$\endgroup$
2
  • $\begingroup$ FYI: Sqrt[b1 + b2 + b3] should be Sqrt[b1^2 + b2^2 + b3^2] etc. $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 13:29
  • $\begingroup$ @Mr.Wizard. Thanks for pointing out my error. I've repaired my code $\endgroup$
    – m_goldberg
    Commented Jul 17, 2015 at 14:46
2
$\begingroup$ 
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
Improve this answer
$\endgroup$
6
  • $\begingroup$ Abs was not called for. $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 13:34
  • $\begingroup$ @Mr.Wizard Neither Sqrt[b1^2]:) $\endgroup$
    – Dr. belisarius
    Commented Jul 17, 2015 at 13:35
  • $\begingroup$ I suppose, but I think my change is the logical result whereas this is a different operation. $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 13:37
  • $\begingroup$ @Mr.Wizard Well, the word "logical" has a few meanings. Here is a nice one I was reading right now. $\endgroup$
    – Dr. belisarius
    Commented Jul 17, 2015 at 13:50
  • $\begingroup$ +1 for your cheeky answer as well as the interesting article you sidetracked me with. $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 14:20
2
$\begingroup$

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@#))
  } &
Improve this answer
$\endgroup$
2
  • $\begingroup$ I see that your method is quite similar to my own, so +1 for you too. $\endgroup$
    – Mr.Wizard
    Commented Jul 17, 2015 at 13:25
  • $\begingroup$ @Mr.Wizard thank you too. Cleaned the code up a bit as well. $\endgroup$
    – LLlAMnYP
    Commented Jul 17, 2015 at 13:47
1
$\begingroup$

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]
Improve this answer
$\endgroup$
0
$\begingroup$

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}]
Improve this answer
$\endgroup$

Your Answer

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

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