I'm stuck on a conversion.
I have a KMZ file with some coordinates. I read the file like this:
m=Import["~/Desktop/locations.kmz","Data"]
I get something like this:
{{LayerName->Point Features,
Geometry->{
Point[{-120.934,49.3321,372}],
Point[{-120.935,49.3275,375}],
Point[{-120.935,49.323,371}]},
Labels->{},LabeledData->{},ExtendedData->{},
PlacemarkNames->{1,2,3},
Overlays->{},NetworkLinks->{}
}}
I want to extract the {x,y,z} from each of the points and also the placemark names {1,2,3} associated with the points. Even if I can just get the points out of Geometry->{} that would be fine because I can extract them into a list with List###, but I'm lost at the fundamental part where I can't extract the Geometry "Rule".
Thanks for any help,
Ron
While Leonid's answer is correct, you will likely find that it does not work with your code. The reason is that the output of your Import command contains strings, such as "LayerNames", rather than symbols, such as LayerNames. I've uploaded a KML file to my webspace so we can try this using an actual Import command. Try something like the following:
in = Import["http://facstaff.unca.edu/mcmcclur/my.kml", "Data"];
pointList = "Geometry" /.
Cases[in, Verbatim[Rule]["Geometry", _], Infinity];
pointList /. Point[stuff_] -> stuff
Again, note that "Geometry" is a string. In fact, the contents of in look like so (in InputForm):
{{"LayerName" -> "Waypoints",
"Geometry" -> {Point[{-82.5, 32.5, 0}]},
"Labels" -> {}, "LabeledData" -> {},
"ExtendedData" -> {}, "PlacemarkNames" -> {"asheville"},
"Overlays" -> {}, "NetworkLinks" -> {}}}
Context: KML refers to Keyhole Markup Language. Keyhole was a company that developed tools that ultimately became Google Earth, after they were acquired by Google. KMZ is a zipped version of KML.
A simplification to Leonid and Mark's answers that I believe can be made safely is to remove the fancy Verbatim construct. That is:
Leonid's first operation can be written:
Join ## Cases[expr, (Geometry -> x_) :> (x /. Point -> Sequence), Infinity]
Leonid's second operation:
Join ## Cases[expr, (PlacemarkNames -> x_) :> x, Infinity]
I had trouble importing Mark's data, but from what I can guess, one could write:
pointList = Cases[in, ("Geometry" -> x_) :> x, Infinity, 1]
I'll let the votes on this answer tell me if I am correct.
Given your expression
expr = {{LayerName -> Point Features,
Geometry -> {
Point[{-120.934, 49.3321, 372}],
Point[{-120.935, 49.3275, 375}],
Point[{-120.935, 49.323, 371}]},
Labels -> {}, LabeledData -> {}, ExtendedData -> {},
PlacemarkNames -> {1, 2, 3}, Overlays -> {}, NetworkLinks -> {}}}
This will extract the points:
In[121]:=
Flatten[Cases[expr, Verbatim[Rule][Geometry, x_] :> (x /. Point -> Sequence),
Infinity], 1]
Out[121]= {{-120.934, 49.3321, 372}, {-120.935, 49.3275,375}, {-120.935, 49.323, 371}}
And this will extract the placemarks:
In[124]:= Flatten[Cases[expr, Verbatim[Rule][PlacemarkNames, x_] :> x, Infinity], 1]
Out[124]= {1, 2, 3}
Here is a more elegant method exploiting that we are looking for rules, that will extract both:
In[127]:=
{Geometry, PlacemarkNames} /.Cases[expr, _Rule, Infinity] /. Point -> Sequence
Out[127]=
{{{-120.934, 49.3321, 372}, {-120.935, 49.3275,375}, {-120.935, 49.323, 371}}, {1, 2, 3}}
How about Transpose[{"PlacemarkNames", "Geometry"} /. m[[1]]] ?
Related
I have a tree (expression) on which I want to gather only certain types of nodes - those that follow a certain pattern. I have a simplified example below:
A = {{{{},{0.3,0.3}},{0.2,0.2}},{0.1,0.1}};
TreeForm[A, PlotRangePadding->0]
Cases[A, {x_Real, y_Real}, Infinity]
The output:
Is this a good way to do it?
If instead of {x_, y_}, if I wanted to look for {{x1_, y1_}, {x2_, y_2}}, how can I exclude expressions like {x_, y_}, which also match?
Regards
EDIT (14/07/2011)
I have found that using a head other than List will greatly aid in finding such sub-expressions without collisions.
For example, reformulating the above:
A = {{{{}, pt[0.3, 0.3]}, pt[0.2, 0.2]}, pt[0.1, 0.1]};
List ### Cases[A, _pt, Infinity]
Output:
{{0.3,0.3},{0.2,0.2},{0.1,0.1}}
About the second part of your question, ie, selecting {{a,b},{c,d}}, how about
b = {{{{}, {0.3, 0.3}}, {0.2, 0.2}}, {{0.1, 0.1}, {0.3, 0.4}}};
TreeForm[b]
Cases[b, {{a_, b_}, {c_, d_}} /; (And ## NumericQ /# {a, b, c, d}), Infinity]
(so that they do not have to be Real but any Numeric will do)?
Here is an alternative to the form acl used, that I find more readable.
b = {{{{}, {0.3, 0.3}}, {0.2, 0.2}}, {{0.1, 0.1}, {0.3, 0.4}}};
With[{p = _?NumericQ}, Cases[b, {{p, p}, {p, p}}, -1] ]
I would like to be able to have a pattern that matches only expressions that are (alternately: are not) children of certain other elements.
For example, a pattern to match all Lists not within a Graphics object:
{ {1,2,3}, Graphics[Line[{{1,2},{3,4}}]] }
This pattern would match {1,2,3} but not {{1,2},{3,4}}.
There are relatively easy ways to extract expressions matching these criteria, but patterns are not only for extraction, but also for replacement, which is my main use case here (ReplaceAll).
Do you know of any easy, concise, and general ways to do this?
Is it possible to do this at all with just patterns?
I will propose a solution based on expression pre-processing and soft redefinitions of operations using rules, rather than rules themselves. Here is the code:
ClearAll[matchChildren, exceptChildren];
Module[{h, preprocess},
preprocess[expr_, parentPtrn_, lhs_, match : (True | False)] :=
Module[{pos, ptrnPos, lhsPos},
ptrnPos = Position[expr, parentPtrn];
lhsPos = Position[expr, lhs];
pos = Cases[lhsPos, {Alternatives ## PatternSequence ### ptrnPos, __}];
If[! match,pos = Complement[Position[expr, _, Infinity, Heads -> False], pos]];
MapAt[h, expr, pos]];
matchChildren /:
fun_[expr_, matchChildren[parentPtrn_, lhs : Except[_Rule | _RuleDelayed]],
args___] :=
fun[preprocess[expr, parentPtrn, lhs, True], h[lhs], args] //.
h[x_] :> x;
matchChildren /:
fun_[expr_, matchChildren[parentPtrn_, lhs_ :> rhs_], args___] :=
fun[preprocess[expr, parentPtrn, lhs, True], h[lhs] :> rhs, args] //.
h[x_] :> x;
exceptChildren /:
fun_[expr_,exceptChildren[parentPtrn_, lhs : Except[_Rule | _RuleDelayed]],
args___] :=
fun[preprocess[expr, parentPtrn, lhs, False], h[lhs], args] //.
h[x_] :> x;
exceptChildren /:
fun_[expr_, exceptChildren[parentPtrn_, lhs_ :> rhs_], args___] :=
fun[preprocess[expr, parentPtrn, lhs, False], h[lhs] :> rhs, args] //.
h[x_] :> x;
]
A few details on implementation ideas, and how it works. The idea is that, in order to restrict the pattern that should match, we may wrap this pattern in some head (say h), and also wrap all elements matching the original pattern but also being (or not being) within some other element (matching the "parent" pattern) in the same head h. This can be done for generic "child" pattern. Technically, one thing that makes it possible is the intrusive nature of rule application (and function parameter-passing, which have the same semantics in this respect). This allows one to take the rule like x_List:>f[x], matched by generic pattern lhs_:>rhs_, and change it to h[x_List]:>f[x], generically by using h[lhs]:>rhs. This is non-trivial because RuleDelayed is a scoping construct, and only the intrusiveness of another RuleDelayed (or, function parameter-passing) allows us to do the necessary scope surgery. In a way, this is an example of constructive use of the same effect that leads to the leaky functional abstraction in Mathematica. Another technical detail here is the use of UpValues to overload functions that use rules (Cases, ReplaceAll, etc) in the "soft" way, without adding any rules to them. At the same time, UpValues here allow the code to be universal - one code serves many functions that use patterns and rules. Finally, I am using the Module variables as a mechanism for encapsulation, to hide the auxiliary head h and function preprocess. This is a generally very handy way to achieve encapsulation of both functions and data on the scale smaller than a package but larger than a single function.
Here are some examples:
In[171]:= expr = {{1,2,3},Graphics[Line[{{1,2},{3,4}}]]};
In[168]:= expr/.matchChildren[_Graphics,x_List:>f[x]]//FullForm
Out[168]//FullForm= List[List[1,2,3],Graphics[Line[f[List[List[1,2],List[3,4]]]]]]
In[172]:= expr/.matchChildren[_Graphics,x:{__Integer}:>f[x]]//FullForm
Out[172]//FullForm= List[List[1,2,3],Graphics[Line[List[f[List[1,2]],f[List[3,4]]]]]]
In[173]:= expr/.exceptChildren[_Graphics,x_List:>f[x]]//FullForm
Out[173]//FullForm= List[f[List[1,2,3]],Graphics[Line[List[List[1,2],List[3,4]]]]]
In[174]:= expr = (Tan[p]*Cot[p+q])*(Sin[Pi n]+Cos[Pi m])*(Tan[q]+Cot[q]);
In[175]:= expr/.matchChildren[_Plus,x_Tan:>f[x]]
Out[175]= Cot[p+q] (Cot[q]+f[Tan[q]]) (Cos[m \[Pi]]+Sin[n \[Pi]]) Tan[p]
In[176]:= expr/.exceptChildren[_Plus,x_Tan:>f[x]]
Out[176]= Cot[p+q] f[Tan[p]] (Cos[m \[Pi]]+Sin[n \[Pi]]) (Cot[q]+Tan[q])
In[177]:= Cases[expr,matchChildren[_Plus,x_Tan:>f[x]],Infinity]
Out[177]= {f[Tan[q]]}
In[178]:= Cases[expr,exceptChildren[_Plus,x_Tan:>f[x]],Infinity]
Out[178]= {f[Tan[p]]}
In[179]:= Cases[expr,matchChildren[_Plus,x_Tan],Infinity]
Out[179]= {Tan[q]}
In[180]:= Cases[expr,matchChildren[_Plus,x_Tan],Infinity]
Out[180]= {Tan[q]}
It is expected to work with most functions which have the format fun[expr_,rule_,otherArgs___]. In particular, those include Cases,DeleteCases, Replace, ReplaceAll,ReplaceRepeated. I did not generalize to lists of rules, but this should be easy to do. It may not work properly in some subtle cases, e.g. with non-trivial heads and pattern-matching on heads.
According to your explanation in the comment to the acl's answer:
Actually I'd like it to work at any
level in the expression <...>. <...>
what I need is replacement: replace
all expression that match this
"pattern", and leave the rest
unchanged. I guess the simplest
possible solution is finding the
positions of elements, then using
ReplacePart. But this can also get
quite complicated in the end.
I think it could be done in one pass with ReplaceAll. We can rely here on the documented feature of the ReplaceAll: it does not look at the parts of the original expression which were already replaced even if they are replaced by themselves! Citing the Documentation: "ReplaceAll looks at each part of expr, tries all the rules on it, and then goes on to the next part of expr. The first rule that applies to a particular part is used; no further rules are tried on that part, or on any of its subparts."
Here is my solution (whatIwant is what you want to do with matched parts):
replaceNonChildren[lst_List] :=
ReplaceAll[#, {x_List :> whatIwant[x], y_ :> y}] & /# lst
Here is your test case:
replaceNonChildren[{{1, 2, 3}, Graphics[Line[{{1, 2}, {3, 4}}]]}] // InputForm
=> {whatIwant[{1, 2, 3}], Graphics[Line[{{1, 2}, {3, 4}}]]}
Here is a function that replaces only inside certain head (Graphics in this example):
replaceChildren[lst_List] :=
ReplaceAll[#, {y : Graphics[__] :> (y /. x_List :> whatIwant[x])}] & /# lst
Here is a test case:
replaceChildren[{{1, 2, 3}, Graphics[Line[{{1, 2}, {3, 4}}]]}] // InputForm
=> {{1, 2, 3}, Graphics[Line[whatIwant[{{1, 2}, {3, 4}}]]]}
You might write a recursive function that descends an expression tree and acts on the types of expression you want only if inside the right type of sub-expression, while leaving everything else alone. Patterns would be used heavily in the definition of the function.
Consider, for example, the following expression.
test = {{1, 2}, Graphics[{
Point[{{-1, 0}, {1, 0}}],
Line[{{-1, 0}, {1, 0}}]},
Frame -> True,
PlotRange -> {{-1, 1}, {-0.5, 0.5}}]};
Let's suppose that we want to rotate every ordered pair that we see in the first argument of Graphics about the origin through the angle Pi/4, while leaving other points alone. The following function does this.
Clear[f];
f[{x_?NumericQ, y_?NumericQ}] := If[flag === True,
RotationMatrix[Pi/4].{x, y}, {x, y}];
f[Graphics[primitives_, rest___]] := Block[{flag = True},
Graphics[f[primitives], rest]];
f[x_?AtomQ] := x;
f[x_] := f /# x;
Now we check
f[test]
I am probably misunderstanding you, but, if I do understand correctly you want to match all expressions with head List which have the property that, going upwards in the expression tree, we'll never meet a Graphics. I m not sure how to do this in one pass, but if you are willing to match twice, you can do something like
lst = {randhead[5], {1, 2, {3, 5}}, Graphics[Line[{{1, 2}, {3, 4}}]]};
Cases[#, _List] &#Cases[#, Except#Graphics[___]] &#lst
(*
----> {{1, 2, {3, 5}}}
*)
which first selects elements so that the Head isn't Graphics (this is done by Cases[#, Except#Graphics[___]] &, which returns {randhead[5], {1, 2, {3, 5}}}), then selects those with Head List from the returned list. Note that I've added some more stuff to lst.
But presumably you knew this and were after a single pattern to do the job?
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:
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]
I'm currently reading the Mathematica Guidebooks for Programming and I was trying to work out one of the very first program of the book. Basically, when I run the following program:
Plot3D[{Re[Exp[1/(x + I y)]]}, {x, -0.02, 0.022}, {y, -0.04, 0.042},
PlotRange -> {-1, 8}, PlotPoints -> 120, Mesh -> False,
ColorFunction -> Function[{x1, x2, x3}, Hue[Arg[Exp[1/(x1 + I x2)]]]]]
either I get a 1/0 error and e^\infinity error or, if I lower the PlotPoints options to, say, 60, an overflow error. I have a working output though, but it's not what it's supposed to be. The hue seems to be diffusing off the left corner whereas it should be diffusing of the origin (as can be seen on the original output)
Here is the original program which apparently runs on Mathematica 5 (Trott, Mathematica Guidebook for Programming):
Off[Plot3D::gval];
Plot3D[{Re[Exp[1/(x + I y)]], Hue[Arg[Exp[1/(x + I y)]]]},
{x, -0.02, 0.022}, {y, -0.04, 0.042},
PlotRange -> {-1, 8}, PlotPoints -> 120, Mesh -> False]
Off[Plot3D::gval];
However, ColorFunction used this way (first Plot3D argument) doesn't work and so I tried to simply adapt to its new way of using it.
Well, thanks I guess!
If you are satisfied with Mathematica's defaults you can use the old version of the code, simply cut out , Hue[Arg[Exp[1/(x + I y)]]] and the function works fine.
The problems you are having with the new version of the code seem to stem from the expression Exp[1/(x1 + I x2)] -- sometimes this will require the evaluation of 1/0. At least, if I cut out 1/ the program executes (on Mathematica 7) without complaint, though obviously with the wrong colours. So you need to rewrite your colour function, probably.
I finally found two alternative ways to solve my problem. The first one is to simply use the << Version5`Graphics` command to use Plot3Dfunction the way it worked with Mathematica V5. The code taken from the book works just like it used to.
However, if one wishes to display correctly the hue (that is, without diffusion off the left-hand corner) with the latest version, the Rescale function must be used, just like this:
Plot3D[Evaluate[Re[f[x, y]]], {x, -.02, .022}, {y, -0.04, 0.042},
PlotRange -> {-1, 2}, PlotPoints -> 120, Mesh -> False,
ColorFunction -> Function[{x, y, z}, Hue#Rescale[Arg[f[x, y]], {-π, π}]],
ColorFunctionScaling -> False,
ClippingStyle -> None]
I suppose the argument function in Mathematica does not map automatically to the [-Pi,Pi) range and so it must be rescaled to this domain. The result is quite good-looking, although there are some minor differences with the original plot.