Setting options of expressions similar to using SetOptions on objects

Question

Introduction

I often have the problem that in an expression, I want to change an option. If we are sure the option is not present, we could simply use Append[expression, opt -> val]. But sometimes such an expression is very long and it can be a bit of a pain to see if this option is already present.

Example

We have

Notebook[{Cell["hello", "Text"]}]

we want

Notebook[{Cell["hello", "Text"]}, Background -> LightGreen]

Mathematica has some built in functions for setting options. They are SetOptions, Option in combination with Set (which I think does the same thing as SetOptions) and CurrentValue in combination with Set. None of these seem to do what I want.

Silly things I tried

The fact that we can use Options with Set may sound promising, but although we can ask the value of an option in an expression, we cannot set it.

Example

kkkk:=f[2,q->c,z->x,zz->xx];
Options[kkkk]
Options[kkkk, q]

{q -> c, z -> x, zz -> xx} 
{q -> c}

But

Options[kkkk] = {q -> d, z -> x, zz -> xx}

gives an error and

Options[Unevaluated@kkkk] = {q -> d, z -> x, zz -> xx}

does something strange.

Nice function

So I have made my own function

setExpressionOptions[
  head_[
   a__,
   b : Longest[ OptionsPattern[], 1],
   Longest[(symb_ -> _) ..., 2],
   d : OptionsPattern[]
   ],
  symb_ -> val_
  ] := head[a, b, symb -> val, d]

Examples of use

setExpressionOptions[f[2, q -> b, z -> x, zz -> xx], q -> c]

 f[2, q -> c, z -> x, zz -> xx]

setExpressionOptions[f[2, z -> x, zz -> xx], q -> c]

 f[2, z -> x, zz -> xx, q -> c]

The function also works with Unevaluated

setExpressionOptions[Unevaluated[Plot[x, {x, 0, 1}]], PlotStyle -> Red]

 (*a plot with a red line*)

Note that we really need Unevaluated here, otherwise the expression with head Plot evaluates to an expression with head Graphics, which does not work with PlotStyle.

Possible extension

We can define the function setOptions like this

setOptions[
  x_ /; MemberQ[{NotebookObject, CellObject, FrontEndObject, InputStream, 
     OutputStream, Symbol, String}, Head[Unevaluated@x]], y___
  ] := SetOptions[x, y]

setOptions[z___] := setExpressionOptions[z]

Examples of use

setOptions[EvaluationNotebook[], Background -> LightGreen]

(*makes the background LightGreen*)

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

f[1, q -> r]

Question

I like the functions quite a lot, but they could be better. It would be nice if we could set any number of options at once using setExpressionOptions.

Example of desired evaluation

setExpressionOptionsBetter[
 Notebook[{Cell["hello", "Text"]}, Background -> LightGreen],
 Background -> Cyan,
 DynamicUpdating -> True
 ]

 Notebook[{Cell["hello", "Text"]}, Background -> Cyan, DynamicUpdating -> True]

Note that SetOptions works the same way; beyond position one there are any number of Rules. That also makes integrating this case in setOptions easier.

Also I am sure I left out a lot of heads in the test in setOptions. The Q&A How can I work out which functions work with SetOptions? sounded promising for making the list more complete, but I guess it is not helpful.

• Main question*: Can we add the additional functionality?

  • sub Question 1: Did I overlook anything and can this be done easier?

  • sub Question 2: Can this use of Longest lead to bad performance? (probably no)

Answer 1

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)

Answer 2

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]