Mathematica 9 is now available
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: [mg4866] Re: programming competition
  • From: rhall2 at umbc.edu (hall robert)
  • Date: Thu, 26 Sep 1996 22:42:21 -0400
  • Organization: University of Maryland, Baltimore County
  • Sender: owner-wri-mathgroup at wolfram.com

Xah wrote:
>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.

This was Xah's list of points:

In[26]:=
   li =  Join[ {{0,0},{1,1}}, Table[{i,1}, {i,1,2,1/5}], {{2,1}, {3,3}}];

Xah gave linearInterpolate[] as a solution.

In[27]:=
   linearInterpolate[ li, .3]
                                    1
   Power::infy: Infinite expression - encountered.
                                    0
   Drop::drop: Cannot drop positions -1 through -1 in {}.
Out[27]=
                                        6       7       8       9
   {{Drop[{}, -1], 0}, {0, 1}, {1, 1}, {1, -}, {1, -}, {1, -}, {1, -}, 
                                        5       5       5       5
 
     {1, 2}, {1, 2.04348}, {1.08696, 2.08696}, {1.17391, 2.13043}, 
 
     {1.26087, 2.17391}, {1.34783, 2.21739}, {1.43478, 2.26087}, 
 
     {1.52174, 2.30435}, {1.6087, 2.34783}, {1.69565, 2.3913}, 
 
     {1.78261, 2.43478}, {1.86957, 2.47826}, {1.95652, 2.52174}, 
 
     {2.04348, 2.56522}, {2.13043, 2.6087}, {2.21739, 2.65217}, 
 
     {2.30435, 2.69565}, {2.3913, 2.73913}, {2.47826, 2.78261}, 
 
     {2.56522, 2.82609}, {2.65217, 2.86957}, {2.73913, 2.91304}, 
 
     {2.82609, 2.95652}, {2.91304, 2}, {1, 3}}

Making a few small changes in linearInterpolate[] gives

In[33]:=
   linearInterpolate2[ 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
                  ]
               ]&,
               li, 
               Reverse[positions]
            ]
         ], 
         2
      ]
   ]

In[34]:=
   linearInterpolate2[ li, .3]
Out[34]=
   {{0.2, 0.2}, {0.4, 0.4}, {0.6, 0.6}, {0.8, 0.8}, {0, 0}, {1, 1}, 
 
               6       7       8       9
      {1, 1}, {-, 1}, {-, 1}, {-, 1}, {-, 1}, {2, 1}, {2.125, 1.25}, 
               5       5       5       5
 
      {2.25, 1.5}, {2.375, 1.75}, {2.5, 2.}, {2.625, 2.25}, 
 
      {2.75, 2.5}, {2.875, 2.75}, {2, 1}, {3, 3}}

This is better, but it still doesn't give the answer in the form Xah 
specified; the new points are not positioned in the list between the points
they're being interpolated between, i. e. they are not
{p1, p2, p3, newP1, newP2,..., newPm, p4, p5, ... , pn}.

With Lichtblau's and Hayes' admonitions to use procedural programming 
to solve procedural problems ringing freshly in my ears, I offer the
following:

In[69]:=
   insertPoints[points_List, maxDistance_] := Module[
      {vector, distance},
	
      Append[
         Flatten[	
            Table[
               If[
                  vector = 
                     points[[pointIndex]] - 
                     points[[pointIndex + 1]]
                  ;
                  distance = N[Sqrt[vector . vector]];
			
                  distance > maxDistance,
                  (points[[pointIndex]] - #)& /@ Table[
                     multiplier * vector / distance,
                     {
                        multiplier, 
                        0,
                        distance,
                        maxDistance
                     }
                  ],
                  {points[[pointIndex]]}
               ],
               {pointIndex, Length[points] - 1}
            ], 
            1
         ],
         Last[points]
      ]
   ]
In[70]:=
   insertPoints[li, .3]
Out[70]=
   {{0, 0}, {0.212132, 0.212132}, {0.424264, 0.424264}, 
 
      {0.636396, 0.636396}, {0.848528, 0.848528}, {1., 1.}, {1., 1.}, 
 
      {1.2, 1.}, {1.4, 1.}, {1.6, 1.}, {1.8, 1.}, {2., 1.}, {2., 1.}, 
 
      {2.13416, 1.26833}, {2.26833, 1.53666}, {2.40249, 1.80498}, 
 
      {2.53666, 2.07331}, {2.67082, 2.34164}, {2.80498, 2.60997}, 
 
      {2.93915, 2.8783}, {3., 3.}}

Xah's description of the problem didn't say anything about having the
points evenly spaced, so they're not. But it would be simple to modify
one line of code so they were evenly spaced.

As Lichtblau points out, repeated copying of lists makes the problem 
O(n^2).

In[137]:=
   pointsList1 = Table[{Random[], Random[]}, {100}];
   pointsList2 = Table[{Random[], Random[]}, {1000}];

In[139]:=
   linearInterpolate2[ pointsList1, .3]; // Timing
   linearInterpolate2[ pointsList2, .3]; // Timing
Out[139]=
   {3.8 Second, Null}
Out[140]=
   {15.75 Second, Null}

Avoiding copying of lists keeps the problem to O(n)

In[143]:=
   insertPoints[pointsList1, .3]; // Timing
   insertPoints[pointsList2, .3]; // Timing
Out[143]=
   {2.4 Second, Null}
Out[144]=
   {4.25 Second, Null}

I periodically need to do fairly complicated operations on
small lists. Using the list manipulation functions may make the 
problem O(n^2), but for small lists this doesn't really matter.
Using Append[], Rest[], and similar functions simplifies the
code and makes it easier to develop and debug, compared to 
using a procedural approach and trying to write the fastest
code possible. In Xah's and Richard Gaylord's (actually, Don 
Piele's) problems it was easier to develop a solution using
a procedural approach, but it is often easier to use an approach
that results in slower code. What I ask from Mathematica is that
the code be as clear and self-documenting as possible, the
development process be as short and painless as possible, and
the result be correct. If speed were that important to me
I'd be writing in a compiled language. The problem with many
blocks of code is not that they're slow, but that
they're confusing. This makes it more  difficult to debug
and be sure of getting a correct result. Overall, I think
top-down design and attention to formatting are more important
that speed. Because of it's clarity, I liked Paul Abbott's pattern
matching approach to the Gaylord-Piele problem. It worked fine 
on short lists and you could tell at a glance what the code was 
doing.

-- 
Bob Hall            | "Know thyself? Absurd direction!
rhall2 at gl.umbc.edu  |  Bubbles bear no introspection."  -Khushhal Khan Khatak

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


  • Prev by Date: Optic For Sale-Best Offer
  • Next by Date: Re: Importing gif, tiff... (etc) as an array
  • Previous by thread: programming competition
  • Next by thread: Black Holes & Mathcad