Setting options of expressions similar to using SetOptions on objects

Another thought-provoking question Jacob, and sadly one I missed until today. After only brief consideration I think perhaps what you want can be done more simply but I look forward to your critique of my proposal.

Assumptions:

• Exact preservation of the structure of option lists is not required
• The specific order of options is not significant
• Option rules may be safely evaluated

Basic Proposal

SetAttributes[setOpts, HoldFirst]

setOpts[head_[args___, opts : OptionsPattern[]], new__] := 
 First /@ GatherBy[Flatten@{new, opts}, First] /. {op___} :> head[args, op]

Test:

setOpts[f[1], q -> r]

f[1, q -> r]

setOpts[
  f[2, q -> b, z -> x, {aa -> bb -> cc, foo :> bar}],
  z -> dog,
  a :> cat
]

f[2, z -> dog, a :> cat, q -> b, aa -> bb -> cc, foo :> bar]

setOpts[Plot[Sinc@x, {x, 0, 10}], PlotStyle -> Red]

Extended definition

To make the following case work an additional definition is required:

delay := Plot[Sinc@x, {x, 0, 10}]

setOpts[delay, PlotStyle -> Red]

setOpts[delay, PlotStyle -> RGBColor[1, 0, 0]]      (* failure *)

I shall use the same method I did for:

• How to achieve Set+Part like behaviour in custom Set function?
• why set values in this way doesn't work?
• Creating a Block from a list of rules

This will require my step function from: How do I evaluate only one step of an expression?

SetAttributes[step, HoldAll]

step[expr_] :=
  Module[{P},
    P = (P = Return[#, TraceScan] &) &;
    TraceScan[P, expr, TraceDepth -> 1]
  ]

setOpts[other_, new__] := step[other] /. _[x_] :> setOpts[x, new]

Now:

setOpts[delay, PlotStyle -> Red]

---

Related:

• Consistent Plot Styles across multiple MMA files and data sets
  (setOpts therein is not the same as the one here)

I've written a similar function, but constrained to only add options that exist in Options.

changeOptions[wrapper_[args___, old:OptionsPattern[]], new:OptionsPattern[]] := With[
    {
    newopts = changedRules[Hold[old], {new}, options[wrapper]]
    },
    Replace[newopts, Hold[o___] :> wrapper[args, o]]
]

changeOptions[Hold[wrapper_[args___, old:OptionsPattern[]]], new:OptionsPattern[]] := With[
    {
    newopts = changedRules[Hold[old], {new}, options[wrapper]]
    },
    Replace[newopts, Hold[o___] :> Hold[wrapper[args, o]]]
]

changedRules[old_, new_, defaults_] := Module[{filtered, all},
    filtered = FilterRules[Flatten @ new, defaults];
    all = DeleteDuplicatesBy[
        Join[Hold@@filtered, Flatten[old, Infinity, List]],
        First
    ];
    Complement[all, Hold@@defaults]
]

options[Inactive[h_]] := Options[h]
options[h_] := Options[h]

Basic example:

changeOptions[
    Graphics[{Circle[]}, ImagePadding->3, PlotRange->{{0,2},{0,2}}],
    ImagePadding->None
] //InputForm

Graphics[{Circle[{0, 0}]}, ImagePadding -> None, PlotRange -> {{0, 2}, {0, 2}}]

Example where defaults get removed:

changeOptions[
    Graphics[{Circle[]}, ImagePadding->3, PlotRange->{{0,2},{0,2}}],
    PlotRange->All
] //InputForm

Graphics[{Circle[{0, 0}]}, ImagePadding -> 3]

Example adding an invalid option:

changeOptions[
    Graphics[{Circle[]}, ImagePadding->None],
    foo->bar
]//InputForm

Graphics[{Circle[{0, 0}]}, ImagePadding -> None]

There is also support for held and inactive expressions. Example on a held expression (no evaluation leak):

changeOptions[
    Hold[Plot[Sin[x], {x, 1-1, Pi}, ImagePadding->10/2]],
    PlotRange->All
]
ReleaseHold@%

Hold[Plot[Sin[x],{x,1-1,[Pi]},ImagePadding->10/2,PlotRange->All]]

Example on an Inactive expression:

changeOptions[
    Inactive[Plot][Sin[x], {x, 0, Pi}, ImagePadding->All],
    ImagePadding->None
]
Activate@%

Plot[Sin[x],{x,0,[Pi]},ImagePadding->None]