6
$\begingroup$

Say I have a list of coordinates in an array

{{0, 0}, {0, 1}, {1, 1}}

I'd like to create a new array where, between each pair of nearest-neighbor coordinates in the previous array, I place $k$ points equispaced on a linear interval between the points. For example, with $k = 3$ we would generate the array:

{{0, 0}, {0, 0.25}, {0, 0.5}, {0, 0.75}, {0, 1},
   {0.25, 1}, {0.5, 1}, {0.75, 1}, {1, 1}}

Is there a nice one-liner for doing this?

Improve this question
$\endgroup$
1
  • $\begingroup$ @user8646 Did you try Insert[]? $\endgroup$
    – Rod
    Commented Jul 20, 2013 at 14:35

4 Answers 4

Reset to default
5
$\begingroup$

edit InterpolationFunction

list = {{0, 0}, {0, 1}, {1, 1}}
k = 3;
r = (k + 1) Length@list - k;
Interpolation[Transpose[{Range[1, r, k + 1], #}], x,InterpolationOrder -> 1
             ] &/@ Transpose[list] /. {x -> #} & /@ Range[r]

{{0, 0}, {0, 1/4}, {0, 1/2}, {0, 3/4}, {0, 1}, 
   {1/4, 1}, {1/2, 1}, {3/4, 1}, {1, 1}}

old

This works but is suspiciously long:

list = {{0, 0}, {0, 1}, {1, 1}};
k=3;

{list[[1]]}~Join~(
  Sequence @@ Table[#1 + i (#2 - #1)/(k + 1), {i, 1, k + 1}] & @@@ Partition[list, 2, 1])

{{0, 0}, {0, 1/4}, {0, 1/2}, {0, 3/4}, {0, 1}, {1/4, 1}, {1/2, 1}, 
  {3/4, 1}, {1, 1}}

I do not like Join there so this is interesting replacement with Riffle (the difference is also in iterator range):

Riffle[
   Sequence @@ Table[#1 + i (#2 - #1)/(k + 1), {i, 1, k}] & @@@ Partition[list, 2, 1],  
   list, 
   {1, -1, k + 1}
      ]
Improve this answer
$\endgroup$
6
  • $\begingroup$ @user8646 Please, do not accept so fast, I'm sure something better will appear :). You can still upvote if you like it ;) $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 14:39
  • $\begingroup$ I am getting "Table::iterb: Iterator {i,1,1+k} does not have appropriate bounds. >>" while running this..any idea ? $\endgroup$
    – Pankaj Sejwal
    Commented Jul 20, 2013 at 15:11
  • $\begingroup$ @Blackbird You have to set k=3 for example. OP wants to be able to change k. I should have posted it. $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 15:15
  • $\begingroup$ yes now I got it..thanks $\endgroup$
    – Pankaj Sejwal
    Commented Jul 20, 2013 at 15:23
  • $\begingroup$ @Blackbird No, thank you :) $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 15:24
9
$\begingroup$

A very neat one liner does exist, and it's done using the 3 argument form of Array. Observe the following:

Array[# &, 5, {{0, 1}, {1, 1}}]
(* {{0, 1}, {1/4, 1}, {1/2, 1}, {3/4, 1}, {1, 1}} *)

where the 5 is your desired number of inserts (3) plus the endpoints (2). Array automatically does the insertion in the appropriate coordinates. Now you just need to use this on consecutive pairs and remove duplicate endpoints.

insertPoints[coords_, k_] := Array[# &, k + 2, #] & /@ Partition[coords, 2, 1] /. 
    {h__, t_} /; Length@coords > 2 :> Join[Most /@ {h}, {t}] ~Flatten~ 1

With your list of coords, 

insertPoints[{{0, 0}, {0, 1}, {1, 1}}, 3] // N
(* {{0., 0.}, {0., 0.25}, {0., 0.5}, {0., 0.75}, {0., 1.}, 
    {0.25, 1.}, {0.5, 1.}, {0.75, 1.}, {1., 1.}} *)
Improve this answer
$\endgroup$
6
  • $\begingroup$ Very nice use of Array! $\endgroup$
    – bill s
    Commented Jul 20, 2013 at 16:29
  • $\begingroup$ +1 for 3rd Array's argument reminding. It's a pity, that even with Array, insertPoints can't be shorter. $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 16:35
  • $\begingroup$ @Kuba Well, I tend to go by functionality and not just # of characters alone. Here, the primary need is to linearly sample and insert points between two coordinates A and B, and that is achieved in one Array call. The others are mostly for changing the OP's input to a suitable form and changing the output to OP's desired form (someone else could have a different form). These could be functions in their own right (thus usable elsewhere) and moved outside in OP's actual code. So it might end up looking like insertPoints[#, 5]& /@ coordPairs@coords // removeDupeEndpoints, which is clean. $\endgroup$
    – rm -rf ♦
    Commented Jul 20, 2013 at 16:46
  • $\begingroup$ @rm-rf Fantastic - $\endgroup$
    – user8646
    Commented Jul 20, 2013 at 16:56
  • $\begingroup$ @rm-rf I agree, do not get me wrong, I like it more than mine since Array does the dirty job. :) $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 17:04
7
$\begingroup$

One line, as requested:

BSplineFunction[{{0, 0}, {0, 1}, {1, 1}}, SplineDegree -> 1] /@ Range[0, 1, 1/8]

(* {{0., 0.}, {0., 0.25}, {0., 0.5}, {0., 0.75}, {0., 1.},
    {0.25,  1.}, {0.5, 1.}, {0.75, 1.}, {1., 1.}}

More generally, as a function:

insertPoints[pts_?ArrayQ, k_Integer] := 
  BSplineFunction[pts, SplineDegree -> 1] /@ Range[0, 1, 1/((k + 1) (Length@pts - 1))]

insertPoints[{{0, 0}, {0, 1}, {1, 1}}, 3]
(* same output as above *)
Improve this answer
$\endgroup$
6
  • $\begingroup$ I'm struggling with InterpolationFunction but this is far better. $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 18:46
  • $\begingroup$ @Kuba If you figure out how to interpolate between points (not just real numbers), please post. (You could use two Interpolations to interpolate x and y separately, of course.) $\endgroup$
    – Michael E2
    Commented Jul 20, 2013 at 19:18
  • $\begingroup$ I know, I did, take a look at my edit :) (indeed double Interpolate) But is is not as handy as BSplineFunction $\endgroup$
    – Kuba
    Commented Jul 20, 2013 at 19:23
  • $\begingroup$ I see it now - Good - I responded to the comment ping without looking at anything else. $\endgroup$
    – Michael E2
    Commented Jul 20, 2013 at 23:42
  • $\begingroup$ Nice approach! +1 $\endgroup$
    – Mr.Wizard
    Commented Jul 30, 2013 at 1:29
3
$\begingroup$

This method is limited, only working for k values of the form $2^n - 1$, but I like the style:

Nest[# ~Riffle~ MovingAverage[#, 2] &, a, 2]

{{0, 0}, {0, 1/4}, {0, 1/2}, {0, 3/4}, {0, 1}, {1/4, 1}, {1/2, 1}, {3/4, 1}, {1, 1}}

On the upside this method is concise and faster even than BSplineFunction.

More practically, here is my own application of Interpolation:

linearFill[a_List, k_Integer] :=
  Interpolation[MapIndexed[{#2, #} &, a], InterpolationOrder -> 1] /@ 
    Range[1, Length@a, 1/(k + 1)]

linearFill[{{0, 0}, {0, 1}, {1, 1}}, 2]

{{0, 0}, {0, 1/3}, {0, 2/3}, {0, 1}, {1/3, 1}, {2/3, 1}, {1, 1}}

This function is faster than Kuba's code, but not as fast as insertPoints which is blazing fast but only returns machine precision numbers. (I could not test R.M's method in version 7.)

Improve this answer
$\endgroup$
1
  • $\begingroup$ Yes, that's the Interpolation I was looking for. I thought I tried it. Actually, I thought I remembered using it a while ago, and when I tried it here, no go. Must have goofed. Thanks. The first one is cute. $\endgroup$
    – Michael E2
    Commented Jul 30, 2013 at 4:35

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.