6
$\begingroup$

I obtained a list:

(original list)
 list1=
 {{-2.25, 24},
 {-2.24, 0},
 {-2.23, 0},
 {-2.22, 10},
 {-2.21, 32},
 {-2.20, 50}};

I am motivated to create another list in which some pairs (x,y) add to the first list according to a law: x: brings from the next pair of original list and y repeats from the past pair in the original list.

list2=
 {{-2.25, 24}, {-2.24, 24},
 {-2.24, 0}, {-2.23, 0},
 {-2.23, 0}, {-2.22, 0},
 {-2.22, 10}, {-2.21, 10},
 {-2.21, 32}, {-2.20, 32},
 {-2.20, 50}}
$\endgroup$
  • 5
    $\begingroup$ Riffle[list1, Transpose[{Rest[#1], Most[#2]}] & @@ Transpose[list1]]? $\endgroup$ – J. M. is away Aug 6 '17 at 1:57
  • $\begingroup$ I think you have mis-copied list2. I think you want it to be list2 = {{-2.25, 24}, {-2.24, 24}, {-2.24, 0}, {-2.23, 0}, {-2.23, 0}, {-2.22, 0}, {-2.22, 10}, {-2.21, 10}, {-2.21, 32}, {-2.20, 32}, {-2.20, 50}} $\endgroup$ – Jack LaVigne Aug 6 '17 at 2:02
  • $\begingroup$ So sorry yes. You are right. $\endgroup$ – Unbelievable Aug 6 '17 at 2:22
  • $\begingroup$ @J.M. your code is wonderful. I must see how that works. $\endgroup$ – Unbelievable Aug 6 '17 at 2:25
  • 1
    $\begingroup$ I'm not marrying you, sorry. ;) $\endgroup$ – J. M. is away Aug 6 '17 at 19:00
6
$\begingroup$
 Join @@ Developer`PartitionMap[If[Length@# === 1, #, {#[[1]], {#[[2, 1]], #[[1, 2]]}}] &, 
 list1, 2, 1, 1, {}]  == list2

True

Join @@ (If[Length@# === 1, #, {#[[1]], {#[[2, 1]], #[[1, 2]]}}] & /@ 
    Partition[list1, 2, 1, 1, {}]) == list2

True

Steps:

Partition list into parts of length up to 2 with offset 1 (take 2 elements move 1 step):

l1 = Partition[list1, 2, 1, 1, {}]

{{{-2.25, 24}, {-2.24, 0}},
{{-2.24, 0}, {-2.23, 0}},
{{-2.23, 0}, {-2.22, 10}},
{{-2.22, 10}, {-2.21, 32}},
{{-2.21, 32}, {-2.2, 50}},
{{-2.2, 50}}}

The function

func = If[Length@# === 1, #, {#[[1]], {#[[2, 1]], #[[1, 2]]}}] &;

leaves objects with Length 1 untouched, and, for two-element arguments modifies the second element to make its last entry equal to that of the first. Applied to the first element of l1 it gives

func @ l1[[1]]

{{-2.25, 24}, {-2.24, 24}}

Mapped to each element of l1 it gives

func /@ l1

{{{-2.25, 24}, {-2.24, 24}},
{{-2.24, 0}, {-2.23, 0}},
{{-2.23, 0}, {-2.22, 0}},
{{-2.22, 10}, {-2.21, 10}},
{{-2.21, 32}, {-2.2, 32}},
{{-2.2, 50}}}

Flattening this gives list2.

Developer`PartititionMap[func, list, other arguments] is equivalent to func /@ Partition[list, other arguments], that is, it applies the function to each element of the partition.

$\endgroup$
  • $\begingroup$ I do apologize for my question but I cannot understand the mean of Developer`PartitionMap . what does it mean!!! $\endgroup$ – Unbelievable Aug 6 '17 at 2:49
  • $\begingroup$ @Irreversible, I updated with some explanation. Hope it helps. $\endgroup$ – kglr Aug 6 '17 at 3:19
4
$\begingroup$

You can also use ReplaceAll

list = {{-2.25, 24}, {-2.24, 0}, {-2.23, 0}, {-2.22, 10}, {-2.21, 32}, {-2.20, 50}};

Append[Partition[list, 2, 1] /. {p : {_, a_}, {b_, _}} :> 
   Sequence[p, {b, a}], Last@list]

{{-2.25, 24}, {-2.24, 24},
{-2.24, 0}, {-2.23, 0},
{-2.23, 0}, {-2.22,0},
{-2.22, 10}, {-2.21, 10},
{-2.21, 32}, {-2.2, 32},
{-2.2, 50}}

Or

Most@Catenate@MapThread[{#1, {First@#2, Last@#1}} &, {list, RotateLeft@list}]
$\endgroup$
2
$\begingroup$

J. M.'s method is much faster than others provided, and deserves its own answer.

The champion:

fastJM[a_] := Riffle[a, {Rest[#1], Most[#2]}\[Transpose] & @@ (a\[Transpose])] 

The contenders:

kglr[a_] :=
  Join @@ Developer`PartitionMap[
    If[Length@# === 1, #, {#[[1]], {#[[2, 1]], #[[1, 2]]}}] &, a, 2, 1, 1, {}]

eldo1[list_] :=
  Append[Partition[list, 2, 1] /. {p : {_, a_}, {b_, _}} :> 
    Sequence[p, {b, a}], Last@list];

eldo2[list_] :=
  Most@Catenate@MapThread[{#1, {First@#2, Last@#1}} &, {list, RotateLeft@list}]

My own contribution, a variation of J.M.'s Riffle code:

JMmod[a_] := Riffle[a, {a[[2 ;;, 1]], a[[;; -2, 2]]}\[Transpose]]

Benchmark

With a packed array of reals:

Needs["GeneralUtilities`"]

BenchmarkPlot[{fastJM, kglr, eldo1, eldo2, JMmod}, RandomReal[9, {#, 2}] &, 10]

enter image description here

With unpackable Strings:

BenchmarkPlot[{fastJM, kglr, eldo1, eldo2, JMmod},
  RandomChoice[Alphabet[], {#, 2}] &, 10]

enter image description here

It appears that my variation manages a slight edge on the original in the case of unpackable data, but it falls behind on a packed array. None of the other methods come close in either test.

$\endgroup$
  • $\begingroup$ The comparison is amazing, +1, $\endgroup$ – Unbelievable Aug 6 '17 at 16:58

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.