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$
7
  • 5
    $\begingroup$ Riffle[list1, Transpose[{Rest[#1], Most[#2]}] & @@ Transpose[list1]]? $\endgroup$ Commented Aug 6, 2017 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$ Commented Aug 6, 2017 at 2:02
  • $\begingroup$ So sorry yes. You are right. $\endgroup$ Commented Aug 6, 2017 at 2:22
  • $\begingroup$ @J.M. your code is wonderful. I must see how that works. $\endgroup$ Commented Aug 6, 2017 at 2:25
  • 1
    $\begingroup$ I'm not marrying you, sorry. ;) $\endgroup$ Commented Aug 6, 2017 at 19:00

3 Answers 3

5
$\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$
2
  • $\begingroup$ I do apologize for my question but I cannot understand the mean of Developer`PartitionMap . what does it mean!!! $\endgroup$ Commented Aug 6, 2017 at 2:49
  • $\begingroup$ @Irreversible, I updated with some explanation. Hope it helps. $\endgroup$
    – kglr
    Commented Aug 6, 2017 at 3:19
3
$\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$
3
$\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$
1
  • $\begingroup$ The comparison is amazing, +1, $\endgroup$ Commented Aug 6, 2017 at 16:58

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.