Is it possible to create MakeBoxesStop wrapper? - wolfram-mathematica

It is known that output expressions are passed through MakeBoxes to turn the graphics expressions into the box language which the front end uses to represent graphics (when $Output has default option FormatType->StandardForm). For example, if we evaluate:
HoldComplete[Graphics[Disk[]]]
we get a disk wrapped by HoldComplete:
This is because HoldComplete does not stop MakeBoxes from converting its contents to typeset expression:
In[4]:= MakeBoxes#HoldComplete[Graphics[Disk[]]]
Out[4]= RowBox[{"HoldComplete", "[", GraphicsBox[DiskBox[{0, 0}]], "]"}]
So my question is: is it possible to make some additional definitions to MakeBoxes such that wrapping any expression with head MakeBoxesStop will prevent MakeBoxes from converting this expression to typeset form? In this case the expression should look in output as any other expression with no rules associated with symbols in it; in the above case:
P.S. Please do not suggest to use InputForm since I am not satisfied with its default behavior.

This function seems to do it:
Clear[MakeBoxesStop];
MakeBoxesStop /: MakeBoxes[MakeBoxesStop[expr_], form_] :=
Module[{heldHeads =
Join ## Cases[expr,s_Symbol[___] :> HoldComplete[s], {0, Infinity},
Heads -> True],
modified, direct, tempContext = ToString[Unique[]] <> "`"},
Block[{$ContextPath = $ContextPath, $Packages = $Packages},
BeginPackage[tempContext];
modified =
Join ## Map[
Function[head,
ToExpression[ToLowerCase[ToString[Unevaluated[head]]],InputForm, HoldComplete],
HoldAllComplete],
heldHeads];
EndPackage[];
With[{newexpr =
expr /. (List ## Thread[HoldPattern /# heldHeads -> modified, HoldComplete])},
With[{result =
MakeBoxes[newexpr, form] /.
Thread[Rule ##
Map[List ##
Map[Function[head, ToString[Unevaluated[head]], HoldAllComplete], #] &,
{modified , heldHeads}]]
},
Remove ## Names[tempContext <> "*"];
result]]]];
It won't win the elegance contests, and may be not very clean, but it seems to do what you requested:
In[270]:= MakeBoxesStop[Graphics[Disk[]]]
Out[270]= Graphics[Disk[List[0, 0]]]
If you don't want expression inside MakeBoxesStop to evaluate, add the appropriate attributes and Unevaluated wrappers in the body.
EDIT
The following simple box-making function is based on the Mathematica parser posted here:
Clear[toBoxes];
toBoxes[expr_] :=
First[parse[tokenize[ToString#FullForm[expr]]] //. {
head_String[elem_] :> RowBox[{head, "[", elem, "]"}],
head_String[elems___] :> RowBox[{head, "[", RowBox[Riffle[{elems}, ","]], "]"}]}]
Then, we need:
Clear[MakeBoxesStopAlt];
MakeBoxesStopAlt /: MakeBoxes[MakeBoxesStopAlt[expr_], form_] := toBoxes[expr]
For example:
In[327]:= MakeBoxesStopAlt[Graphics[Disk[]]]
Out[327]= Graphics[Disk[List[0, 0]]]

Starting from Mathematica 11.0, we have DisableFormatting wrapper which prevents formatting inside of held expressions:
Hold[DisableFormatting#Graphics[Disk[]]]
Strongly related answer by Carl Woll:
Prevent graphics from rendering inside a held expression

Related

When to use Hold / ReleaseHold in Mathematica?

Example and background ( note the usage of Hold, ReleaseHold ):
The following code represents a static factory method to create a scenegraph object ( from an XML file ). The (output-)field is an instance of CScenegraph ( an OO-System class ).
new[imp_]:= Module[{
ret,
type = "TG",
record ={{0,0,0},"Root TG"}
},
ret = MathNew[
"CScenegraph",
2,
MathNew["CTransformationgroup",1,{type,record},0,0,0,0,Null]];
ret#setTree[ret];
ret#getRoot[]#setColref[ret];
csp = loadClass["CSphere"];
spheres = Cases[imp, XMLElement["sphere", _, __], Infinity];
codesp = Cases[spheres, XMLElement["sphere",
{"point" -> point_, "radius" -> rad_, "hue" -> hue_}, {}] -> Hold[csp#new[ToExpression[point], ToExpression[rad], ToExpression[hue]]]];
ret#addAschild[ret#getRoot[],ReleaseHold[codesp]];
ret
];
My question is about the following:
spheres = Cases[imp, XMLElement[\sphere\, _, __], Infinity];
codesp = Cases[spheres, XMLElement[\sphere\,
{\point\ -> point_, \radius\ -> rad_, \"hue\" -> hue_}, {}] -> Hold[csp#new[ToExpression[point], ToExpression[rad], ToExpression[hue]]]];
ret#addAschild[ret#getRoot[],ReleaseHold[codesp]];
where
addAschild
adds ( a list of ) geometries to a ( root ) transformationgroup and has the signature
addAsChild[parent MathObject, child MathObject], or
addAsChild[parent MathObject, Children List{MathObject, ...}]
and the XML element representing a sphere looks as follows:
<sphere point='{0., 1., 3.}'
radius='1'
hue='0.55' />
If I do NOT USE Hold[] , ReleaseHold[] I end up with objectdata like
{"GE", {"SP", {CScenegraph`point, CScenegraph`rad}}, {CScenegraph`hue}}
while I would have expected
{"GE", {"SP", {{4., 3., -4.}, 3.}}, {0.45}}
(The above code with Hold[], ReleaseHold[] yields the correct data.)
Questions
1. Why is Hold necessary in this case? ( In fact, is it? Is there a way to code this without Hold[], ReleaseHold[]? ) ( I got it right by trial and error! Don't really understand why. )
2. As a learning point: What is the prototypical example / case for the usage of Hold / ReleaseHold?
EDIT:
Summary of Leonid's answer. Change this code
codesp = Cases[spheres, XMLElement["sphere",
{"point" -> point_, "radius" -> rad_, "hue" -> hue_}, {}] -> Hold[csp#new[ToExpression[point], ToExpression[rad], ToExpression[hue]]]];
ret#addAschild[ret#getRoot[],ReleaseHold[codesp]];
to:
codesp = Cases[spheres, XMLElement["sphere",
{"point" -> point_, "radius" -> rad_, "hue" -> hue_}, {}] :> csp#new[ToExpression[point], ToExpression[rad], ToExpression[hue]]];
ret#addAschild[ret#getRoot[],codesp];
The short answer for the first question is that you probably should have used RuleDelayed rather than Rule, and then you don't need Hold-ReleaseHold.
It is hard to be sure what is going on since your code sample is not self-contained. One thing to be sure is that OO-System performs non-trivial manipulations with contexts, since it uses contexts as an encapsulation mechanism (which makes sense). Normally, Rule and RuleDelayed inject the matched expressions in the r.h.s., so it is not clear how this could happen. Here is one possible scenario (you may execute this in a notebook):
BeginPackage["Test`"]
f[{a_Symbol, b_Symbol}] := {c, d};
fn[input_] := Cases[input, XMLElement[{"a" -> a_, "b" -> b_}, {}, {}] -> f[{a, b}]];
fn1[input_] := Cases[input, XMLElement[{"a" -> a_, "b" -> b_}, {}, {}] :> f[{a, b}]];
EndPackage[];
$ContextPath = DeleteCases[$ContextPath, "Test`"]
Now,
In[71]:= Test`fn[{XMLElement[{"a"->1,"b"->2},{},{}],{"a"->3,"b"->4},{"a"->5,"b"->6}}]
Out[71]= {{Test`c,Test`d}}
What happened is that, since we used Rule in XMLElement[...]->rhs, the r.h.s. evaluates before the substitution takes place - in this case the function f evaluates. Now,
In[78]:= Test`fn1[{XMLElement[{"a" -> 1, "b" -> 2}, {}, {}],
{"a" ->3, "b" -> 4}, {"a" -> 5, "b" -> 6}}]
Out[78]= {Test`f[{1, 2}]}
The result is different here since the idiom XMLElement[...] :> rhs was used in implementation of fn1, involving RuleDelayed this time. Therefore, f[{a,b}] was not evaluated until a and b were substituted by the matching numbers from the l.h.s. And since f does not have a rule for the argument of the form of list of 2 numbers, it is returned.
The reason why your method with Hold-ReleaseHold worked is that this prevented the r.h.s. (function f in my example, and the call to new in your original one) from evaluation until the values for pattern variables have been substituted into it. As a side note, you may find it useful to add better error-checking to your constructor (if OO-System allows that), so that problems like this would be better diagnosed at run-time.
So, the bottom line: use RuleDelayed, not Rule.
To answer the second question, the combination ReleaseHold-Hold is generally useful when you want to manipulate the held code before you allow it to evaluate. For example:
In[82]:=
{a,b,c}={1,2,3};
ReleaseHold[Replace[Hold[{a,b,c}],s_Symbol:>Print[s^2],{2}]]
During evaluation of In[82]:= 1
During evaluation of In[82]:= 4
During evaluation of In[82]:= 9
Out[83]= {Null,Null,Null}
One can probably come up with more sensible examples. This is especially useful for things like code-generation - one less trivial example can be found here. The specific case at hand, as I already mentioned, does not really fall into the category of cases where Hold-ReleaseHold are beneficial - they are here just a workaround, which is not really necessary when you use delayed rules.

How can I hide $Aborted message?

I know that I'm aborting the evaluation and can see it when the black bar on the side goes away. So there is no need for this message. How do I turn it off?
The following is a generalization of the $Pre-based method suggested by Simon and the $Post-based method suggested by Mr.Wizard.
In both cases one should set HoldAllComplete attribute to the pure functions and wrap x (input expression) inside them by Unevaluated so they work correctly with inputs having Heads Sequence, Unevaluated and Evaluate.
Compare two versions of the $Pre-based solution:
f1 = Function[{x}, CheckAbort[x, Null], {HoldAll}]
f2 = Function[{x}, CheckAbort[Unevaluated#x, Null], {HoldAllComplete}]
In[3]:= f1#Sequence[1,2]
f1#Abort[]
f1#Evaluate[Abort[]]
f1#Unevaluated[1+1]
Out[3]= 1
Out[5]= $Aborted
Out[6]= 2
In[7]:= f2#Sequence[1,2]
f2#Evaluate[Abort[]]
f2#Unevaluated[1+1]
Out[7]= Sequence[1,2]
Out[9]= Unevaluated[1+1]
One can see that the first version can easily be broken with Evaluate[Abort[]] and works incorrectly with input expressions having Heads Sequence and Unevaluated. It is generally true for any one-argument function without HoldAllComplete attribute. Since $Pre, $Post and friends all are one-argument functions one must always set HoldAllComplete attribute to them.
I also see no problems with using Null as the second argument of CheckAbort (there is no need for Return#Null). On my machine (Mathematica 7.0.1 under Windows 2000) $Abort is never returned in the case of the f2.
The same is true for the $Post-based solution. It can be generalized as follows:
$Post = Function[x, If[Unevaluated#x =!= $Aborted, Unevaluated#x],
HoldAllComplete]
Test expressions:
In[14]:= Unevaluated[1+2]
Sequence[1,2]
$Aborted
Abort[]
Out[14]= Unevaluated[1+2]
Out[15]= Sequence[1,2]
If you are not using $Post for something else, or if you can combine functions, you could use:
$Post = # /. $Aborted -> Null &;
Be warned that you may break things, as programs may use $Aborted in their control flow.
More robustly, addressing the problem Alexey demonstrates:
$Post = Function[Null, Unevaluated## /. $Aborted -> Null, HoldAllComplete];
The following seems to work:
SetAttributes[katch, HoldAll];
katch[x_] := CheckAbort[x, Return#Null]
$Pre = katch;
After testing, remember to return $Pre to its previous value:
$Pre =.
Probably interferes with some internal abort catching, though.
Edit
Simon's version:
$Pre = Function[{x}, CheckAbort[x,Return#Null], {HoldAll}]

How to Convert an Alphanumeric (Reference) Number Containing a Decimal Point to a String in Mathematica

I have a reference number of the following type DAA76647.1 which I want to convert unchanged to a string in Mathematica.
That is
myfn[DAA76647.1]
gives as output
"DAA76647.1"
Is there an easy way to do this? (The input cannot be a string and, other than conversion to a string, I do not want to change the input in any other way).
Update
ToString /# {A1234, 1234.1, A1234 .5}
gives the following output (where I have simply entered everything from the keyboard)
{"A1234", "1234.1", "0.5 A1234"}
It appears that if what goes before the decimal point is alphanumeric, there is a problem.
Possible Workaround
Based on a suggested solution by David Carraher, a possible method is as follows:
ToString[# /.a_ b_ :> ToString[b] <> StringDrop[ToString[a], 1]] & /# {A1234,
1234.1, A1234 .5}
giving as output:
{"A1234", "1234.1", "A1234.5"}
This seems to work OK provided that what comes after the decimal point is not alphanumeric, and provided that what comes before does not begin with zero (0A123.1, for example).
If alphanumerics occur only after the decimal point, this may be incorporated
StringReplace[ToString[123.45 B55c], Whitespace -> ""]
but if alphanumerics occur before and after the decimal point the number still needs to be entered as a string.
David Carraher's original suggestion
f[Times[a_, b_]] := ToString[b] <> ToString[a]
The call for myfn[DAA76647.1] should be intercepted at the stage of converting Input to an expression.
You can see that Input has the form RowBox[{"myfn", "[", RowBox[{"DAA76647", ".1"}], "]"}]:
In[1]:= myfn[DAA76647 .1]
DownValues[InString]
Out[1]= myfn[0.1 DAA76647]
Out[2]= {HoldPattern[InString[1]] :>
ToString[RowBox[{"myfn", "[", RowBox[{"DAA76647", ".1"}], "]"}],
InputForm],
HoldPattern[InString[2]] :>
ToString[RowBox[{"DownValues", "[", "InString", "]"}], InputForm]}
We could create a special case definition for MakeExpression:
MakeExpression[RowBox[{"myfn", "[", RowBox[{"DAA76647", ".1"}], "]"}],
f_] := MakeExpression[RowBox[{"myfn", "[", "\"DAA76647.1\"", "]"}],
f]
You can see that now myfn[DAA76647 .1] works as desired:
In[4]:= myfn[DAA76647 .1]//FullForm
Out[4]//FullForm= myfn["DAA76647.1"]
This approach can be generalized to something like
MakeExpression[RowBox[{"myfn", "[", expr:Except[_String], "]"}], form_] :=
With[{mexpr = StringJoin[expr /. RowBox -> List]}, Hold[myfn[mexpr]]]
myfn[expr_String] := (* what ever you want to do here *)
Note that the Except[_String] part is not really needed... since the following code won't do anything wrong with a String.
At the moment, the code only works with simple examples with one-dimensional box structure. If you want something that handles more general input, you might want to add error checking or extra rules for things like SuperscriptBox and friends. Or hit it with the hammer of Evaluate[Alternatives ## Symbol /# Names["*Box"]] -> List to make all Box objects become lists and flatten everything down.
If you enter DAA76647DAA76647.1 via an input cell in a Mma notebook, Mma will interpret the characters as a multiplication. It even automatically inserts a space between the 7 and the .1 (at least in Mma 8) when you input it.
DAA76647DAA76647 .1 // FullForm
(*Out= Times[0.1`,DAA76647DAA76647] *)
This looks promising:
f[Times[a_, b_]] := ToString[b] <> ToString[a]
EDIT:
However, as TomD noted (and I somehow missed), it adds an additional zero to the solution!
f[Times[DAA76647DAA76647 .1]]
(*Out= DAA76647DAA766470.1 *)
%//FullForm
"DAA76647DAA766470.1"
TomD later showed how it is possible to handle this by StringDropping the zero.
This corrected solution will work if only numbers appear to the right of the decimal point and if the left-hand part is not interpreted as a product.
If you try to enter DAA76647.01A Mma will parse it as
(*Out= Times[".01",A,DAA76647] *)
Notice that it changes the order of the components.
I cannot see a way to handle this reordering.
I don't think you can directly type this between the brackets of a function call, but would
myfn[InputString[]]
work for you?

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*)

Define Custom Notation in Mathematica

I often need to extract to restrict value lists to sublists, ie if vals gives values of vars={x1,x2,x3,x4}, and I need values of svars={x2,x4} I do restrict[list,vars,svars] where
restrict[vars_, svars_, vals_] :=
Extract[vals, Flatten[Position[vars, #] & /# svars, 1]]
I'd like to improve code readability, perhaps by defining following custom notation for restrict[vars,svars,vals]
(source: yaroslavvb.com)
My questions are
What is a good way to implement this?
Is this a good idea altogether?
Good notations can be very useful - but I'm not sure that this particular one is needed...
That said, the Notation package makes this pretty easy. As there are many hidden boxes when you use the Notation palette, I'll use a screenshot:
You can see the underlying NotationMake* downvalues construct by using the Action -> PrintNotationRules option. In[4] in the screenshot generates
NotationMakeExpression[
SubscriptBox[vals_, RowBox[{vars_, "|", svars_}]], StandardForm] :=
MakeExpression[
RowBox[{"restrict", "[", RowBox[{vars, ",", svars, ",", vals}],
"]"}], StandardForm]
NotationMakeBoxes[Subscript[vals_, vars_ | svars_], StandardForm] :=
SubscriptBox[MakeBoxes[vals, StandardForm],
RowBox[{Parenthesize[vars, StandardForm, Alternatives], "|",
Parenthesize[svars, StandardForm, Alternatives]}]]
With regard to 2: I would pass the rule list Thread[vars -> vals] instead of keeping track of names and values separately.
One of my favorite Mathematica idioms is to use rule lists together with WithRules as defined below: This construct evaluates an expression in a With block where all the replacement symbols have been (recursively defined). This allow you to do stuff like
WithRules[{a -> 1, b -> 2 a + 1}, b]
and gets you quite far towards named arguments.
SetAttributes[WithRules, HoldRest]
WithRules[rules_, expr_] := Module[{notSet}, Quiet[
With[{args = Reverse[rules /. Rule[a_, b_] -> notSet[a, b]]},
Fold[With[{#2}, #1] &, expr, args]] /. notSet -> Set,
With::lvw]]
Edit: The WithRules construct is based on these two usenet threads (thanks to Simon for digging them up):
A version of With that binds variables sequentially
Add syntax highlighting to own command

Resources