MathGroup Archive 1997

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

Search the Archive

Re: Graphics manipulation question

  • To: mathgroup at smc.vnet.net
  • Subject: [mg8402] Re: [mg8318] Graphics manipulation question
  • From: Allan Hayes <hay at haystack.demon.co.uk>
  • Date: Tue, 26 Aug 1997 20:41:42 -0400
  • Sender: owner-wri-mathgroup at wolfram.com

"Seth J. Chandler" <SChandler at uh.edu>
[mg8318] Graphics manipulation question
writes

> Suppose one has a Mathematica Graphics expression called g. And
> supposefurther that one has a list of graphics primitives called p.
> And one has a boolean test function t. I want to transform the
> graphics expression g in the following way. Each time I encounter a
> primitive q in g that satisfies the boolean test function t I want
> to replace that primitive q with {q,First[p]} and to then delete
> the first element of p. If the primitive q does not satisfy t, then 
> I want to leave q alone. A practical application of this concept
> might be to ascribe different colors to some points scattered
> through a graphics expression.

Seth,
How about the following?

MapAtCase::usage =
  "MapAtCase[expr, fn, pattern] applies the function fn at each  
part of expr that matches pattern.
\nMapAtCase[expr, fn, pattern,lev, k, opts], applies fn at up to k  
positions in level lev. Options for Position are passed on.
\nThe data for fn for action at position pos are pos, index (first,  
second... selection made), k, total number of selections made  
(would it be better to simply give the list of all the selected  
positions?)";

MapAtCase[g_,f_,p_,lev_:1,k_:Infinity,opts___]:=
   Module[{h=g},
      Apply[(h[[Sequence@@#]]=f[##])&,
	 Thread[
	    {#,Range[Length[#]],k,Length[#]}&[
	      Position[g,p,lev,k, opts]
	    ]
	 ],
	 1
      ];h
   ]

Examples
g = Graphics[Table[Circle[{Random[],Random[]}, Random[]],{10}]];
cl = Table[Hue[Random[]],{10}];

MapAtCase[g,{cl[[#2]],g[[Sequence@@#]]}&,Circle[_,_?(#<.5&)],Infinity]

Show[%, AspectRatio-> Automatic]

MapAtCase[g,  	
	g[[Sequence@@#]]/.
	    Circle[p_,r_]->{Hue[.7r],Disk[p,r]}&,Circle[_,_?(#<.1&)],
	Infinity
];

Show[%, AspectRatio-> Automatic]

Allan


  • Prev by Date: I want to make Auto-Animate Button.
  • Next by Date: Re: FullSimplify[Sum[1/(n^2 +n+1)^2,{n,1,p}]]?
  • Previous by thread: Re: Graphics manipulation question
  • Next by thread: Re: Graphics manipulation question