Preventing avalanche of runtime errors in Mathematica - wolfram-mathematica

A typical situation I run into when notebook grows beyond a couple of functions -- I evaluate an expression, but instead of correct answer I get Beep followed by dozens of useless warnings followed by "further Output of ... will be suppressed"
One thing I found useful -- use Python-like "assert" inside functions to enforce internal consistency. Any other tips?
Assert[expr_, msg_] := If[Not[expr], Print[msg]; Abort[], None]
edit 11/14
A general cause of a warning avalanche is when a subexpression evaluates to "bad" value. This causes the parent expression to evaluate to a "bad" value and this "badness" propagates all the way to the root. Built-ins evaluated along the way notice the badness and produce warnings. "Bad" could mean an expression with wrong Head, list with wrong number of elements, negative definite matrix instead of positive definite, etc. Generally it's something that doesn't fit in with the semantics of the parent expression.
One way do deal with this is to redefine all your functions to return unevaluated on "bad input." This will take care of most messages produced by built-ins. Built-ins that do structural operations like "Part" will still attempt to evaluate your value and may produce warnings.
Having the debugger set to "break on Messages" prevents an avalanche of errors, although it seems like an overkill to have it turned on all the time

As others have pointed out, there are three ways to deal with errors in a consistent manner:
correctly typing parameters and setting up conditions under which your functions will run,
dealing correctly and consistently with errors generated, and
simplifying your methodology to apply these steps.
As Samsdram pointed out, correctly typing your functions will help a great deal. Don't forget about the : form of Pattern as it is sometimes easier to express some patterns in this form, e.g. x:{{_, _} ..}. Obviously, when that isn't sufficient PatternTests (?) and Conditions (/;) are the way to go. Samdram covers that pretty well, but I'd like to add that you can create your own pattern test via pure functions, e.g. f[x_?(Head[#]===List&)] is equivalent to f[x_List]. Note, the parentheses are necessary when using the ampersand form of pure functions.
The simplest way to deal with errors generated is obviously Off, or more locally Quiet. For the most part, we can all agree that it is a bad idea to completely shut off the messages we don't want, but Quiet can be extremely useful when you know you are doing something that will generate complaints, but is otherwise correct.
Throw and Catch have their place, but I feel they should only be used internally, and your code should communicate errors via the Message facilities. Messages can be created in the same manner as setting up a usage message. I believe the key to a coherent error strategy can be built using the functions Check, CheckAbort, AbortProtect.
Example
An example from my code is OpenAndRead which protects against leaving open streams when aborting a read operation, as follows:
OpenAndRead[file_String, fcn_]:=
Module[{strm, res},
strm = OpenRead[file];
res = CheckAbort[ fcn[strm], $Aborted ];
Close[strm];
If[res === $Aborted, Abort[], res] (* Edited to allow Abort to propagate *)
]
which, Until recently, has the usage
fcn[ file_String, <otherparams> ] := OpenAndRead[file, fcn[#, <otherparams>]&]
fcn[ file_InputStream, <otherparams> ] := <fcn body>
However, this is annoying to do every time.
This is where belisarius solution comes into play, by creating a method that you can use consistently. Unfortunately, his solution has a fatal flaw: you lose support of the syntax highlighting facilities. So, here's an alternative that I came up with for hooking into OpenAndRead from above
MakeCheckedReader /:
SetDelayed[MakeCheckedReader[fcn_Symbol, symbols___], a_] :=
Quiet[(fcn[file_String, symbols] := OpenAndRead[file, fcn[#, symbols] &];
fcn[file_Symbol, symbols] := a), {RuleDelayed::"rhs"}]
which has usage
MakeCheckedReader[ myReader, a_, b_ ] := {file$, a, b} (*as an example*)
Now, checking the definition of myReader gives two definitions, like we want. In the function body, though, file must be referred to as file$. (I have not yet figured out how to name the file var as I'd wish.)
Edit: MakeCheckedReader works by not actually doing anything itself. Instead, the TagSet (/:) specification tells Mathematica that when MakeCheckedReader is found on the LHS of a SetDelayed then replace it with the desired function definitions. Also, note the use of Quiet; otherwise, it would complain about the patterns a_ and b_ appearing on the right side of the equation.
Edit 2: Leonid pointed out how to be able to use file not file$ when defining a checked reader. The updated solution is as follows:
MakeCheckedReader /:
SetDelayed[MakeCheckedReader[fcn_Symbol, symbols___], a_] :=
Quiet[(fcn[file_String, symbols] := OpenAndRead[file, fcn[#, symbols] &];
SetDelayed ## Hold[fcn[file_Symbol, symbols], a]),
{RuleDelayed::"rhs"}]
The reasoning for the change is explained in this answer of his. Defining myReader, as above, and checking its definition, we get
myReader[file$_String,a_,b_]:=OpenAndRead[file$,myReader[#1,a_,b_]&]
myReader[file_Symbol,a_,b_]:={file,a,b}

I'm coming late to the party, with an accepted answer and all, but I want to point out that definitions of the form:
f[...] := Module[... /; ...]
are very useful in this context. Definitions of this kind can perform complex calculations before finally bailing out and deciding that the definition was not applicable after all.
I will illustrate how this can be used to implement various error-handling strategies in the context of a specific case from another SO question. The problem is to search a fixed list of pairs:
data = {{0, 1}, {1, 2}, {2, 4}, {3, 8}, {4, 15}, {5, 29}, {6, 50}, {7,
88}, {8, 130}, {9, 157}, {10, 180}, {11, 191}, {12, 196}, {13,
199}, {14, 200}};
to find the first pair whose second component is greater than or equal to a specified value. Once that pair is found, its first component is to be returned. There are lots of ways to write this in Mathematica, but here is one:
f0[x_] := First # Cases[data, {t_, p_} /; p >= x :> t, {1}, 1]
f0[100] (* returns 8 *)
The question, now, is what happens if the function is called with a value that cannot be found?
f0[1000]
error: First::first: {} has a length of zero and no first element.
The error message is cryptic, at best, offering no clues as to what the problem is. If this function was called deep in a call chain, then a cascade of similarly opaque errors is likely to occur.
There are various strategies to deal with such exceptional cases. One is to change the return value so that a success case can be distinguished from a failure case:
f1[x_] := Cases[data, {t_, p_} /; p >= x :> t, {1}, 1]
f1[100] (* returns {8} *)
f1[1000] (* returns {} *)
However, there is a strong Mathematica tradition to leave the original expression unmodified whenever a function is evaluated with arguments outside of its domain. This is where the Module[... /; ...] pattern can help out:
f2[x_] :=
Module[{m},
m = Cases[data, {t_, p_} /; p >= x :> t, {1}, 1];
First[m] /; m =!= {}
]
f2[100] (* returns 8 *)
f2[1000] (* returns f2[1000] *)
Note that the f2 bails out completely if the final result is the empty list and the original expression is returned unevaluated -- achieved by the simple expedient of adding a /; condition to the final expression.
One might decide to issue a meaningful warning if the "not found" case occurs:
f2[x_] := Null /; Message[f2::err, x]
f2::err = "Could not find a value for ``.";
With this change the same values will be returned, but a warning message will be issued in the "not found" case. The Null return value in the new definition can be anything -- it is not used.
One might further decide that the "not found" case just cannot occur at all except in the case of buggy client code. In that case, one should cause the computation to abort:
f2[x_] := (Message[f2::err, x]; Abort[])
In conclusion, these patterns are easy enough to apply so that one can deal with function arguments that are outside the defined domain. When defining functions, it pays to take a few moments to decide how to handle domain errors. It pays in reduced debugging time. After all, virtually all functions are partial functions in Mathematica. Consider: a function might be called with a string, an image, a song or roving swarms of nanobots (in Mathematica 9, maybe).
A final cautionary note... I should point out that when defining and redefining functions using multiple definitions, it is very easy to get unexpected results due to "left over" definitions. As a general principle, I highly recommend preceding multiply-defined functions with Clear:
Clear[f]
f[x_] := ...
f[x_] := Module[... /; ...]
f[x_] := ... /; ...

The problem here is essentially one of types. One function produces a bad output (incorrect type) which is then fed into many subsequent functions producing lots of errors. While Mathematica doesn't have user defined types like in other languages, you can do pattern matching on function arguments without too much work. If the match fails the function doesn't evaluate and thus doesn't beep with errors. The key piece of syntax is "/;" which goes at the end of some code and is followed by the test. Some example code (and output is below).
Input:
Average[x_] := Mean[x] /; VectorQ[x, NumericQ]
Average[{1, 2, 3}]
Average[$Failed]
Output:
2
Average[$Failed]
If the test is simpler, there is another symbol that does similar pattern testing "?" and goes right after an argument in a pattern/function declaration. Another example is below.
Input:
square[x_?NumericQ] := x*x
square[{1, 2, 3}]
square[3]
Output:
square[{1, 2, 3}]
9

It can help to define a catchall definition to pick up error conditions and report it in a meaningful way:
f[x_?NumericQ] := x^2;
f[args___] := Throw[{"Bad Arguments: ", Hold[f[args]]}]
So your top level calls can use Catch[], or you can just let it bubble up:
In[5]:= f[$Failed]
During evaluation of In[5]:= Throw::nocatch: Uncaught Throw[{Bad Args: ,Hold[f[$Failed]]}] returned to top level. >>
Out[5]= Hold[Throw[{"Bad Args: ", Hold[f[$Failed]]}]]

What I'd love to get is a way to define a general procedure to catch error propagation without the need to change radically the way I write functions right now, preferentially without adding substantial typing.
Here is a try:
funcDef = t_[args___] :c-: a_ :> ReleaseHold[Hold[t[args] :=
Check[a, Print#Hold[a]; Abort[]]]];
Clear#v;
v[x_, y_] :c-: Sin[x/y] /. funcDef;
?v
v[2, 3]
v[2, 0]
The :c-: is of course Esc c- Esc, an unused symbol (\[CircleMinus]), but anyone would do.
Output:
Global`v
v[x_,y_]:=Check[Sin[x/y],Print[Hold[Sin[x/y]]];Abort[]]
Out[683]= Sin[2/3]
During evaluation of In[679]:= Power::infy: Infinite expression 1/0 encountered. >>
During evaluation of In[679]:= Hold[Sin[2/0]]
Out[684]= $Aborted
What we changed is
v[x_, y_] := Sin[x/y]
by
v[x_, y_] :c-: Sin[x/y] /. funcDef;
This almost satisfies my premises.
Edit
Perhaps it's also convenient to add a "nude" definition for the function, that does not undergo the error checking. We may change the funcDef rule to:
funcDef =
t_[args___] \[CircleMinus] a_ :>
{t["nude", args] := a,
ReleaseHold[Hold[t[args] := Check[a, Print#Hold[a]; Abort[]]]]
};
to get for
v[x_, y_] :c-: Sin[x/y] /. funcDef;
this output
v[nude,x_,y_]:=Sin[x/y]
v[x_,y_]:=Check[Sin[x/y],Print[Hold[Sin[x/y]]];Abort[]]

Related

Why is Cases[] so slow here? Are there any tricks to speed it up?

While trying to paste images, I noticed that Cases[] is very slow.
To reproduce, first copy a large image to the clipboard (just press Print Screen), then evaluate the following:
In[33]:= SetSystemOptions["PackedArrayOptions" -> "UnpackMessage" -> True];
In[34]:= AbsoluteTiming[nb = NotebookGet#ClipboardNotebook[];]
Out[34]= {0.4687500, Null}
In[35]:= AbsoluteTiming[d1 = nb[[1, 1, 1, 1, 1, 1, 1]];]
Out[35]= {0., Null}
In[36]:= AbsoluteTiming[d2 = First#Cases[nb, r_RasterBox :> First[r], Infinity, 1];]
During evaluation of In[36]:= Developer`FromPackedArray::unpack: Unpacking array in call to Notebook. >>
Out[36]= {0.9375000, Null}
(I did this on Windows, not sure if the paste code is the same on other systems.)
Note that extracting the data using Cases is extremely slow compared to using Part directly, even though I explicitly tell Cases that I need only one match.
I did find out (as shown above) that Cases triggers unpacking for some reason, even though the search should stop before it reaches the packed array inside. Using a shallower level specification than Infinity might avoid unpacking.
Question: Using Cases here is both easier and more reliable than Part (what if the subexpression can appear in different positions?) Is there a way to make Cases fast here, perhaps by using a different pattern or different options?
Possibly related question: Mathematica's pattern matching poorly optimized?
(This is why I changed the Cases rule from RasterBox[data_, ___] -> data to r_RasterBox :> First[r].)
I don't have access to Mathematica right now, so what follows is untested. My guess is that Cases unpacks here because it searches depth-first, and so sees the packed array first. If this is correct, then you could use rules instead (ReplaceAll, not Replace), and throw an exception upon first match:
Module[{tag},
Catch[
nb /. r_RasterBox :> Block[{}, Throw[First[r], tag] /; True];
$Failed,
tag]
]
As I said, this is just an untested guess.
Edit 2: an approach based on shielding parts of expression from the pattern-matcher
Preamble
In the first edit (below) a rather heavy approach is presented. In many cases, one can take an alternative route. In this particular problem (and many others like it), the main problem is to somehow shield certain sub-expressions from the pattern-matcher. This can be achieved also by using rules, to temporarily replace the parts of interest by some dummy symbols.
Code
Here is a modification of Cases which does just that:
Clear[casesShielded];
casesShielded[expr_,pt_,shieldPattern_,levspec_,n_,opts:OptionsPattern[]]:=
Module[{dummy,inverseShieldingRules, shielded, i=0},
inverseShieldingRules =
If[#==={},#,Dispatch#First##]&#
Reap[shielded= expr/.(p:shieldPattern):>
With[{eval = With[{ind = ++i},Sow[dummy[ind]:>p];dummy[ind]]},
eval/;True];
][[2]];
Cases[shielded,pt,levspec,n,opts]/.inverseShieldingRules];
This version of Cases has one additional parameter shieldPattern (third one), which indicates which sub-expressions must be shielded from the pattern-matcher.
Advantages and applicability
The code above is pretty light-weight (compared to the suggestion of edit1 below), and it allows one to fully reuse and leverage the existing Cases functionality. This will work for cases when the main pattern (or rule) is insensitive to shielding of the relevant parts, which is a rather common situation (and in particular, covers patterns of the type _h, including the case at hand). This may also be faster than the application of myCases (described below).
The case at hand
Here, we need this call:
In[55]:=
(d4=First#casesShielded[nb,x_RasterBox:>First#x,
p_List/;Developer`PackedArrayQ[p],Infinity,1]);//Timing
Out[55]= {0.,Null}
and the result is of course the same as before:
In[61]:= d2===d4
Out[61]= True
Edit: an alternative Cases-like function
Motivation and code
It took me a while to produce this function, and I am not 100 percent sure it always works correctly, but here is a version of Cases which, while still working depth-first, analyzes expression as a whole before sub-expressions:
ClearAll[myCases];
myCases[expr_, lhs_ :> rhs_, upToLevel_: 1, max : (_Integer | All) : All,
opts : OptionsPattern[]] :=
Module[{tag, result, f, found = 0, aux},
With[{
mopts = FilterRules[{opts}, {Heads -> False}],
frule =
Apply[
RuleDelayed,
Hold[lhs, With[{eval = aux}, Null /; True]] /.
{aux :> Sow[rhs, tag] /; max === All,
aux :> (found++; Sow[rhs, tag])}
]
},
SetAttributes[f, HoldAllComplete];
If[max =!= All,
_f /; found >= max := Throw[Null, tag]
];
f[x_, n_] /; n > upToLevel := Null;
f[x_, n_] :=
Replace[
HoldComplete[x],
{
frule,
ex : _[___] :>
With[{ev =
Replace[
HoldComplete[ex],
y_ :> With[{eval = f[y, n + 1]}, Null /; True],
{2},
Sequence ## mopts
]},
Null /; True
]
},
{1}
]
]; (* external With *)
result =
If[# === {}, #, First##] &#
Reap[Catch[f[expr, 0], tag], tag, #2 &][[2]];
(* For proper garbage-collection of f *)
ClearAll[f];
result
]
How it works
This is not the most trivial piece of code, so here are some remarks. This version of Cases is based on the same idea I suggested first - namely, use rule-substitution semantics to first attempt the pattern-match on an entire expression and only if that fails, go to sub-expressions. I stress that this is still the depth-first traversal, but different from the standard one (which is used in most expression-traversing functions like Map, Scan, Cases, etc). I use Reap and Sow to collect the intermediate results (matches). The trickiest part here is to prevent sub-expressions from evaluation, and I had to wrap sub-expressions into HoldComplete. Consequently, I had to use (a nested version of the) Trott-Strzebonski technique (perhaps, there are simpler ways, but I wasn't able to see them), to enable evauation of rules' r.h.sides inside held (sub)expressions, and used Replace with proper level spec, accounting for extra added HoldComplete wrappers. I return Null in rules, since the main action is to Sow the parts, so it does not matter what is injected into the original expression at the end. Some extra complexity was added by the code to support the level specification (I only support the single integer level indicating the maximal level up to which to search, not the full range of possible lev.specs), the maximal number of found results, and the Heads option. The code for frule serves to not introduce the overhead of counting found elements in cases when we want to find all of them. I am using the same Module-generated tag both as a tag for Sow, and as a tag for exceptions (which I use to stop the process when enough matches have been found, just like in my original suggestion).
Tests and benchmarks
To have a non-trivial test of this functionality, we can for example find all symbols in the DownValues of myCases, and compare to Cases:
In[185]:=
And##Flatten[
Outer[
myCases[DownValues[myCases],s_Symbol:>Hold[s],#1,Heads->#2] ===
Cases[DownValues[myCases],s_Symbol:>Hold[s],#1,Heads->#2]&,
Range[0,20],
{True,False}
]]
Out[185]= True
The myCases function is about 20-30 times slower than Cases though:
In[186]:=
Do[myCases[DownValues[myCases],s_Symbol:>Hold[s],20,Heads->True],{500}];//Timing
Out[186]= {3.188,Null}
In[187]:= Do[Cases[DownValues[myCases],s_Symbol:>Hold[s],20,Heads->True],{500}];//Timing
Out[187]= {0.125,Null}
The case at hand
It is easy to check that myCases solves the original problem of unpacking:
In[188]:= AbsoluteTiming[d3=First#myCases[nb,r_RasterBox:>First[r],Infinity,1];]
Out[188]= {0.0009766,Null}
In[189]:= d3===d2
Out[189]= True
It is hoped that myCases can be generally useful for situations like this, although the performance penalty of using it in place of Cases is substantial and has to be taken into account.

Hold any argument

Is it possible to define a function that holds arguments at given positions ?
Or to do something like HoldLast as a counterpart to HoldFirst ?
As far as I know, you can not do this directly in the sense that there isn't a HoldN attribute.
However, below there is a work-around that should be doing what you requested.
Proposed solution
One simple way is to define an auxiliary function that will do the main work, and your "main" function (the one that will actually be called) as HoldAll, like so:
In[437]:=
SetAttributes[f, HoldAll];
f[a_, b_, c_] :=
faux[a, Unevaluated[b], c];
faux[a_, b_, c_] := Hold[a, b, c]
In[440]:= f[1^2, 2^2, 3^2]
Out[440]= Hold[1, 2^2, 9]
You don't have to expose the faux to the top level, can wrap everyting in Module[{faux}, your definitions] instead.
Automation through meta-programming
This procedure can be automated. Here is a simplistic parser for the function signatures, to extract pattern names (note - it is indeed simplistic):
splitHeldSequence[Hold[seq___], f_: Hold] := List ## Map[f, Hold[seq]];
getFunArguments[Verbatim[HoldPattern][Verbatim[Condition][f_[args___], test_]]] :=
getFunArguments[HoldPattern[f[args]]];
getFunArguments[Verbatim[HoldPattern][f_[args___]]] :=
FunArguments[FName[f], FArgs ## splitHeldSequence[Hold[args]]];
(*This is a simplistic "parser".It may miss some less trivial cases*)
getArgumentNames[args__FArgs] :=
args //. {
Verbatim[Pattern][tag_, ___] :> tag,
Verbatim[Condition][z_, _] :> z,
Verbatim[PatternTest][z_, _] :> z
};
Using this, we can write the following custom definition operator:
ClearAll[defHoldN];
SetAttributes[defHoldN, HoldFirst];
defHoldN[SetDelayed[f_[args___], rhs_], n_Integer] :=
Module[{faux},
SetAttributes[f, HoldAll];
With[{heldArgs =
MapAt[
Unevaluated,
Join ## getArgumentNames[getFunArguments[HoldPattern[f[args]]][[2]]],
n]
},
SetDelayed ## Hold[f[args], faux ## heldArgs];
faux[args] := rhs]]
This will analyze your original definition, extract pattern names, wrap the argument of interest in Unevaluated, introduce local faux, and make a 2-step definition - basically the steps we did manually. We need SetDelayed ## .. to fool the variable renaming mechanism of With, so that it won't rename our pattern variables on the l.h.s. Example:
In[462]:=
ClearAll[ff];
defHoldN[ff[x_,y_,z_]:=Hold[x,y,z],2]
In[464]:= ?ff
Global`ff
Attributes[ff]={HoldAll}
ff[x_,y_,z_]:=faux$19106##Hold[x,Unevaluated[y],z]
In[465]:= ff[1^2,2^2,3^2]
Out[465]= Hold[1,2^2,9]
Notes
Note that this is trivial to generalize to a list of positions in which you need to hold the arguments. In general, you'd need a better pattern parser, but the simple one above may be a good start. Note also that there will be a bit of run-time overhead induced with this construction, and also that the Module-generated auxiliary functions faux won't be garbage-collected when you Clear or Remove the main ones - you may need to introduce a special destructor for your functions generated with defHoldN. For an alternative take on this problem, see my post in this thread (the one where I introduced the makeHoldN function).
Another way to do would be for example:
SetAttributes[f,HoldFirst];
f[{heldArg1_,heldArg2_},arg3_,arg4_,arg5_]:= Hold[arg3 heldArg1];
And this would allow to be able to have any mix of held and non held arguments.
HoldRest could be used similarly.

Possible to block OwnValues when DownValues already exist?

For cases where one has already assigned DownValues associated with the name 'a', is there an accepted way to block the assignment of OwnValues to the same name? (I originally came across this issue while playing with someone's attempt at implementing a data dictionary.)
Here's what I mean to avoid:
Remove[a];
a[1] := somethingDelayed
a[2] = somethingImmediate;
DownValues[a]
a[1]
a[2]
Returns...
{HoldPattern[a[1]] :> somethingDelayed,
HoldPattern[a[2]] :> somethingImmediate}
somethingDelayed
somethingImmediate
And now if we were to evaluate:
a = somethingThatScrewsUpHeads;
(* OwnValues[a] above stored in OwnValues *)
a[1]
a[2]
We get...
somethingThatScrewsUpHeads[1]
somethingThatScrewsUpHeads[2]
Is there an easy/flexible way to prevent OwnValues for any Name in DownValues? (Lemme guess... it's possible, but there's going to be a performance hit?)
I don't know if this is an "accepted" way, but you could define a rule that prevents Set and SetDelayed from acting upon a:
Remove[a];
a[1] := somethingDelayed
a[2] = somethingImmediate;
a /: HoldPattern[(Set|SetDelayed)[a, _]] := (Message[a::readOnly]; Abort[])
a::readOnly = "The symbol 'a' cannot be assigned a value.";
With this rule in place, any attempt to assign an OwnValue to a will fail:
In[17]:= a = somethingThatScrewsUpHeads;
During evaluation of In[17]:= a::readOnly:
The symbol 'a' cannot be assigned a value.
Out[17]= $Aborted
In[18]:= a := somethingThatScrewsUpHeads;
During evaluation of In[18]:= a::readOnly:
The symbol 'a' cannot be assigned a value.
Out[18]= $Aborted
However, this rule will still allow new DownValues for a:
In[19]:= a[3] = now;
a[4] := later
In[20]:= a[3]
Out[20]= now
In[21]:= a[4]
Out[21]= later
Performance
The rule does not seem to have an appreciable impact on the performance of Set and SetDelayed, presumably since the rule is installed as an up-value on a. I tried to verify this by executing...
Timing#Do[x = i, {i, 100000000}]
... both before and after the installation of the rule. There was no observable change in the timing. I then tried installing Set-related up-values on 10,000 generated symbols, thus:
Do[
With[{s=Unique["s"]}
, s /: HoldPattern[(Set|SetDelayed)[s, _]] :=
(Message[s::readOnly]; Abort[])
]
, {10000}]
Again, the timing did not change even with so many up-value rules in place. These results suggest that this technique is acceptable from a performance standpoint, although I would strongly advise performing performance tests within the context of your specific application.
I am not aware of any way to directly "block" OwnValues, and since Mathematica's evaluator evaluates heads before anything else (parts, application of DownValues, UpValues and SubValues, etc), this does not bring us anywhere (I discussed this problem briefly in my book).
The problem with a straightforward approach is that it will likely be based on adding DownValues to Set and SetDelayed, since it looks like they can not be overloaded via UpValues.
EDIT
As pointed by #WReach in the comments, for the case at hand UpValues can be successfully used, since we are dealing with Symbols which must be literally present in Set/SetDelayed, and therefore the tag depth 1 is sufficient. My comment is more relevant to redefining Set on some heads, and when expressions with those heads must be allowed to be stored in a variable (cases like Part assignments or custom data types distinguished by heads)
END EDIT
However, adding DownValues for Set and SetDelayed is a recipe for disaster in most cases ( this thread is very illustrative), and should be used very rarely (if at all) and with extreme care.
From the less extreme approaches, perhaps the simplest and safest, but not automatic way is to Protect the symbols after you define them. This method has a problem that you won't be able to add new or modify existing definitions, without Unprotect-ing the symbol.
Alternatively, and to automate things, you can use a number of tricks. One is to define custom assignment operators, such as
ClearAll[def];
SetAttributes[def, HoldAll];
def[(op : (Set | SetDelayed))[lhs_, rhs_]] /;
Head[Unevaluated[lhs]] =!= Symbol || DownValues[lhs] === {} :=
op[lhs, rhs]
and consistently wrap SetDelayed- and Set-based assignments in def (I chose this syntax for def - kept Set / SetDelayed inside def - to keep the syntax highlighting), and the same for Set. Here is how your example would look like:
In[26]:=
Clear[a];
def[a[1]:=somethingDelayed];
def[a[2]=somethingImmediate];
def[a=somethingThatScrewsUpHeads];
In[30]:= {a[1],a[2]}
Out[30]= {somethingDelayed,somethingImmediate}
You can then go further and write a code - processing macro, that will wrap SetDelayed- and Set-based assignments in def everywhere in your code:
SetAttributes[useDef, HoldAll];
useDef[code_] := ReleaseHold[Hold[code] /. {x : (_Set | _SetDelayed) :> def[x]}]
So, you can just wrap your piece of code in useDef, and then don't have to change that piece of code at all. For example:
In[31]:=
useDef[
Clear[a];
a[1]:=somethingDelayed;
a[2]=somethingImmediate;
a=somethingThatScrewsUpHeads;
]
In[32]:= {a[1],a[2]}
Out[32]= {somethingDelayed,somethingImmediate}
In the interactive session, you can go one step further still and set $Pre = useDef, then you won't forget to wrap your code in useDef.
EDIT
It is trivial to add diagnostic capabilities to def, by using the pattern - matcher. Here is a version that will issue a warning message in case when an assignment to a symbol with DownValues is attempted:
ClearAll[def];
SetAttributes[def, HoldAll];
def::ownval =
"An assignment to a symbol `1` with existing DownValues has been attempted";
def[(op : (Set | SetDelayed))[lhs_, rhs_]] /;
Head[Unevaluated[lhs]] =!= Symbol || DownValues[lhs] === {} := op[lhs, rhs]
def[(Set | SetDelayed)[sym_, _]] :=
Message[def::ownval, Style[HoldForm[sym], Red]];
Again, by using useDef[] (possibly with $Pre), this can be an effective debugging tool, since no changes in the original code are at all needed.

Mathematica: How is OptionValue implemented?

The implementation of the built-in OptionValue contains some piece of magic so that
OptionValue[name] is equivalent to
OptionValue[f, name], where f is the
head of the left-hand side of the
transformation rule in which
OptionValue[name] appears.
Does anybody have an idea for how to achieve something similar for Options, i.e. implement an autoOptions[] that would resolve to the options defined for the symbol on the left hand side of the transformation rule in which autoOptions[] appears?
For clarity, what I am looking for is a way to make
Options[foo]={bar->1};
foo[OptionsPattern[]]:=autoOptions[]
foo[]
output {bar->1}
The eventual goal is to do something like requested in this question without having to change anything but the RHS of a definition.
Here is a simple, very schematic version:
Module[{tried},
Unprotect[SetDelayed];
SetDelayed[f_[args___, optpt : OptionsPattern[]], rhs_] /;
!FreeQ[Unevaluated[rhs], autoOptions[]] :=
Block[{tried = True},
f[args, optpt] :=
Block[{autoOptions}, autoOptions[] = Options[f]; rhs]] /; ! TrueQ[tried];
Protect[SetDelayed];]
Your usage:
In[8]:= Options[foo] = {bar -> 1};
foo[OptionsPattern[]] := autoOptions[]
foo[]
Out[10]= {bar -> 1}
Note that this won't work when explicit options are also passed - accounting for them is some more work, and this is not generally a good practice since I overloaded SetDelayed - but you asked for it and you get it.

Checking if a symbol is defined

Is there an easy way to check if there's a definition for x? I need a function that takes
something of the form f,f[_] or f[_][_] and returns True if there's a definition for it
To be really concrete, I'm storing things using constructs like f[x]=b, and g[x][y]=z and I need to check if f[x] has definition for every x in some list and if g[x][y] has a definition for every x,y in some set of values
Actually, the ValueQ function is not innocent, since it leaks evaluation for code with side effects. Examples:
ClearAll[f, g];
f[x_] := Print[x];
g[x_][0] := Print[x];
{ValueQ[f[1]],ValueQ[g[2][0]]}
If you remove the ReadProtected Attribute of ValueQ and look at the code, you will see why - the code is very simplistic and does a decent job for OwnValues only. Here is a more complex version which I developed to avoid this problem (you can test that, at least for the examples above, it does not leak evaluation):
ClearAll[symbolicHead];
SetAttributes[symbolicHead, HoldAllComplete];
symbolicHead[f_Symbol[___]] := f;
symbolicHead[f_[___]] := symbolicHead[f];
symbolicHead[f_] := Head[Unevaluated[f]];
ClearAll[partialEval];
SetAttributes[partialEval, HoldAllComplete];
partialEval[a_Symbol] /; OwnValues[a] =!= {} :=
Unevaluated[partialEval[a]] /. OwnValues[a];
partialEval[a : f_Symbol[___]] /; DownValues[f] =!= {} :=
With[{dv = DownValues[f]},
With[{eval = Hold[partialEval[a]] /. dv},
ReleaseHold[eval] /;
(First[Extract[eval, {{1, 1}}, HoldComplete]] =!=
HoldComplete[a])]];
partialEval[a_] :=
With[{sub = SubValues[Evaluate[symbolicHead[a]]]},
With[{eval = Hold[partialEval[a]] /. sub},
ReleaseHold[eval] /;
(First[Extract[eval, {{1, 1}}, HoldComplete]] =!=
HoldComplete[a])]];
ClearAll[valueQ];
SetAttributes[valueQ, HoldAllComplete];
valueQ[expr_] := partialEval[expr] =!= Unevaluated[partialEval[expr]];
This is not complete either, since it does not account for UpValues, NValues, and FormatValues, but this seems to be enough for your stated needs, and also, rules for these three extra cases can perhaps also be added along the same lines as above.
If I understood correctly I think the function ValueQ is what you are looking for. It will return true if a variable or a function has been defined and false if it has not been defined.
Read more at http://reference.wolfram.com/mathematica/ref/ValueQ.html
For symbols in System`, check SyntaxInformation for a ArgumentsPattern option.
For other symbols, check DownValues, UpValues, SubValues, etc...
What's the intended use?
Here's a nice, simple solution which works if the object in question has enough internal structure.
You can use
Length[variable]
to detect whether variable has been assigned to something with more than one part. Thus:
Remove[variable]
Length[variable]
(*---> 0*)
variable={1,2,3};
Length[variable]
(*---> 3*)
You can then use Length[variable]>0 to get True in the latter case.
This fails, though, if there's a chance that variable be assigned to an atomic value, such as a single string or number:
variable=1
Length[variable]
(*---> 0*)

Resources