Logarithmic Slider Control in Mathematica - user-interface

I'm making a small interface for calculating voltage dividers in Mathematica. I have two sliders (z1 & z2) that represent the resistor values and a couple of sliders to represent Vin as a sinusoid.
The issue is that the range of available resistor values (in the real world) is roughly logarithmic on {r, 100, 1,000,000}. If I set my slider range to r, however, it's impractical to select common low resistor values in approx. {100, 10,000}.
Is it possible to create a slider that sweeps through a logarithmic range?
Manipulate[
Grid[{{Plot[(VinRCos[t] + VinC), {t, -3, 9},
PlotRange -> {-1, VMax}, AxesLabel -> {t, Vin}]}, {Plot[
z2/(z1 + z2)(VinR*Cos[t] + VinC), {t, -3, 9},
PlotRange -> {-1, VMax}, AxesLabel -> {t, Vout}]}},
ItemSize -> 20],
{{z1, 10000}, 10, 1000000, 10}, {z1}, {{z2, 10000}, 10,
1000000}, {z2}, Delimiter, {{VinR, 2.5}, 0,
5}, {VinR}, {{VinC, 2}, -VMax, VMax}, {VinC}]

Michael's answer is probably the best, i.e. just get the user to specify the exponent. An alternate solution is to make a LogSlider type command. Here's a simple example:
LogSlider[{v:Dynamic[var_], v0_?Positive}, {min_?Positive, max_?Positive},
base_:10, options___] := DynamicModule[{ev}, Dynamic[
var = base^ev;
Slider[Dynamic[ev], Log[base, {min, max}]]]]
LogSlider[v:Dynamic[var_], {min_?Positive, max_?Positive},
base_:10, options___] := LogSlider[{v, min}, {min, max}]
The function only has a subset of the flexibility of Slider and will have to be extended if you want custom step sizes etc...
You then modify your Manipulate by specifying the variables using
{{z1, 10000}, 10, 1000000, LogSlider[##]&} etc...

A simple fix is to just make the slider manipulate the exponent, and plug in e.g. 10^z1 where you need the actual value:
Manipulate[10^z1, {{z1, 5}, 2, 6}] (* 100 to 1M *)
In your particular case, you could of course also input a list of standard resistor values to pick from:
Manipulate[z1, {z1, {100, 110, 120, 130, 150, 160, 180, 200, 220, 240, 270}}]
HTH!

Here is my final result:
Manipulate[
Evaluate[Round[10^Z2]/(Round[10^Z1] + Round[10^Z2])*Vin] "V",
{{Z1, 5}, 2, 6},
Pane["Z1 = " Dynamic[Round[10^Z1] "[CapitalOmega]"],
ImageMargins -> {{2.5, 0}, {3, 0}}],
{{Z2, 5}, 2, 6},
Pane["Z2 = " Dynamic[Round[10^Z2] "[CapitalOmega]"],
ImageMargins -> {{2.5, 0}, {0, -5}}], {{Vin, 2.5}, 0, VMax},
Pane["Vin = " Dynamic[Vin "V"], ImageMargins -> {{0, 0}, {0, -5}}]]

Here is a start to LogSlider that produces the standard two-way behavior the other controls have.
LogSlider[Dynamic[x_], max_] :=
Module[{exp},
Dynamic[exp = Log[max, x];
Slider[Dynamic[exp, (exp = #; x = max^exp) &]]]]
{LogSlider[Dynamic#x, 10^6], Dynamic#x}

Related

Plotting a 3 dimensional bar graph in Mathematica involving three axes of data

So I am fairly new to Mathematica and I have been having trouble finding a way of displaying three dimensional data in a bar structure in Mathematica. However, the best that I can do to represent my data.
My data is formatted in a way that I have a three coordinate structure for all of the points but I want to have each individual point represented. The data is as follows:
{0, 220, 0.05}, {0, 230, 0.33}, {0, 230, 0}, {0, 230, 0},
{0, 250, 1.04}, {0, 250, 0.26}, {0, 250, 1.01}, {0, 250, 4.83}, {0, 250, 0},
{0, 270, 2.69}, {10, 220, 0.6}, {10, 240, 1.28}, {10, 250, 0.97},
{15, 250, 0.25}, {15, 270, 3.52}
How can I make the graph a three dimensional graph with each coordinate point (all three axes) represented in its individual bar on the graph as opposed to a plane?
not sure what you are after -- note ListPlot3D doesn't work really right because some of your points are on top of each other..
Show[{ListPlot3D[data ], Graphics3D[{PointSize[.1], Point[data]}]}]
Show[Graphics3D#{Cuboid[{Append[#[[1 ;; 2]], 0] +
{2, 2, 0}, # - {2, 2, 0}}] & /# data}, Axes -> True,
AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}},
BoxRatios -> {1, 2, .5}]
ListPointPlot3D[{{0, 220, 0.05}, {0, 230, 0.33}, {0, 230, 0}, {0, 230,
0}, {0, 250, 1.04}, {0, 250, 0.26}, {0, 250, 1.01}, {0, 250,
4.83}, {0, 250, 0}, {0, 270, 2.69}, {10, 220, 0.6}, {10, 240,
1.28}, {10, 250, 0.97}, {15, 250, 0.25}, {15, 270, 3.52}},
Filling -> Bottom, DataRange -> All]
Is this what you want?

Draw lines to intersection of two functions

I'm trying to draw lines to the intersection of two functions in Mathematica that can be manipulated with a couple variables each in the following equation:
Manipulate[
Show[
Plot[
Tooltip[QSupply + q^PriceElasticity, "Supply"], {q, 0, 150},
AxesOrigin -> {0, 0},
PlotStyle -> {Thick, Red},
AxesLabel -> {"quantity", "price"},
PlotRange -> {{0, 200}, {0, 200}},
PlotLabel -> Macroeconomy, Ticks -> {{{45, "Qe"}}, {{54.3, "Pe"}}},
BaseStyle -> {FontWeight -> "Bold", FontSize -> 12}
],
Plot[
Tooltip[(DemandElasticity/q) + QDemand, "Aggregate Demand"], {q,
0, 180},
AxesOrigin -> {0, 0},
PlotStyle -> {Thick, Blue}
],
Graphics[{Dashed, Line[{{45, 0}, {45, 54.3}}]}],
Graphics[{Dashed, Line[{{0, 54.3}, {45, 54.3}}]}]
],
{PriceElasticity, 0.6, 10},
{QSupply, -17, 55, 2},
{DemandElasticity, 500, 10000, 100},
{QDemand, 0, 150, 10}
]
I tried using the FindRoot function, but the output doesn't give a raw value (eg. {q->40.0123}. Is there a way to extract the value from the FindRoot output? Or is there a better way to go about this?
I also looked into using Mesh but it looks like that would only help draw a dot at the point of intersection.
Thanks for your help!

How can I accelerate a Dynamic showing a graphic with custom ticks?

The following was adapted from a real world code:
ticks = Join[
Table[{i, Style[i, 10, Background -> White], {.04, 0}}, {i, 0, 20,
1}],
Table[{i, Null, {.01, 0}}, {i, 0, 20, 0.1}],
Table[{i, Null, {.025, 0}}, {i, 0, 20, 0.5}]
];
loc = {1, 1};
LocatorPane[
Dynamic[loc, loc[[2]] = #[[2]]; &],
Dynamic#Show[
Graphics[{Dashed,
Line[{{loc[[1]] - 0.5, loc[[2]]}, {0, loc[[2]]}}]}],
ImageSize -> 300, PlotRange -> {{-10, 10}, {0, 20}},
Axes -> {False, True}, AxesOrigin -> {0, 0},
Ticks -> {Automatic, ticks}
]]
The problem I have is that when I use the custom ticks, the updating (moving the locator) becomes much slower than with automatic ticks (Ticks -> {Automatic, Automatic}). How can I avoid what I believe is a ticks rebuilding time?
(I do need the Dynamic#Show[...] for other updating reasons not shown on this code sample).
Just as an example of moving Dynamic inside:
ticks = Join[
Table[{i, Style[i, 10, Background -> White], {.04, 0}}, {i, 0, 20,
1}], Table[{i, Null, {.01, 0}}, {i, 0, 20, 0.1}],
Table[{i, Null, {.025, 0}}, {i, 0, 20, 0.5}]];
loc = {1, 1};
LocatorPane[Dynamic[loc, loc[[2]] = #[[2]]; &],
Show[Graphics[
Dynamic#{Dashed, Line[{{loc[[1]] - 3, loc[[2]]}, {3, loc[[2]]}}]}],
ImageSize -> 300, PlotRange -> {{-10, 10}, {0, 20}},
Axes -> {False, True}, AxesOrigin -> {0, 0},
Ticks -> {Automatic, ticks}]]
Without knowing more about the rest of your program I cannot be very helpful.

Locator goes out of the graph region

When I run the following code
pMin = {-3, -3};
pMax = {3, 3};
range = {pMin, pMax};
Manipulate[
GraphicsGrid[
{
{Graphics[Locator[p], PlotRange -> range]},
{Graphics[Line[{{0, 0}, p}]]}
}, Frame -> All
],
{{p, {1, 1}}, Locator}
]
I expect the Locator control to be within the bounds of the first Graph, but instead it can be moved around the whole GraphicsGrid region. Is there an error in my code?
I also tried
{{p, {1, 1}}, pMin, pMax, Locator}
instead of
{{p, {1, 1}}, Locator}
But it behaves completely wrong.
UPDATE
Thanks to everyone, this is my final solution:
Manipulate[
distr1 = BinormalDistribution[p1, {1, 1}, \[Rho]1];
distr2 = BinormalDistribution[p2, {1, 1}, \[Rho]2];
Grid[
{
{Graphics[{Locator[p1], Locator[p2]},
PlotRange -> {{-5, 5}, {-5, 5}}]},
{Plot3D[{PDF[distr1, {x, y}], PDF[distr2, {x, y}]}, {x, -5, 5}, {y, -5, 5}, PlotRange -> All]}
}],
{{\[Rho]1, 0}, -0.9, 0.9}, {{\[Rho]2, 0}, -0.9, 0.9},
{{p1, {1, 1}}, Locator},
{{p2, {1, 1}}, Locator}
]
UPDATE
Now the problem is that I cannot resize and rotate the lower 3d graph. Does anyone know how to fix that?
I'm back to the solution with two Slider2D objects.
If you examine the InputForm you'll find that GraphicsGrid returns a Graphics object. Thus, the Locator indeed moves throughout the whole image.
GraphicsGrid[{{Graphics[Circle[]]}, {Graphics[Disk[]]}}] // InputForm
If you just change the GraphicsGrid to a Grid, the locator will be restricted to the first part but the result still looks a bit odd. Your PlotRange specification is a bit strange; it doesn't seem to correspond to any format specified in the Documentation center. Perhaps you want something like the following.
Manipulate[
Grid[{
{Graphics[Locator[p], Axes -> True,
PlotRange -> {{-3, 3}, {-3, 3}}]},
{Graphics[Line[{{0, 0}, p}], Axes -> True,
PlotRange -> {{-3, 3}, {-3, 3}}]}},
Frame -> All],
{{p, {1, 1}}, Locator}]
LocatorPane[] does a nice job of confining the locator to a region.
This is a variation on the method used by Mr. Wizard.
Column[{ LocatorPane[Dynamic[pt3],
Framed#Graphics[{}, ImageSize -> 150, PlotRange -> 3]],
Framed#Graphics[{Line[{{-1, 0}, Dynamic#pt3}]}, ImageSize -> {150, 150},
PlotRange -> 3]}]
I would have assumed that you'd want the locator to share the space with the line it controls. In fact, to be "attached" to the line. This turns out to be even easier to implement.
Column[{LocatorPane[Dynamic[pt3],Framed#Graphics[{Line[{{-1, 0}, Dynamic#pt3}]},
ImageSize -> 150, PlotRange -> 3]]}]
I am not sure what you are trying to achieve. There are a number of problems I see, but I don't know what to address. Perhaps you just want a simple Slider2D construction?
DynamicModule[{p = {1, 1}},
Column#{Slider2D[Dynamic[p], {{-3, -3}, {3, 3}},
ImageSize -> {200, 200}],
Graphics[Line[{{0, 0}, Dynamic[p]}],
PlotRange -> {{-3, 3}, {-3, 3}}, ImageSize -> {200, 200}]}]
This is a reply to the updated question about 3D graphic rotation.
I believe that LocatorPane as suggested by David is a good way to approach this. I just put in a generic function since your example would not run on Mathematica 7.
DynamicModule[{pt = {{-1, 3}, {1, 1}}},
Column[{
LocatorPane[Dynamic[pt],
Framed#Graphics[{}, PlotRange -> {{-5, 5}, {-5, 5}}]],
Dynamic#
Plot3D[{x^2 pt[[1, 1]] + y^2 pt[[1, 2]],
-x^2 pt[[2, 1]] - y^2 pt[[2, 1]]},
{x, -5, 5}, {y, -5, 5}]
}]
]

How can I constrain locators to a limited (but not regular) set of positions?

In Mathematica, locators can be constrained to certain screen regions via the parameters of LocatorPane (See LocatorPane documentation.)
A list of three ordered pairs {{{minX, minY}, {maxX, maxY}, {dX, dY}}} is usually the key to determining the behavior of locators. {minX, minY} and {maxX, maxY} set the region. {dX, dY} sets the jump size: zero for unrestrained, any other positive number for the size of each hop.
In the code below, {{{-.9, 0}, {1, 0}, {0, 0}}} sets the region and jumps for the locator pts. The first two ordered pairs limit the locators to the interval [-9, 1] on the number line. The ordered pair {0, 0} imposes no additional constraints on either of the locators. However, because the y values can only be zero, due to the region defined by the first two items, neither locator is free to leave the x-axis.
I'd like to confine each locator to x-values in myTicks. (In the full program, myTicks will change over time depending on decisions made by the user.) Because the ticks are not uniformly spaced along x, the issue cannot be solved by setting a constant value for the x-jump. And if the value were take into account the current position of the locator, the next left hop might be different size than the right hop.
myTicks = {-.9, 0, .1, .2, .45, .79, 1};
pts = {{.25, 0}, {.75, 0}};
LocatorPane[Dynamic[pts],
Graphics[{},
Axes -> {True, False},
PlotLabel -> Row[{"locators at: " , Dynamic[pts[[1, 1]]], " and ",
Dynamic[pts[[2, 1]]]}],
Ticks -> {myTicks, Automatic}],
{{{-.9, 0}, {1, 0}, {0, 0}}}]
Any suggestions would be appreciated!
This appears to work.
myTicks = {-.9, 0, .1, .2, .45, .79, 1};
DynamicModule[{p = {.25, 0}, p2 = {.75, 0}},
LocatorPane[Dynamic[{p, p2}],
Graphics[{}, Axes -> {True, False},
PlotLabel ->
Row[{"locators at: ",
Dynamic[p[[1]] = Nearest[myTicks, p[[1]]][[1]]], " and ",
Dynamic[p2[[1]] = Nearest[myTicks, p2[[1]]][[1]]]}],
Ticks -> {myTicks, Automatic}], {{{-.9, 0}, {1, 0}}}, ContinuousAction -> False]
]
Let's try this:
pts = {{0, 0}, {10, 0}};
myTics = Table[{x, 0}, {x, 0, 10, 5}];
LocatorPane[Dynamic[pts],
ListPlot[myTics, PlotRange -> {{-1, 11}, {-1, 1}},
PlotStyle -> Directive[PointSize[.07], Red],
Epilog -> {PointSize[.05], Blue, h = Point[Dynamic[{Nearest[myTics, pts[[1]]]}]],
PointSize[.03], Yellow, j = Point[Dynamic[{Nearest[myTics, pts[[2]]]}]],
Black,
Text[{"locators at: ", Dynamic[h[[1, 1]]], " and ",Dynamic[j[[1, 1]]]},
{5, .5}]}],
Appearance -> None]

Resources