Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1996
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1996

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: programming competition

  • To: mathgroup at smc.vnet.net
  • Subject: [mg4900] Re: programming competition
  • From: Xah Lee <xah at best.com>
  • Date: Fri, 4 Oct 1996 00:17:38 -0400
  • Organization: Best Internet Communications
  • Sender: owner-wri-mathgroup at wolfram.com

At 10:42 PM 96/9/26, Xah Lee wrote:
>This is a programming problem I recently encountered. The problem has the 
>attraction of being a programming competition type. I post the problem and my 
>solution here and hope someone will enjoy and maybe come out with other solutions.
>
>Problem:
>Suppose you have a ordered list {p1, p2, ... , pn} where points has the form 
>{x,y}. You want to modify the list so any neighboring points will have a distance 
>less or equal to a given value maxLength. You do this by adding points in between 
>points. For example, suppose p3 and p4 has length greater than maxLength. Your new 
>list should then be
>{p1, p2, p3, newP1, newP2,..., newPm, p4, p5, ... , pn} where 
>newP1, ...newPm lies on the line p3 p4.


A few people have responded. Attached below are the codes and a timing
result.

Clear[linearInterpolate, insertPoints, linearInterpolateEH1,
linearInterpolateEH2]


(* by Xah Lee xah at best.com *)
linearInterpolate[ li_List, maxLength_ ]:=
Module[{positions},
  positions = Flatten@ Position[
    N@ Sqrt[#.#]& /@ Rest[ li-RotateRight[li] ],
    x_/; (x > maxLength), {1} 
  ];
  Partition[ Flatten@ (Fold[
  Module[{p1 = li[[#2]], p2 = li[[#2+1]]},
    Insert[
      #1,
      Drop[
        Rest@ Table[ (p2-p1) i + p1,
          {i, 0, 1, 1./Ceiling@ N[Sqrt[Plus@@((p2-p1)^2)]/maxLength] } 
        ],-1
      ],
      #2 +1
    ]
  ]&,
  li, 
  Reverse@ positions]), 2]
]


(* by  rhall2 at umbc.edu (hall robert), (modified a bit) *)
insertPoints[li_List, maxLength_] := Module[
  {v, dist},    
  Append[
    Flatten[
      Table[
            If[
              v = li[[i]] - li[[i + 1]];
              dist = N[Sqrt[v.v]];
              dist > maxLength,
              (li[[i]] - #)& /@ Table[ v*j/dist,
                  {j, 0, dist -dist/Ceiling@ N[dist/maxLength],
                  dist/Ceiling@ N[dist/maxLength] } 
                ],
              {li[[i]]}
            ],
            {i, Length@ li - 1}
          ]
    ,1
    ],
   Last@ li
  ]
]


(* by espen.haslund at fys.uio.no (Espen Haslund) *)

linearInterpolateEH1[ li_List, maxLength_ ]:=
Module[{res={}, p1, p2, n},
   Do[
      {p1, p2} = li[[{i, i+1}]];
      n = Max[Ceiling[Sqrt[#.#]&[N[p2-p1]]/maxLength],1];
      res = {res,Table[p1+(p2-p1)j,{j,0,1-.5/n,1./n}]},
   {i, 1, Length[li]-1}];
   Partition[Flatten[{res, Last[li]}],2]
]


(* by espen.haslund at fys.uio.no (Espen Haslund) *)

linearInterpolateEH2[ li_List, maxLength_ ]:=
Module[{p1, p2, n},
 Append[Join @@ Table[{p1, p2} = li[[{i, i+1}]];
  n = Max[Ceiling[Sqrt[#.#]&[N[p2-p1]]/maxLength],1];
   Table[p1+(p2-p1)j,{j,0,1-.5/n,1./n}],
    {i,1,Length[li]-1}], Last[li] ]
]

(*-----------timing results -------------*)


li = Table[{Random[], Random[]}, {1000}];
maxLength = .1;

a1 = Timing@ linearInterpolate[ li, maxLength];
a2 = Timing@ insertPoints[ li, maxLength];
a3 = Timing@ linearInterpolateEH1[ li, maxLength];
a4 = Timing@ linearInterpolateEH2[ li, maxLength];

First /@ {a1,a2,a3,a4}

(* {20. Second, 9.36667 Second, 8.81667 Second, 7.9 Second} *)

SameQ@@ Last /@ SetPrecision[{a1,a2,a3,a4},5]
(* True *)

Except that my functional approach is the slowest by an order,
Robert Hall and Espen Haslund's sequential approach are similar.
Now perhaps someone can give a pattern matching approach?

 Xah
 xah at best.com; 74631.731 at compuserve.com

http://www.best.com/~xah/PageTwo_dir/MathGraphicsGallery_dir/mathGraphicsGallery.html
 Mountain View, CA, USA

==== [MESSAGE SEPARATOR] ====


  • Prev by Date: Conjugate
  • Next by Date: Re: Pattern matching
  • Previous by thread: Re: Re: programming competition
  • Next by thread: Re: programming competition