Skip to main content

dynamic - Logarithmic slider


Is it possible to create a logarithmic slider similar to this one that responds to a change of the variable value?


That is, when the slider is moved, the variable value should update. When the variable value is changed separately, the slider position should update too.


The ultimate aim is to use this in Manipulate and have both a text input and a logarithmic slider input for the same parameter.





The post I linked to does not address changing the slider position when the variable is changed elsewhere.



Answer



A reliable composition of elements


Perhaps something like this? (Edit: Fixed to work with Autorun.) Note that the InputField label is editable, similar to a normal Manipulator. One can also add an additional InputField[Dynamic @ x] if a regular InputField is desired.


Manipulate[
x,
{{x, 1.}, 1., 100.,
Row[{Slider[Dynamic[Log10[#], (x = 10^#) &], Log10[#2]], " ",
InputField[#, Appearance -> "Frameless", BaseStyle -> "Label"]}] &}
]


Autorun of Manipulate


It's not a Manipulator, so no animator/input field. That's harder, since they (and the label) are built into the front-end implementation of a Manipulator. A Trigger and InputField could be added to simulate a Manipulator, I suppose.




A proper hack


All right, Kuba, you asked for it. :)


This is based on some spelunking of undocumented functions. The section titles reflect my feeling that the first is the best and a very good way to go. (These UI/Manipulate questions never seem to generate much interest in this SE community. This one wasn't particularly hard, but it did take some time to go through the details. I hope someone will find it useful, which is much more rewarding to me that "upvotes." In fact, I hope the first one is even more useful.)


The code is long, mainly because I worked out how the options to Manipulator are passed to the internal function. I put it at the end. I wrote a function logManipulator that works (almost exactly) like Manipulator (one unimportant thing was left undone).


{logManipulator[Dynamic[x], {1., 100.}], InputField[Dynamic@x]}


Mathematica graphics


The OP mentioned using it in a Manipulate with an input field. My original answer put the editable field as a label, just as a Manipulator does. However if a separate InputField is desired, that it as easy as adding a line to Manipulate for it.


To use logManipulator in Manipulate, one needs to pass a pure Function as with any custom control. Note: the animation below was produce with Export via Autorun, which interpolates x linearly between 10.^-5 and 10.; the animator, however, when run, interpolates linearly between their logarithms, and the slider moves with constant speed (more or less).


Manipulate[
Plot[t Sin[1/t], {t, -x, x}, PlotRange -> x, ImagePadding -> 10],
{x, 10.^-5, 10.,
logManipulator[##, Appearance -> {"Labeled", "Open"}, AnimationDirection -> Backward] &},
{{x, 1.}, Number, InputField},
AutorunSequencing -> {1}
]


Autorun of Manipulate


One can enter a value for x in the InputField (note the position of the slider):


Mathematica graphics


Code dump


The elements and options of Manipulator are nearly each passed as separate arguments to FEPrivate`FrontEndResource["FEExpressions", "Manipulator04"][..]. Only the animator elements in AppearanceElements -> {..} are passed together as a list. Some of the options are passed in other places. Since the Manipulator is wrapped in a DynamicBox, I used With to inject the values. I've given the arguments names that correspond more or less to the names of the elements or options. I hope that is enough of a hint as to how it works. The basis for the code was the output cell of a simple Manipulator[Dynamic[x]] (which can be inspected with the menu command "Cell > Show Expression").


ClearAll[logManipulator];
With[{smallerRule = {Large -> Medium, Medium -> Small, Small -> Tiny}},
logManipulator[Dynamic[x_], range_: {1, 10},
OptionsPattern[Manipulator]] := With[{

logrange = Log10[range],
imagesize = OptionValue[ImageSize] /. Automatic -> Medium,
inputfieldsize =
OptionValue[ImageSize] /. Automatic -> Medium /. smallerRule,
enabled = OptionValue[Enabled],
continuousaction = OptionValue[ContinuousAction],
appearance =
First[Cases[OptionValue[Appearance],
Tiny | Small | Medium | Large] /. {} -> {Automatic}],
labeled = ! FreeQ[OptionValue[Appearance], "Labeled"] || !

FreeQ[OptionValue[AppearanceElements], "InlineInputField"],
opener =
OptionValue[AppearanceElements] /. {Automatic -> True,
All -> True, None -> False,
l_List :> (Cases[l, Except["InlineInputField"]] =!= {})},
inputfield =
MatchQ[OptionValue[AppearanceElements], Automatic | All] ||
! FreeQ[OptionValue[AppearanceElements], "InputField"],
appearanceelements =
OptionValue[AppearanceElements] /. {Automatic -> All, None -> {},

l_List :> Cases[l, Except["InlineInputField" | "InputField"]]},
autoaction = OptionValue[AutoAction],
exclusions = OptionValue[Exclusions]},
ReleaseHold@MakeExpression[
PaneBox[
DynamicModuleBox[{
Typeset`open$$ = ! FreeQ[OptionValue[Appearance], "Open"],
Typeset`paused$$ = OptionValue[PausedTime],
Typeset`rate$$ = OptionValue[AnimationRate],
Typeset`dir$$ = OptionValue[AnimationDirection]},

StyleBox[
DynamicBox[
FEPrivate`FrontEndResource["FEExpressions", "Manipulator04"][
Dynamic[x],
Dynamic[Log10[x], (x = 10^#) & ],
logrange,
imagesize,
inputfieldsize,
enabled,
continuousaction,

appearance,
labeled,
opener,
inputfield,
appearanceelements ,
autoaction,
exclusions,
Dynamic[Typeset`open$$],
Dynamic[Typeset`paused$$],
Dynamic[Typeset`rate$$],

Dynamic[Typeset`dir$$]]],
DynamicUpdating -> True],
DynamicModuleValues :> {}],
BaselinePosition -> (OptionValue[BaselinePosition] /. Automatic -> Baseline),
ImageMargins -> OptionValue[ImageMargins]],
StandardForm]]
]

Comments

Popular posts from this blog

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]

plotting - Adding a thick curve to a regionplot

Suppose we have the following simple RegionPlot: f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}] Now I'm trying to change the curve defined by $y=g[x]$ into a thick black curve, while leaving all other boundaries in the plot unchanged. I've tried adding the region $y=g[x]$ and playing with the plotstyle, which didn't work, and I've tried BoundaryStyle, which changed all the boundaries in the plot. Now I'm kinda out of ideas... Any help would be appreciated! Answer With f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 You can use Epilog to add the thick line: RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}, PlotPoints -> 50, Epilog -> (Plot[g[x], {x, 0, 2}, PlotStyle -> {Black, Thick}][[1]]), PlotStyle -> {Directive[Yellow, Opacity[0.4]], Directive[Pink, Opacity[0.4]],