4
$\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?

$\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}]
$\endgroup$
  • $\begingroup$ Thank you. I have to digest your answer. $\endgroup$ – user57467 May 1 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 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 at 15:44
3
$\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}}

$\endgroup$
  • $\begingroup$ I am impressed! $\endgroup$ – user57467 May 1 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}}

$\endgroup$
  • $\begingroup$ Wow! Good! I enjoy the clarity! $\endgroup$ – user57467 May 2 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.

$\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.