Related
In Mathematica:
I would like to pass a variable number of arguments to a function.
I would like to print the name of each argument. The problem is that SymbolName evaluates its input. For a given variable, you can get around this:
a=18;
SymbolName[Unevaluated[a]]
works. But that won't work if the variable is in a list. For example:
printname[x__]:=Print[Table[SymbolName[Unevaluated[{x}[[i]]]],{i,1,Length[{x}]}]];
printname[a,b,c]
will not work. Any suggestions?
Thanks in advance.
Mathematica tries to evaluate the argument of Unevaluated[] when you call it. So {x}[[i]] gets converted into {18, b, c}[[i]] which you didn't want and then the iteration over i doesn't work anymore because Unevaluated[] doesn't let the Table access the iterator.
So, to really solve the issue you should disable Mathematica's evaluation completely for the functions that you want to pass the symbols through.
In[1]:= SetAttributes[SymbolName, HoldAll];
SetAttributes[Map, HoldAll];
After this you can just do
In[2]:= a=18; SymbolName ### Unevaluated /# {a, b, c}
Out[2]:= {a, b, c}
where ### and /# are shorthand for Apply[] and Map[].
Setting Hold[] or similar attributes in Mathematica's built in functions can lead to trouble. See this question and answer in the Mathematica stackexchange for more information.
Specifically, to make a function that takes an arbitrary number of arguments would be
sym = SymbolName ### Unevaluated /# {##} &
But the List[] function that takes the sequence of arguments ## for the function & will again evaluate a and turning HoldAll on for List[] is not OK.
Thus the easiest way to do this is to define a function with HoldAll that just passes the args into a Block[] as the list of local variables. This makes a creates an isolated context where the variables do not evaluate to anything.
In[1]:= SetAttributes[f, HoldFirst];
In[2]:= f[seq__] := Block[{seq}, Print[SymbolName /# {seq}]];
In[3]:= a=18; f[a, b, c]
Out[3]:= {a, b, c}
I often wish to see the internal representation of Mathematica's graphical objects not in the FullForm but in much more readable InputForm having the ability to select parts of the code by double-clicking on it and easily copy this code to a new input Cell. But the default InputForm does not allow this since InputForm is displayed by default as a String, not as Mathematica's code. Is there a way to have InputForm displayed as Mathematica's code?
I also often wish to see a shortened version of such InputForm where all long lists of coordinates are displayed as the first coordinate followed by number of skipped coordinate values wrapped with Skeleton, all empty Lists removed and all numbers are also shortened for displaying no more than 6 digits. It would be even better to use 6 digits only for coordinates but for color directives such as Hue display only 2 significant digits. For example,
Plot[{Sin[x], .5 Sin[2 x]}, {x, 0, 2 \[Pi]},
Filling -> {1 -> {2}}] // ShortInputForm
should give:
Graphics[GraphicsComplex[{{1.28228`*^-7, 1.28228*^-7}, <<1133>>},
{{{EdgeForm[], Directive[{Opacity[0.2], Hue[0.67, 0.6, 0.6]}],
GraphicsGroup[{Polygon[{{1133, <<578>>}}]}]},
{EdgeForm[], Directive[{Opacity[0.2], Hue[0.67, 0.6, 0.6]}],
GraphicsGroup[{Polygon[{{432, <<556>>}}]}]}}, {{Hue[0.67, 0.6,
0.6], Line[{1, <<431>>}]}, {Hue[0.91, 0.6, 0.6],
Line[{432, <<701>>}]}}}], {AspectRatio -> GoldenRatio^(-1),
Axes -> True, AxesOrigin -> {0, 0},
Method -> {"AxesInFront" -> True},
PlotRange -> {{0, 2*Pi}, {-1., 1}},
PlotRangeClipping -> True,
PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]
(note that -0.9999998592131705 is converted to -1., 1.2822827157509358*^-7 is converted to 1.28228*^-7 and Hue[0.9060679774997897, 0.6, 0.6] is converted to Hue[0.91, 0.6, 0.6]).
In this way, I wish to have the output of InputForm as Mathematica's code and also have a ShortInputForm function which will give the shortened version of this code. Can anybody help me?
As to the first part of the question, I have found one way to achieve what I want:
Plot[{Sin[x], .5 Sin[2 x]}, {x, 0, 2 \[Pi]}, Filling -> {1 -> {2}}] //
InputForm // StandardForm
UPDATE
The most recent version of the shortInputForm function can be found here.
Original post
Here is another, even better solution (compatible with Mathematica 5):
myInputForm[expr_] :=
Block[{oldContexts, output, interpretation, skeleton},
output = ToString[expr, InputForm];
oldContexts = {$Context, $ContextPath};
$Context = "myTemp`"; $ContextPath = {$Context};
output = DisplayForm#ToBoxes[ToExpression[output] /.
{myTemp`interpretation -> If[$VersionNumber >= 6,
System`Interpretation, System`First#{#} &],
myTemp`Row -> System`Row,
myTemp`skeleton -> System`Skeleton,
myTemp`sequence :> (System`Sequence ## # &)}, StandardForm];
{$Context, $ContextPath} = oldContexts; output]
shortInputForm[expr_] := myInputForm[expr /. {{} -> Sequence[],
lst : {x_ /; VectorQ[x, NumberQ], y__} /;
(MatrixQ[lst, NumberQ] && Length[lst] > 3) :>
{x /. v : {a_, b__} /; Length[v] > 3 :>
{a, interpretation[skeleton[Length[{b}]], sequence#{b}]},
interpretation[skeleton[Length[{y}]], sequence#{y}]},
lst : {x_, y__} /; VectorQ[lst, NumberQ] && Length[lst] > 3 :>
{x, interpretation[skeleton[Length[{y}]], sequence#{y}]}}]
How it works
This solution is based on simple idea: we need to block conversion of such things as Graphics, Point and others to typeset expressions in order to get them displayed in the internal form (as expressions suitable for input). Happily, if we do this, the resulting StandardForm output is found to be just formatted (two-dimensional) InputForm of the original expression. This is just what is needed!
But how to do this?
First of all, this conversion is made by FormatValues defined for Symbols like Graphics, Point etc. One can get full list of such Symbols by evaluating the following:
list = Symbol /#
Select[DeleteCases[Names["*"], "I" | "Infinity"],
ToExpression[#, InputForm,
Function[symbol, Length[FormatValues#symbol] > 0, HoldAll]] &]
My first idea was just Block all these Symbols (and it works!):
myInputForm[expr_] :=
With[{list = list}, Block[list, RawBoxes#MakeBoxes#expr]]
But this method leads to the evaluation of all these Symbols and also evaluates all FormatValues for all Symbols in the $ContextPath. I think it should be avoided.
Other way to block these FormatValues is just to remove context "System`" from the $ContextPath. But it works only if these Symbols are not resolved yet to the "System`" context. So we need first to convert our expression to String, then remove "System`" context from the $ContextPath and finally convert the string backward to the original expression. Then all new Symbols will be associated with the current $Context (and Graphics, Point etc. - too, since they are not in the $ContextPath). For preventing context shadowing conflicts and littering the "Global`" context I switch $Context to "myTemp`" which can be easily cleared if necessary.
This is how myInputForm works.
Now about shortInputForm. The idea is not just to display a shortened version of myInputForm but also preserve the ability to select and copy parts of the shortened code into new input cell and use this code as it would be the full code without abbreviations. In version 6 and higher it is possible to achieve the latter with Interpretation. For compatibility with pre-6 versions of Mathematica I have added a piece of code that removes this ability if $VersionNumber is less than 6.
The only problem that I faced when working with Interpretation is that it has no SequenceHold attribute and so we cannot simply specify Sequence as the second argument for Interpretation. But this problem can easily be avoided by wrapping sequence in List and then Applying Sequence to it:
System`Sequence ## # &
Note that I need to specify the exact context for all built-in Symbols I use because at the moment of calling them the "System`" context is not in the $ContextPath.
This ends the non-standard decisions taken me in the development of these functions. Suggestions and comments are welcome!
At this moment I have come to the following solution:
round[x_, n_] := (10^-n*Round[10^n*MantissaExponent[x]]) /.
{m_, e_} :> N[m*10^e];
ShortInputForm[expr_] := ((expr /.
{{} -> Sequence[],
lst : {x_ /; VectorQ[x, NumberQ], y__} /;
(MatrixQ[lst, NumberQ] && Length[lst] > 2) :>
{x, Skeleton[Length[{y}]]},
lst : {x_, y__} /; VectorQ[lst, NumberQ] && Length[lst] > 2 :>
{x, Skeleton[Length[{y}]]}} /.
{exp : Except[List | Point][x__] /;
VectorQ[{x}, MachineNumberQ] :>
(round[#, 2] & /# exp),
x_Real /; MachineNumberQ[x] :> round[x, 6]})
// InputForm // StandardForm)
Now:
How to get all definitions for a symbol associated with other symbols by TagSet, TagSetDelayed, UpSet or UpSetDelayed?
For example, if one has defined
area[square] ^= s^2
area[cube] ^= 6*s^2
how to obtain these definitions, not knowing the names square, cube but knowing only the name area?
I just have found that UpValues does not return definitions for MakeBoxes and N since they are stored in FormatValues and NValues correspondingly:
In[1]:= rotate /: MakeBoxes[expr_rotate, "StandardForm"] := x
UpValues[rotate]
FormatValues[rotate]
Out[2]= {}
Out[3]= {HoldPattern[MakeBoxes[expr_rotate, "StandardForm"]] :> x}
In[4]:= pi /: N[pi] = 3.14
UpValues[pi]
NValues[pi]
Out[4]= 3.14
Out[5]= {}
Out[6]= {HoldPattern[N[pi, {MachinePrecision, MachinePrecision}]] :>
3.14}
In this way instead of UpValues we should use a combination of UpValues, FormatValues and NValues.
When trying to output a list of FormatValues one can face problems with MakeBoxes since FormatValues gives definitions for MakeBoxes those are further processed by MakeBoxes on creating the output for the FrontEnd. This problem can be solved by switching FormatType temporarily to OutputForm or by converting these definitions to strings.
In[1]:= SetOptions[$Output,FormatType->OutputForm];
FormatValues[DialogNotebook]
Out[2]= {HoldPattern[MakeBoxes[BoxForm`apat$:HoldPattern[DialogNotebook[___]], BoxForm`fpat$_]] :>
BoxForm`BoxFormAutoLoad[MakeBoxes, BoxForm`apat$, BoxForm`fpat$, Typeset`CellNotebook`,
{{CellGroup, _}, {DocumentNotebook, _}, {PaletteNotebook, _}, {DialogNotebook, _}, {ExpressionCell, _}, {Text, _},
{TextCell, _}, {Cell, HoldPattern[MakeExpression[_Cell, _]]}, {Notebook, HoldPattern[MakeExpression[_Notebook, _]]}}]}
In[1]:= ToString#FormatValues[DialogNotebook]
Out[1]= {HoldPattern[MakeBoxes[BoxForm`apat$:HoldPattern[DialogNotebook[___]], BoxForm`fpat$_]] :> BoxForm`BoxFormAutoLoad[MakeBoxes, BoxForm`apat$, BoxForm`fpat$, Typeset`CellNotebook`, {{CellGroup, _}, {DocumentNotebook, _}, {PaletteNotebook, _}, {DialogNotebook, _}, {ExpressionCell, _}, {Text, _}, {TextCell, _}, {Cell, HoldPattern[MakeExpression[_Cell, _]]}, {Notebook, HoldPattern[MakeExpression[_Notebook, _]]}}]}
Attempting to address Alexey's concerns with Howard's answer, I came up with this:
Cases[
UpValues ### MakeExpression /# Names["Global`*"],
HoldPattern[_#_area :> _],
{2}
]
In response to your updated requirements, here is the advanced version:
SetAttributes[otherValues, HoldFirst]
otherValues[sym_] :=
With[{names = MakeExpression /# Names["Global`*"]},
Join[
Cases[UpValues ### names, HoldPattern[_#_sym :> _], {2}],
Cases[NValues ### names, HoldPattern[_#N[sym, ___] :> _], {2}],
Select[Join ## FormatValues ### names, ! FreeQ[#, HoldPattern#sym] &]
]
]
You can try an exhaustive search via
Select[UpValues /# Cases[ToExpression[Names["*"]], _Symbol], ! FreeQ[#, area] &]
which in your example will yield
{{HoldPattern[area[cube]] :> 6 s^2}, {HoldPattern[area[square]] :> s^2}}
The following version
Cases[
Flatten#Map[
ToExpression[#, InputForm, Function[sym, UpValues[sym], HoldAllComplete]] &,
Names["Global`*"]],
Verbatim[RuleDelayed][Verbatim[HoldPattern][_area], _]
]
will not evaluate symbols as well. It is similar in spirit to #Mr. Wizard's answer, but I prefer ToExpression to MakeExpression since the latter is tied to the FrontEnd and boxes ( at least conceptually) , while the former is a general-purpose command (although it is mentioned in the documentation that it will use rules for MakeExpression).
If you have an access to the full Mathematica session from the start, another solution would be to overload TagSet, TagSetDelayed, UpSet and UpSetDelayed so that they will record the symbol dependencies in some kind of hash. Here is an example for UpSet:
Unprotect[UpSet];
Module[{tried, upsetHash},
upsetHash[_] = {};
getUpsetHash[] := upsetHash;
UpSet[f_[args___], rhs_] :=
Block[{tried = True},
AppendTo[upsetHash[f],
Select[HoldComplete[args],
Function[Null, Head[Unevaluated[#]] === Symbol, HoldAll]]];
UpSet[f[args], rhs]] /; ! TrueQ[tried]
];
Protect[UpSet];
All assignments made with UpSet after this redefinition will be recorded. For example, after executing your example above, you can call
In[6]:= getUpsetHash[][area]
Out[6]= {HoldComplete[square], HoldComplete[cube]}
This way you get your information much faster, especially if you want to make such inquiries frequently, and/or you have lots of packages loaded. You can also automate the process further, to switch to the standard definitions for assignments once you load the functionality of interest.
Good day,
I'm puzzled a bit with this:
In[1]:= f[x_]:=With[{xx=x},f[xx_]:=ff[xx]]
DownValues[f]
f[1]
DownValues[f]
Out[2]= {HoldPattern[f[x_]]:>With[{xx=x},f[xx_]:=ff[xx]]}
Out[4]= {HoldPattern[f[xx_]]:>ff[xx]}
The same happens if I use Block or Module instead of With.
I expected that the last DownValues[f] will give: {HoldPattern[f[x_]]:>ff[x]}. But it does not. Please, explain.
From documentation of With.
With replaces symbols in expr only when they do not occur as local variables inside scoping constructs.
Module and Block are simply not meant to do it.
Edit to elaborate on Module and Block. `The reason symbol is not replaced, is that it is not being evaluated. Block and Module do not do syntactic replacement operations. Try
f[x_] := Block[{xx = x}, f[xx_] = ff[xx]]
and then evaluate f[z].
Alternatively, you can execute you initial strategy by first using non-scoping construct:
f[x_] := With[{xx = x},
Hold[{f[xx_], ff[xx]}] /. {Hold[{a_, b_}] :> SetDelayed[a, b]}]
In[117]:= DownValues[f]
Out[117]= {HoldPattern[f[x_]] :>
With[{xx = x},
Hold[{f[xx_], ff[xx]}] /. {Hold[{a_, b_}] :> (a := b)}]}
In[118]:= f[z]
In[119]:= DownValues[f]
Out[119]= {HoldPattern[f[z_]] :> ff[z]}
Say I have a list of Rules
rules = {a -> b, c -> d};
which I use throughout a notebook. Then, at one point, it makes sense to want the rules to apply before any other evaluations take place in an expression. Normally if you want something like this you would use
In[2]:= With[{a=b,c=d}, expr[a,b,c,d]]
Out[2]= expr[b, b, d, d]
How can I take rules and insert it into the first argument of With?
Edit
BothSome solutions fail do all that I was looking for - but I should have emphasised this point a little more. See the bold part above.
For example, let's look at
rules = {a -> {1, 2}, c -> 1};
If I use these vaules in With, I get
In[10]:= With[{a={1,2},c=1}, Head/#{a,c}]
Out[10]= {List,Integer}
Some versions of WithRules yield
In[11]:= WithRules[rules, Head/#{a,c}]
Out[11]= {Symbol, Symbol}
(Actually, I didn't notice that Andrew's answer had the Attribute HoldRest - so it works just like I wanted.)
You want to use Hold to build up your With statement. Here is one way; there may be a simpler:
In[1]:= SetAttributes[WithRules, HoldRest]
In[2]:= WithRules[rules_, expr_] :=
With ## Append[Apply[Set, Hold#rules, {2}], Unevaluated[expr]]
Test it out:
In[3]:= f[args___] := Print[{args}]
In[4]:= rules = {a -> b, c -> d};
In[5]:= WithRules[rules, f[a, c]]
During evaluation of In[5]:= {b,d}
(I used Print so that any bug involving me accidentally evaluating expr too early would be made obvious.)
I have been using the following form of WithRules for a long time. Compared to the one posted by Andrew Moylan, it binds sequentially so that you can say e.g. WithRules[{a->b+1, b->2},expr] and get a expanded to 3:
SetAttributes[WithRules, HoldRest]
WithRules[rules_, expr_] := ReleaseHold#Module[{notSet}, Quiet[
With[{args = Reverse[rules /. Rule[a_, b_] -> notSet[a, b]]},
Fold[With[{#2}, #1] &, Hold#expr, args]] /. notSet -> Set,
With::lvw]]
This was also posted as an answer to an unrelated question, and as noted there, it has been discussed (at least) a couple of times on usenet:
A version of With that binds variables sequentially
Add syntax highlighting to own command
HTH
EDIT: Added a ReleaseHold, Hold pair to keep expr unevaluated until the rules have been applied.
One problem with Andrew's solution is that it maps the problem back to With, and that does not accept subscripted variables. So the following generates messages.
WithRules[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Power[Subscript[x, 1], Subscript[x, 2]]]
Given that With performs syntactic replacement on its body, we can set WithRules alternatively as follows:
ClearAll[WithRules]; SetAttributes[WithRules, HoldRest];
WithRules[r : {(_Rule | _RuleDelayed) ..}, body_] :=
ReleaseHold[Hold[body] /. r]
Then
In[113]:= WithRules[{Subscript[x, 1] -> 2,
Subscript[x, 2] -> 3}, Subscript[x, 1]^Subscript[x, 2]]
Out[113]= 8
Edit: Addressing valid concerns raised by Leonid, the following version would be safe:
ClearAll[WithRules3]; SetAttributes[WithRules3, HoldRest];
WithRules3[r : {(_Rule | _RuleDelayed) ..}, body_] :=
Developer`ReplaceAllUnheld[Unevaluated[body], r]
Then
In[194]:= WithRules3[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Subscript[x, 1]^Subscript[x, 2]]
Out[194]= 8
In[195]:= WithRules3[{x -> y}, f[y_] :> Function[x, x + y]]
Out[195]= f[y_] :> Function[x, x + y]
Edit 2: Even WithRules3 is not completely equivalent to Andrew's version:
In[206]:= WithRules3[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[206]= f[y_] :> Function[x, x + y + z]
In[207]:= WithRules[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[207]= f[y$_] :> Function[x$, x$ + y$ + 2]