How to clear a selection of definitions from UpValues?

Question

I'm trying to set up a bunch of 2D points using UpSet that I am going to use later for building lines and graphs.

Clear[coords, point]
coords[point[0]] = {3, 2.3};
coords[point[1]] = {8, 3.43};

etc. Also, I'm using the same approach to set up some basic characteristics for my shapes, eg. their color, PointSize etc.

Clear[color, size]

(* colors *)
color[point[0]] ^= Blend[{Yellow, Magenta}, 0.25];
color[point[1]] ^= Blend[{Cyan, Yellow}, 0.75];

(* sizes *)
size[point[0]] ^= PointSize[0.025];
size[point[1]] ^= PointSize[0.035];

Now, I figured it would be easier to automate some part of the process eg. for making points, again using UpSet

(* make points *)
point /* ({#, size[#], color[#], Point[coords[#]]} &) /* 
  (Through[{First /* graphics, Rest /* Graphics}[#]] &) /* 
    Apply[UpSet] /@ Range[0, 1]

but it's not working how I was expecting it to behave: every time I re-evaluate the code snippet that creates my points (ie. the code shown above), I get an UpSet::write error.

From what I gather, the first time that the code executes, it performs the expected assignments, ie it usesgraphic[point[n]] to assign to the UpValues of point the associated Graphics object, but from there on, any future evaluation prematurely (for my purposes) evaluates the part inside ... Through[{First /* graphics, ...}] ... and when it's time for ... Apply[UpSet] ... to do the job, it fails because it's not seeing

graphics[point[...]] ^= {graphics primitives...}

but it actually gets

Graphics[{...}] ^= {graphics primitives}

and since the contents of Graphics are inside a List, the kernel complains with the UpSet::write that "Tag List in <it actually displays a graphic> is Protected", letting me know I don't have access to the UpValues of List, which makes sense, but I wasn't trying to do that!

My first instinct was to try and clear the definitions of graphics[point[n]] before every new assignment, but I couldn't and this is when I realized I was having a problem of premature evaluation on my hands.

My ugly solution is to clear the definitions before re-evaluation using the following helper function unset, which removes the relevant definitions from UpValues before I re-insert them, using the code in the code snippet (* make points *) above:

Clear[unset]

SetAttributes[unset, HoldFirst]

unset[head_[expr_[n_]]] := Module[{upvalues},
  upvalues = UpValues[expr];
  UpValues[expr] = {};
  UpValues[expr] = Cases[upvalues, Except[_[head[expr[n]]] :> _]];
]
point /* graphics /* unset /@ Range[0, 1]

Is there a better approach?

Answer 1

Here's the easiest way I can think of, without restructuring your code so that everything is evaluated at the right time, and without playing around with tricky Unevaluated wrappers: use inactivated versions of the symbols that are evaluating prematurely when building the expression, then Activate them once it's built. We'll use the Inactive versions of UpSet and point:

Inactive[point] /* ({#, size[#], color[#], Point[coords[#]]} &) /* 
  (Through[{First /* graphics, Rest /* Graphics}[#]] &) /* 
  Apply[Inactive[UpSet]] /@ Range[0, 1] // Activate

This works here for a couple reasons (some of which could break in other situations):

1. Graphics doesn't complain or evaluate to a Failure when supplied with non-graphical arguments, so it's okay to have Inactive[point] inside it for a bit; otherwise, we might have had to use Inactive[Graphics] as well

2. UpSet evaluates its second argument before assigning the upvalue, so we get a good Graphics expression, as e.g. size[point[...]] is given the chance to evaluate to a valid graphics primitive after activation

3. Activate doesn't have any Hold* attributes, so its argument evaluates fully before anything is Activated

There are lots of other ways, e.g. using Unevalauted at the right times, using Holds, and using functions with hold attributes (e.g. Function[Null, ..., HoldAll] instead of the #/& ones), but this seems simplest to me.