I am trying to custom-format tick labels on a ListLogLogPlot. By searching Mathgroup archives, it looks like the usual way to mess with tick labels is to extract them using AbsoluteOptions, run a replacement rule with the custom format, and then explicitly feed them to the plotting function with the Ticks->{...} option. However, the following doesn't work for ListLogLogPlot:
foo = ListLogLogPlot[Range[20]^3, Frame -> True];
ticks=(FrameTicks /. AbsoluteOptions[foo, FrameTicks])
Any ideas on how to deal with this?..
Edit: lots of good answers here! Accepting Mr. Wizard's since it proved to be the most concise way to solve the immediate problem at hand, but I see myself using the other methods suggested in the future.
One can use replacements to mess with the labels directly, bypassing Option/AbsoluteOptions:
ListLogLogPlot[Range[20]^3, Frame -> True] /.
(FrameTicks -> x_) :>
(FrameTicks -> (x /. {a_?NumericQ, b_Integer, s___} :>
{a, Superscript[10, Log10#b], s} ))
Thanks to Alexey Popkov this is now improved and less fragile.
Like Sjoerd, I generally prefer to write a function that computes the ticks on the fly:
PowerTicks[label_][min_, max_] := Block[{min10, max10},
min10 = Floor[Log10[min]];
max10 = Ceiling[Log10[max]];
Join[Table[{10^i,
If[label, Superscript[10, i], Spacer[{0, 0}]]}, {i, min10,
max10}],
Flatten[
Table[{k 10^i,
Spacer[{0, 0}], {0.005, 0.`}, {Thickness[0.001`]}}, {i, min10,
max10}, {k, 9}], 1]]
]
ListLogLogPlot[Range[20]^3, Frame -> True,
FrameTicks -> {{PowerTicks[True],
PowerTicks[False]}, {PowerTicks[True], PowerTicks[False]}}]
To complement Brett's answer, look at the CustomTicks package in LevelScheme. It provides two functions for generating tick marks 'LinTicksandLogTicks`, and each has a host of formatting options. Currently, it requires you to perform the logarithm yourself, i.e.
Plot[ {Log[10,Cosh[x]], Log[10, Sinh[x]]}, {x, 0, 4}, Frame -> True,
FrameTicks -> { LinTicks, LogTicks, None, None }]
gives
For a list of data, obviously you'd have to use Log[Base, data] with ListPlot, but it is workable. I have submitted a patch to Mark Caprio so that the following would do the exact same thing as above
LogPlot[ {Cosh[x], Sinh[x]}, {x, 0, 4}, Frame -> True,
FrameTicks -> { LinTicks, LogTicks, None, None }]
If the patch is accepted the old form of LogTicks would be accessible by setting the option PlotType to Linear, Logarithmic is default. The advantage of using CustomTicks is that other bases are easy
and it automatically formats it like you want.
Edit: I'd also like to point out, that CustomTicks is loadable by itself, separate from the rest of LevelScheme. And, as it is a small package, there isn't all that much additional overhead.
Looks like a bug to me. Simple calling AbsoluteOptions[foo] yields error messages. Plain old Options[foo] works fine, though.
Send an email with this code in it to support#Wolfram.com. They will be able to tell you if there's a known better workaround.
Related
I want to make mathematica insensitive to the functions first capital letter. For example, it accepts both "Plot" and "plot" as plotting function.
I agree with george's sentiment: "You don't want to do that." It is common practice to start user Symbols with lowercase letters which both identifies them and prevents collisions with built-ins. Nevertheless you can do this in several ways. One is just to create aliases as george also suggested, e.g.
plot = Plot;
sin = Sin;
plot[sin[x], {x, 0, 6}]
This has the advantage of working even in packages because it does not rely on the Front End. However, because these are not true aliases it will fail in some cases, e.g.:
evaluate = Evaluate;
Hold[evaluate[2 + 2]]
Hold[evaluate[2 + 2]]
Whereas the "real" function behaves like this:
Hold[Evaluate[2 + 2]]
Hold[4]
To get complete equivalence, though only in the Front End, you can use $PreRead. (Example.) You will need to build a list of rules that replace the string form of each lowercase Symbol with the uppercase string. I shall do that only for all Symbols in the System` context.
With[{rules = Thread[ToLowerCase[#] -> #] & # Names["System`*"]},
$PreRead = # /. rules &
];
Now both of these examples work:
plot[sin[x], {x, 0, 6}]
hold[evaluate[2 + 2], 3 + 4]
The latter producing:
Hold[4, 3 + 4]
This is not a direct answer to your question and I strongly advise you against redefining Mathematica functions just for the sake of the letter-case.
Nevertheless, have you seen that there is an option Match case in command completion when you go to Edit -> Preferences -> Interface?
If you turn this off, then you can type plot in the notebook and you get the correct Plot as suggestion from the autocompletion. You only have to hit enter and the correct command is inserted.
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.
This should be quick to an expert, but I'm relatively new at defining functions with options. Here is a schematic of what I've tried, I'll explain after showing the code:
MyPlotFunction[params_, optionalparameter_List:{1,2,3}, opts:OptionsPattern[]]:=
Plot [ stuff, {x,0,1}, Evaluate#FilterRules[{opts},Options#Plot]];
Options[MyPlotFunction] = { PlotRange->{-5,5}, Frame->True, ... other plot options};
There are four slight subtleties:
I have an optional parameter in my function that needs to be a list of integers.
I want the ability to call the function with any option of Plot, especially using values other than the default values specified in the third line.
I want to have default values for some of the options.
I potentially want to put other options in the function, so it is not guaranteed that all of the options should be passed through to plot.
But what I have above doesn't work. The default options I set are ignored, yet they appear in the ??MyPlotFunction information for my function. I'll give examples if you guys can't spot the error yet.
Edit:
Examples that doesn't work:
SimplePlot[t_,opts:OptionsPattern[{PlotRange->{-4,4},Frame->True}]]:=
Plot[2x+t,{x,0,1},opts];
Fails, the default option is ignored.
SimplePlot[t_,opts:OptionPattern[]]:=
Plot[2x+t],{x,0,1},opts];
Options[SimplePlot] = {PlotRange->{-4,4},Frame->True};
Fails, the default option is ignored.
SimplePlot[t_,opts__:{PlotRange->{-4,4},Frame->True}]:=
Plot[2x+t,{x,0,1},opts];
Default options work with a bare call, but if one of these options or any other plot option is overridden the remaining defaults are lost.
OptionsPattern[] only catches the options that are passed in, so you need to explicitly include any non-default option settings, say by using something like:
FilterRules[{opts, Options[MyPlotFunction]}, Options#Plot]
Here's a simple example:
Options[MyPlotFunction] = {PlotRange -> {-5, 5}, Frame -> True};
MyPlotFunction[params_, optionalparameter_List: {1, 2, 3},
opts : OptionsPattern[MyPlotFunction]] :=
Plot[optionalparameter, {x, 0, 1},
Evaluate#FilterRules[{opts, Options[MyPlotFunction]}, Options#Plot]]
As noted in the comments to Brett's answer, since options given first supersede options given later, and since options to Plot may be given as a list, you can write something like this:
Options[SimplePlot] = {PlotRange -> {-4, 4}, Frame -> True};
SimplePlot[t_, opts : OptionsPattern[]] :=
Plot[2 x + t, {x, 0, 1}, opts, #] & # Options[SimplePlot];
What would a minimal example for a choropleth map in Mathematica look like?
I can read in a ESRI Shapefile using Import, but do not know how to work with the imported result.
Graphics[
{
ColorData["ThermometerColors"][
Rescale[CountryData[#, "GDPPerCapita"], {100, 50000}]
] /. HoldPattern[Blend[___]] -> Yellow,
CountryData[#, "Polygon"]
} & /#
CountryData[]
]
And why the replacement? If there are no data of the required type for a given country CountryData returns Missing["NotAvailable"], causing ColorData, and its underlying Blend function not to return a specific RGB value. I replace this unevaluated Blend with the color Yellow.
Just for reference, here some tips for working with ESRI Shapefiles. CountryData does not provide county-level data for Germany (the administrative unit is called "Kreis"), which is why I wrote my own KreisData function. The shape file I used can be downloaded for free, however there are terms of use to consider.
The KreisData function is then created as follows:
shp = Import["C:/TEMP/map/VG2500/vg2500_krs.shp", "Data"];
polys = "Geometry" /. First[shp];
ags = "RS" /. ("LabeledData" /. First[shp]);
names = "GEN" /. ("LabeledData" /. First[shp]);
area = "SHAPE_AREA" /. ("LabeledData" /. First[shp]);
KreisDataRules =
Dispatch[MapThread[
Rule[#1, #2] &, {ags, Transpose[{polys, area, names}]}]];
KreisData[tag_String, "Polygon"] := First[tag /. KreisDataRules];
KreisData[tag_String, "Area"] := Part[tag /. KreisDataRules, 2];
KreisData[tag_String, "Name"] := Last[tag /. KreisDataRules];
KreisData[] := ags;
With this function, and the example code by Sjoerd C. de Vries, a map of Germany is created thus:
renderMap[scheme_String] :=
Graphics[{ColorData[scheme][
Rescale[KreisData[#, "Area"], {3.63067036816521*10^7,
3.08469540395003*10^9}]] /.
HoldPattern[Blend[___]] -> Yellow, KreisData[#, "Polygon"]} & /#
KreisData[]];
Manipulate[renderMap[s], {s, ColorData["Gradients"]}]
A throw on Minimal in the code golf sense:
Graphics#Function[f,{Hue[f[#,"Area"]/10^7],f[#,"Polygon"]} &/# f[]]#CountryData
Because I cannot resist a Code Golf competition with belisarius:
Graphics[{Hue[i~#~"Area"/10^7],i~#~"Polygon"}~Table~{i,#[]}&#CountryData]
(for the same result)
#Karsten W.: unfortunately your shp file is not longer available. I tried a similar one (vg250_0101.utm32s.shape.ebenen\vg250_ebenen\vg250_krs.shp) from the same source but I got the error message "Transpose: the first two levels can not be transposed" from your function KreisDataRules. And since I did not really understand what your code does, maybe you can help.
I try to produce a thematic map on a Kreis level, where the colouring shows the number of tourists in our city, if necessary also 0.
I would be very grateful for any help.
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.