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

programming competition

  • To: mathgroup at smc.vnet.net
  • Subject: [mg4847] programming competition
  • From: Xah Lee <xah at best.com>
  • Date: Thu, 26 Sep 1996 22:42:11 -0400
  • Organization: Best Internet Communications
  • Sender: owner-wri-mathgroup at wolfram.com

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.


linearInterpolate::usage = "
linearInterpolate[{p1,p2,...}, maxLength ] returns
{P1,P2,...} such that the length between neighboring points
P[i], P[i+1] is less or equal to maxLength.
Newly created points lies on a line between old points";

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
		]
	]&,
	li, 
	Reverse@ positions]), 2]
]

-----------------------

Example,

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

Show[
	Graphics[{
		Hue[0], PointSize[.02], Point/@ li
	}],
	AspectRatio->Automatic,
	Axes->True,
	PlotRange->All
];0;

Show[
	Graphics[{
		Hue[0], PointSize[.02],
		Point /@ linearInterpolate[ li, .3] 
	}],
	AspectRatio->Automatic,
	Axes->True,
	PlotRange->All
];0;

----------------------

More example

In[15]:=
gp = First@ ParametricPlot[
	t {Cos at t, Sin at t}, {t,0, 4 Pi},
	PlotPoints->10,
	MaxBend->10,
	PlotDivision->5,
	DisplayFunction->Identity
];0;

In[17]:=
Show[
	Graphics[{ Point /@ gp[[1,1,1]]
	}],
	AspectRatio->Automatic,
	Axes->True
];0;

In[18]:=
Show[
	Graphics[{ Point /@ linearInterpolate[ gp[[1,1,1]], 1 ]
	}],
	AspectRatio->Automatic,
	Axes->True
];0;


This program is used to increase resolution of arbitrary user generated graphics. 
This gives me better resolution control of transformations applies to the original 
image.

 Xah
 xah at best.com; 74631.731 at compuserve.com
 http://www.best.com/~xah/SpecialPlaneCurves_dir/specialPlaneCurves.html
 Mountain View, CA, USA

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


  • Prev by Date: Re: Importing gif, tiff... (etc) as an array
  • Next by Date: Re: Plotting functions
  • Previous by thread: Scaling a 2-D graph to a 8.5*11 inches page
  • Next by thread: Re: programming competition