5
$\begingroup$

I have a list,

l1 = {{a, b, 3, c}, {e, f, 5, k}, {n, k, 12, m}, {s, t, 1, y}}

and want to apply differences on the third parts and keep the parts right of the numerals collected.

My result should be

l2 = {{2, c, k}, {7, k, m}, {-11, m, y}}

I tried Map and MapAt, but I could not get anywhere. I could work around split things up and connect again. But is there a better way to do it?

| improve this question | | | | |
$\endgroup$
5
$\begingroup$

Perhaps this?:

l1 = {{a, b, 3, c}, {e, f, 5, k}, {n, k, 12, m}, {s, t, 1, y}};

l2 = Differences[l1[[All, 3 ;;]]] /. b_ - a_ :> Sequence[a, b]
(*  {{2, c, k}, {7, k, m}, {-11, m, y}}  *)

It assumes the letter symbols are simple and not complicated expressions.

This is more complicated, but more robust:

Flatten /@ 
 Transpose@
  MapAt[Differences, 
   Partition[Transpose@l1[[All, 3 ;;]], {1, 2}, {1, 1}], {1, All, 1}]
| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ Thank you. I have to digest your answer. $\endgroup$ – user57467 May 1 '19 at 15:03
  • $\begingroup$ How would you do it if l1= {{z,a, b, 3, c}, {w,e, f, 5, k}, {q,n, k, 12, m}, {p,s, t, 1, y}}; $\endgroup$ – user57467 May 1 '19 at 15:36
  • $\begingroup$ @user57467 I would change the third column to the fourth: l1[[All, 4 ;;]]. You can programmatically get the column with col = Position[First@l1, _?NumericQ][[1, 1]] or col = Position[First@l1, _Integer][[1, 1]]; then use l1[[All, col ;;]]. $\endgroup$ – Michael E2 May 1 '19 at 15:44
4
$\begingroup$

You can also use BlockMap as follows:

BlockMap[{#[[3]].{-1, 1}, ## & @@ Flatten@#[[4 ;;]]} &@* Transpose, l1, 2, 1]

{{2, c, k}, {7, k, m}, {-11, m, y}}

or

BlockMap[{#[[1]].{-1, 1}, ## & @@ Flatten@ #[[2 ;;]]} &@*Transpose, l1[[All, 3 ;;]], 2, 1]

{{2, c, k}, {7, k, m}, {-11, m, y}}

| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ I am impressed! $\endgroup$ – user57467 May 1 '19 at 16:08
3
$\begingroup$

This is very similar to kglr's first solution but picks the relevant quantities a bit more explicitly:

l2 = BlockMap[{#[[2, 3]] - #[[1, 3]], #[[1, 4]], #[[2, 4]]} &, l1, 2, 1]

{{2, c, k}, {7, k, m}, {-11, m, y}}

With a parameter to change the symbolic column quickly:

l2 = With[{col = 3},
  BlockMap[{#[[2,col]] - #[[1,col]], #[[1,col+1]], #[[2,col+1]]} &, l1, 2, 1]]

{{2, c, k}, {7, k, m}, {-11, m, y}}

| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ Wow! Good! I enjoy the clarity! $\endgroup$ – user57467 May 2 '19 at 16:00
1
$\begingroup$

A solution with MapThread on an offset Partition.

MapThread[Sequence @@ #@#2 &, {{Differences, Identity}, Transpose@#}] & /@ 
 Partition[l1[[All, 3 ;;]], 2, 1]
{{2, c, k}, {7, k, m}, {-11, m, y}}

Differences is applied to the integers while Identity preserves the form of the symbols.

Hope this helps.

| improve this answer | | | | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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