Related
So in order to save some time, I wrote a function to plot a graph with a lot of default settings. I want to add a 0 tick to the Axes, so I added Epilog in the plot. However, the 0 does not seem to show up in the graph, and the Epilog does not seem to be working at all.
LatexTextStyle[text_] :=
Style[text, FontSize -> 18, FontFamily -> "CMU Serif"]
StyledText[text_] := Text[LatexTextStyle[text]]
StyledTextPos[text_, posx_, posy_] :=
Text[LatexTextStyle[text], {posx, posy}]
NPlot[fns_, variable_ : x, xmin_, xmax_, ymin_, ymax_,
pltStyle_ : Default, epilog_ : {}, marginScale_ : 0.12,
fontSize_ : 18, xOffset_ : 10, yOffset_ : 10] := Plot[
fns,
{variable, xmin, xmax},
PlotStyle -> pltStyle,
AspectRatio -> Equal,
PlotRange -> {
{xmin - marginScale*Abs[xmax - xmin],
xmax + marginScale*Abs[xmax - xmin]}, {ymin -
marginScale*Abs[ymax - ymin],
ymax + marginScale*Abs[ymax - ymin]}
},
BaseStyle -> {FontFamily -> "CMU Serif", FontSize -> fontSize},
AxesStyle -> Arrowheads[{0.0, 0.05}],
Epilog -> {
StyledTextPos["0", -xOffset, -yOffset]
}
]
NPlot[fns = x^2 + 2 x + 1, xmin = -10, xmax = 10, ymin = -5,
ymax = 15]
Here is the graph that I got:
When I tried other Epilog inputs, nothing appeared to be showing up.
Your offset defaults are positioning the 0 at {-10, -10}, below the vertical plot range.
These defaults position the 0 correctly:
NPlot[ ... , xOffset_ : 0.6, yOffset_ : 1] := etc.
Hello! Help me please to make a procedure from my program code.
I've got code, which includs 2 parts (they're Graphics[...]), it plots functions with rectengles.
But it seems to be too much code, so I have to write a procedure with an argument of a function and then when I call it, this procedure would do the same (plots functions with rectengles). (can somehows to use spx1,spx2.)
This is whole code:
(*Sin[x]*)
data1 = Table[{x, Sin[x]}, {x, -1, 6, 0.1}];
data11 = data1[[;; , 2]];(*отримуємо набір ординат*)localmins1 =
Pick[data1, MinDetect[data11, 10^-6], 1];
localmaxs1 = Pick[data1, MaxDetect[data11, 10^-6], 1];
Graphics[{Thick, Blue, Line[data1], Red, PointSize[0.01],
Point[localmins1], Point[localmaxs1]}, Axes -> True];
spx1 = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 6};
Graphics[{Thick, Blue, Line[data1], Red, PointSize[0.01],
Point[localmins1], Point[localmaxs1],
Point[{{-1, 0}, {1.6, 0}, {-0.35, 0}, {0.3, 0}, {0.95, 0}}], Green,
Point[{{-0.35, -0.1342898}, {0.3, 0.29552}, {0.95, 0.813416}}], Red,
Point[{{2.375, 0}, {3.15, 0}, {3.925, 0}, {4.7, 0}}], Green,
Point[{{2.375, 0.693685}, {3.15, -0.0084}, {3.925, -0.70569766}}],
Pink, Opacity[.7], EdgeForm[Directive[Dashed, Pink]],
Rectangle[{-1, -0.84147}, {-0.35, -0.342898}],
Rectangle[{-0.35, -0.342898}, {0.3, 0.29552}],
Rectangle[{0.3, 0.29552}, {0.95, 0.813416}],
Rectangle[{0.95, 0.813416}, {1.6`, 0.9995736030415051`}],
Rectangle[{1.6, 0.99957}, {2.375, 0.693685}],
Rectangle[{2.375, 0.693685}, {3.15, -0.0084}],
Rectangle[{3.15, -0.0084}, {3.925, -0.70569766}],
Rectangle[{3.925, -0.70569766}, {4.7, -0.9999}],}, Axes -> True]
(*Cos[x]*)
data2 = Table[{x, Cos[x]}, {x, -3, 4, 0.1}]; data22 =
data2[[;; , 2]];(*отримуємо набір ординат*)localmins2 =
Pick[data2, MinDetect[data22, 10^-6], 1];
localmaxs2 = Pick[data2, MaxDetect[data22, 10^-6], 1];
Graphics[{Thick, Blue, Line[data2], Red, PointSize[0.01],
Point[localmins2], Point[localmaxs2]}, Axes -> True];
spx2 = {-3,-2.25, -1.5, -0.75,0, 0.75, 1.5, 2.25, 3};
spxrozb11 = {-3, -2.25, -1.5, -0.75, 0};
spxrozb22 = {0, 0.75, 1.5, 2.25, 3};
Graphics[{Thick, Blue, Line[data2], Red, PointSize[0.01],
Point[localmins2], Point[localmaxs2],
Point[{{-2.25, 0}, {-1.5, 0}, {-0.75, 0}, {0, 0}}], Green,
Point[{{-2.25, -0.628}, {-1.5, 0.07}, {-0.75, 0.73}}], Red,
Point[{{0.75, 0}, {1.5, 0}, {2.25, 0}, {3, 0}}], Green,
Point[{{0.75, 0.7316}, {1.5, 0.07}, {2.25, -0.628}}], Pink,
Opacity[.7], EdgeForm[Directive[Dashed, Pink]],
Rectangle[{-3, -0.989992}, {-2.25, -0.628}],
Rectangle[{-2.25, -0.628}, {-1.5, 0.07}],
Rectangle[{-1.5, 0.07}, {-0.75, 0.7316}],
Rectangle[{-0.75, 0.7316}, {1.6653345369377348`*^-16, 1.`}],
Rectangle[{1.6653345369377348`*^-16, 1.`}, {0.75, 0.7316}],
Rectangle[{0.75, 0.7316}, {1.5, 0.07}],
Rectangle[{1.5, 0.07}, {2.25, -0.628}],
Rectangle[{2.25, -0.628}, {3.1000000000000005`, \
-0.9991351502732795`}]}, Axes -> True]
I tried to write the first step in procedure, and even it doesn't work;(
f1 = Table[{x, Sin[x]}, {x, -1, 6, 0.1}];
f2 = Table[{x, Cos[x]}, {x, -3, 4, 0.1}];
data = {f1, f2};
spx1 = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 6};
graph[i_] :=
Graphics[For[i = 0, i < 3,
i++, {Thick, Blue, Line[data[[i]]], Red, Point[{spx1[[i]], 0}]}]]
graph[1]
******How to write For in procedure correctly?******
Help me, please!
There's the procedure operation[f_].
It works correctly and plot for functions:Cos,Sin. But, Unfortunately, it doesn't work for E^x and Log[E,x] and outputs errors, maybe because inputting not correct name of function or something else;(( What's the problem?
spxsin = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 5.025,
5.35, 5.675, 6};
spxcos = {-1, -0.75, -0.5, -0.25, 0, 0.775, 1.55, 2.325, 3.1, 3.825,
4.55, 5.275, 6};
spxlny = {-1, 0.75, 2.5, 4.25, 6};
spxey = {-1, 0.75, 2.5, 4.25, 6};
operation[f_] := Block[{data},
data = Table[{x, f[x]}, {x, -1, 6, 0.1}];
Graphics[{Thick, Blue, Line[data],
Green, Table[Point[{spx[[i]], f[spx[[i]]]}], {i, 1, Length[spx]}],
Pink, Opacity[.7],
Table[Rectangle[{spx[[i]], f[spx[[i]]]}, {spx[[i + 1]],
f[spx[[i + 1]]]}], {i, 1, Length[spx] - 1}]
}, Axes -> True]]
Which[ f == Sin, spx := spxsin, f == Cos, spx := spxcos, f == E^x ,
spx := spxlny, f == Log, spx := spxey]
operation[Sin]
operation[Cos]
operation[E^x]
operation[Log]
Edit now tested: you can pass pure functions to your operation, so instead of: operation[E^x] try
operation[E^# &]
or for example if you wanted a base 2 log it would be
operation[Log[2,#]&]
A few other things to point out: Log fails simply because your x table range is negative.
Also, the Which statement you have doesn't do anything. Being outside your function, f is not defined so none of the conditionals are True. Moving Which inside the function, this works:
spxsin = {-1, -0.35, 0.3, 0.95, 1.6, 2.375, 3.15, 3.925, 4.7, 5.025,
5.35, 5.675, 6};
spxcos = {-1, -0.75, -0.5, -0.25, 0, 0.775, 1.55, 2.325, 3.1, 3.825,
4.55, 5.275, 6};
spxlny = {-1, 0.75, 2.5, 4.25, 6};
spxey = {-1, 0.75, 2.5, 4.25, 6};
operation[f_] :=
Block[{data}, data = Table[{x, f[x]}, {x, -1, 6, 0.1}];
Clear[spx];
Which[
TrueQ[f == Sin], spx := spxsin,
TrueQ[f == Cos], spx := spxcos ,
TrueQ[f == (E^# &)], spx := spxey ];
Graphics[{Thick, Blue, Line[data], Green,
Table[{PointSize[.1], Point[{spx[[i]], f[spx[[i]]]}]}, {i, 1, Length[spx]}],
Pink, Opacity[.7],
Table[Rectangle[{spx[[i]], f[spx[[i]]]}, {spx[[i + 1]],
f[spx[[i + 1]]]}], {i, 1, Length[spx] - 1}]}, Axes -> True,
AspectRatio -> 1/GoldenRatio]]
Note each which test is wrapped in TrueQ to ensure it is either True or False ( the test Sin==Cos is not false for all values and so does not return False )
operation[Sin]
operation[Cos]
operation[E^# &]
Now if you want Exp to also work you need to explicitly put that form in your Which statement. ( f==(E^#&) || f==Exp )
Euler's E needs to be entered as Esc ee Esc.
It looks to me at you entered is a standard E.
Note also that Exp is the exponential function in Mathematica.
I have an ODE and I solve it with NDSolve, then I plot the solution on a simplex in 2D.
Valid XHTML http://ompldr.org/vY2c5ag/simplex.jpg
Then I need to transform (align or just plot) this simplex in 3D at coordinates (1,0,0),(0,1,0),(0,0,1), so it looks like this scheme:
Valid XHTML http://ompldr.org/vY2dhMg/simps.png
I use ParametricPlot to do my plot so far. Maybe all I need is ParametricPlot3D, but I don't know how to call it properly.
Here is my code so far:
Remove["Global`*"];
phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y);
betam = 0.5;
betaf = 0.5;
betam = s;
betaf = 0.1;
sigma = 0.25;
beta = 0.3;
i = 1;
Which[i == 1, {betam = 0.40, betaf = 0.60, betam = 0.1,
betaf = 0.1, sigma = 0.25 , tmax = 10} ];
eta[x2_, y2_, p2_] = (betam + betaf + sigma)*p2 - betam*x2 -
betaf*y2 - phi[x2, y2];
syshelp = {x2'[t] == (betam + betaf + sigma)*p2[t] - betam*x2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*x2[t],
y2'[t] == (betaf + betam + sigma)*p2[t] - betaf*y2[t] -
phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*y2[t],
p2'[t] == -(betam + betaf + sigma)*p2[t] + phi[x2[t], y2[t]] -
eta[x2[t], y2[t], p2[t]]*p2[t]};
initialcond = {x2[0] == a, y2[0] == b, p2[0] == 1 - a - b};
tmax = 50;
solhelp =
Table[
NDSolve[
Join[initialcond, syshelp], {x2, y2, p2} , {t, 0, tmax},
AccuracyGoal -> 10, PrecisionGoal -> 15],
{a, 0.01, 1, 0.15}, {b, 0.01, 1 - a, 0.15}];
functions =
Map[{y2[t] + p2[t]/2, p2[t]*Sqrt[3]/2} /. # &, Flatten[solhelp, 2]];
ParametricPlot[Evaluate[functions], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> Automatic]
Third day with Mathematica...
You could find a map from the triangle in the 2D plot to the one in 3D using FindGeometricTransformation and use that in ParametricPlot3D to plot your function, e.g.
corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]],
PadRight[#, 3] & /# Append[pts1, Mean[pts1]],
"Transformation" -> "Affine"][[2]]
ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & ### functions],
{t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
Since your solution has the property that x2[t]+y2[t]+p2[t]==1 it should be enough to plot something like:
functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];
ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax},
PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]
I've been developing a gui for some time, which requires the creation of common control objects that Mathematica lacks (e.g. spinner, treeview, openerbar, etc.). One is the multipanel, i.e. a pane object that is split into two (or more) subpanes, where the divider can be set by the mouse. Here is my version of a dual pane. I would like to hear your opinion and ideas about how to expand it to handle not just 2 but any number of subpanes, and also how to optimize it. At present, for heavily loaded subpanes, it lags terribly, no idea why.
Options[SplitPane] = {Direction -> "Vertical",
DividerWidth -> Automatic, Paneled -> {True, True}};
SplitPane[opts___?OptionQ] :=
Module[{dummy}, SplitPane[Dynamic[dummy], opts]];
SplitPane[val_, opts___?OptionQ] := SplitPane[val, {"", ""}, opts];
SplitPane[val_, content_, opts___?OptionQ] :=
SplitPane[val, content, {100, 50}, opts];
SplitPane[Dynamic[split_, arg___], {expr1_, expr2_}, {maxX_, maxY_},
opts___?OptionQ] :=
DynamicModule[{temp, dir, d, panel, coord, max, fix, val},
{dir, d, panel} = {Direction, DividerWidth, Paneled} /. {opts} /.
Options[SplitPane];
dir = dir /. {Bottom | Top | "Vertical" -> "Vertical", _ ->
"Horizontal"};
d = d /. Automatic -> 2;
split = If[NumberQ[split], split, max/2];
val = Clip[split /. {_?NumberQ -> split, _ -> maxX/2}, {0, maxX}];
{coord, max, fix} =
Switch[dir, "Vertical", {First, maxX, maxY},
"Horizontal", {(max - Last[#]) &, maxY, maxX}];
panel = (# /. {None | False ->
Identity, _ -> (Panel[#, ImageMargins -> 0,
FrameMargins -> -1] &)}) & /# panel;
Grid[If[dir === "Vertical",
{{
Dynamic[
panel[[1]]#
Pane[expr1, ImageSize -> {split - d, fix},
ImageSizeAction -> "Scrollable", Scrollbars -> Automatic,
AppearanceElements -> None], TrackedSymbols :> {split}],
Deploy#EventHandler[
MouseAppearance[
Pane[Null, ImageSize -> {d*2, fix}, ImageMargins -> -1,
FrameMargins -> -1], "FrameLRResize"],
"MouseDown" :> (temp =
coord#MousePosition#"CellContentsAbsolute";
split =
If[Abs[temp - split] <= d \[And] 0 <= temp <= max, temp,
split]),
"MouseDragged" :> (temp =
coord#MousePosition#"CellContentsAbsolute";
split = If[0 <= temp <= max, temp, split])],
Dynamic#
panel[[2]]#
Pane[expr2, ImageSizeAction -> "Scrollable",
Scrollbars -> Automatic, AppearanceElements -> None,
ImageSize -> {max - split - d, fix}]
}},
{
List#
Dynamic[panel[[1]]#
Pane[expr1, ImageSize -> {fix, split - d},
ImageSizeAction -> "Scrollable", Scrollbars -> Automatic,
AppearanceElements -> None], TrackedSymbols :> {split}],
List#Deploy#EventHandler[
MouseAppearance[
Pane[Null, ImageSize -> {fix, d*2}, ImageMargins -> -1,
FrameMargins -> -1], "FrameTBResize"],
"MouseDown" :> (temp =
coord#MousePosition#"CellContentsAbsolute";
split =
If[Abs[temp - split] <= d \[And] 0 <= temp <= max, temp,
split]),
"MouseDragged" :> (temp =
coord#MousePosition#"CellContentsAbsolute";
split = If[0 <= temp <= max, temp, split])],
List#
Dynamic[panel[[2]]#
Pane[expr2, ImageSizeAction -> "Scrollable",
Scrollbars -> Automatic,
ImageSize -> {fix, max - split - d},
AppearanceElements -> None], TrackedSymbols :> {split}]
}
], Spacings -> {0, -.1}]
];
SplitPane[val_, arg___] /; NumberQ[val] :=
Module[{x = val}, SplitPane[Dynamic[x], arg]];
pos = 300;
SplitPane[
Dynamic[pos], {Manipulate[
Plot[Sin[x (1 + a x)], {x, 0, 6}], {a, 0, 2}],
Factorial[123]}, {500, 300}]
The key to generalizing to several panels was to refactor your code. In its present form, while very nice, it was mixing visualization / UI primitives and options with the split logic, and had lots of duplicate code. This made generalization hard. Here is the refactored version:
ClearAll[SplitPane];
Options[SplitPane] = {
Direction -> "Vertical", DividerWidth -> Automatic, Paneled -> True
};
SplitPane[opts___?OptionQ] := Module[{dummy}, SplitPane[Dynamic[dummy], opts]];
SplitPane[val_, opts___?OptionQ] := SplitPane[val, {"", ""}, opts];
SplitPane[val_, content_, opts___?OptionQ] :=
SplitPane[val, content, {100, 50}, opts];
SplitPane[sp_List, {cont__}, {maxX_, maxY_}, opts___?OptionQ] /;
Length[sp] == Length[Hold[cont]] - 1 :=
Module[{scrollablePane, dividerPane, onMouseDownCode, onMouseDraggedCode, dynPane,
gridArg, split, divider, panel},
With[{paneled = Paneled /. {opts} /. Options[SplitPane],len = Length[Hold[cont]]},
Which[
TrueQ[paneled ],
panel = Table[True, {len}],
MatchQ[paneled, {Repeated[(True | False), {len}]}],
panel = paneled,
True,
Message[SplitPane::badopt]; Return[$Failed, Module]
]
];
DynamicModule[{temp, dir, d, coord, max, fix, val},
{dir, d} = {Direction, DividerWidth}/.{opts}/.Options[SplitPane];
dir = dir /. {
Bottom | Top | "Vertical" -> "Vertical", _ -> "Horizontal"
};
d = d /. Automatic -> 2;
val = Clip[sp /. {_?NumberQ -> sp, _ -> maxX/2}, {0, maxX}];
{coord, max, fix} =
Switch[dir,
"Vertical",
{First, maxX, maxY},
"Horizontal",
{(max - Last[#]) &, maxY, maxX}
];
Do[split[i] = sp[[i]], {i, 1, Length[sp]}];
split[Length[sp] + 1] = max - Total[sp] - 2*d*Length[sp];
panel =
(# /. {
None | False -> Identity,
_ -> (Panel[#, ImageMargins -> 0,FrameMargins -> -1] &)
}) & /# panel;
scrollablePane[args___] :=
Pane[args, ImageSizeAction -> "Scrollable",
Scrollbars -> Automatic, AppearanceElements -> None];
dividerPane[size : {_, _}] :=
Pane[Null, ImageSize -> size, ImageMargins -> -1,FrameMargins -> -1];
onMouseDownCode[n_] :=
Module[{old},
temp = coord#MousePosition#"CellContentsAbsolute";
If[Abs[temp - split[n]] <= d \[And] 0 <= temp <= max,
old = split[n];
split[n] = temp-Sum[split[i], {i, n - 1}];
split[n + 1] += old - split[n];
]];
onMouseDraggedCode[n_] :=
Module[{old},
temp = coord#MousePosition#"CellContentsAbsolute";
If[0 <= temp <= max,
old = split[n];
split[n] = temp -Sum[split[i], {i, n - 1}];
split[n + 1] += old - split[n];
] ;
];
SetAttributes[dynPane, HoldFirst];
dynPane[expr_, n_, size_] :=
panel[[n]]#scrollablePane[expr, ImageSize -> size];
divider[n_, sizediv_, resizeType_] :=
Deploy#EventHandler[
MouseAppearance[dividerPane[sizediv], resizeType],
"MouseDown" :> onMouseDownCode[n],
"MouseDragged" :> onMouseDraggedCode[n]
];
SetAttributes[gridArg, HoldAll];
gridArg[{content__}, sizediv_, resizeType_, sizeF_] :=
Module[{myHold, len = Length[Hold[content]] },
SetAttributes[myHold, HoldAll];
List ## Map[
Dynamic,
Apply[Hold,
MapThread[Compose,
{
Range[len] /. {
len :>
Function[
exp,
myHold[dynPane[exp, len, sizeF[len]]],
HoldAll
],
n_Integer :>
Function[exp,
myHold[dynPane[exp, n, sizeF[n]],
divider[n, sizediv, resizeType]
],
HoldAll]
},
Unevaluated /# Unevaluated[{content}]
}] (* MapThread *)
] /. myHold[x__] :> x
] (* Map *)
]; (* Module *)
(* Output *)
Grid[
If[dir === "Vertical",
List# gridArg[{cont}, {d*2, fix},"FrameLRResize",{split[#] - d, fix} &],
(* else *)
List /# gridArg[{cont}, {fix, d*2},"FrameTBResize", {fix, split[#] - d} &]
],
Spacings -> {0, -.1}]]];
SplitPane[val_, arg___] /; NumberQ[val] :=
Module[{x = val}, SplitPane[Dynamic[x], arg]];
Here is how it may look:
SplitPane[{300, 300},
{
Manipulate[Plot[Sin[x (1 + a x)], {x, 0, 6}], {a, 0, 2}],
Factorial[123],
CompleteGraph[5]
}, {900, 300}]
Can't comment of performance problems you mentioned. Also, when you start dragging with the mouse, the real cursor position is often quite off with respect to the divider position. This is both for your and my versions, perhaps some more precise scaling is needed.
Just want to emphasize once again - generalization became only possible after I did the refactoring, to separate the splitting logic from the visualization-related things. As to the optimization, I also think that it will be much easier to attempt optimizing this version than the original one, for the same reasons.
EDIT
I hesitated a bit to add this note, but it must be mentioned that my solution above, while working, shows one practice which is considered bad by expert UI mma programmers. Namely, it uses Module- generated variables inside Dynamic inner to that Module (in particular, split in the code above, also various auxiliary functions). The reasons I used it are that I wasn't able to make this work with only DynamicModule- generated variables, plus Module- generated variables always worked for me before. However, please see the post by John Fultz in this MathGroup thread, where he states that this practice should be avoided.
Heavily building on Leonid's solution, here is my version. I've applied several changes, basically to make it easier to track dynamic size-changes and because I simply failed to internalize part of Leonid's code.
Changes made:
Removed DividerWidth option, now it cannot be set by user. It is not that important.
Maximum horizontal size (maxX in the posts above) was dropped as it is now calculated from the user specified panel-width values: w.
First argument (w, the main dynamic variable) saves the widths of panels explicitely instead of saving divider positions. Also, it was made to be a list (w[[n]]) instead of a function (as split[n] was in Leonid's version).
Added minimize/restore buttons to dividers.
Restricted divider movement: dividers can only be moved from their left to their right neigbour, no further movement is possible.
Fine tuned divider width, ImageMargins, FrameMargins, Spacings to allow zero-sized panes.
Problems still to deal with:
When minimizing/maximizing dividers, they should overlap left/rightmost ones. A LIFO stack of dividers would solve the problem of setting a divider to max, and than trying to change other dividers via their buttons. This might cause some problem, as they set back to previous states. The problem with stacking dividers is that it cannot be solved in Grid, or can only be solved with very specifically tuned negative Spacings. I think it does not worth dealing with.
Minor alignment issues when shrinking a panel to zero width/height. This I can live with.
ClearAll[SplitPane];
Options[SplitPane] = {Direction -> "Vertical", Paneled -> True};
SplitPane[opts___?OptionQ] :=
Module[{dummy = {200, 200}}, SplitPane[Dynamic[dummy], opts]];
SplitPane[val_, opts___?OptionQ] := SplitPane[val, {"", ""}, opts];
SplitPane[val_, content_, opts___?OptionQ] :=
SplitPane[val, content, Automatic, opts];
SplitPane[Dynamic[w_], cont_, s_, opts___?OptionQ] :=
DynamicModule[{
scrollPane, divPane, onMouseDownCode, onMouseDraggedCode, grid,
dir, panel, bg, coord, mouse, icon, sizeD, sizeB,
num, old, pos, origo, temp, max, prev, state, fix},
{dir, panel} = {Direction, Paneled} /. {opts} /. Options#SplitPane;
dir = dir /. {Bottom | Top | "Vertical" -> "Vertical", _ ->
"Horizontal"};
bg = panel /. {None | False -> GrayLevel#.9, _ -> None};
panel =
panel /. {None | False ->
None, _ -> {RGBColor[0.70588, 0.70588, 0.70588]}}; (*
Simulate Panel-like colors on the frame. *)
fix = s /. {Automatic -> If[dir === "Vertical", 300, 800]};
(* {coordinate function, mouse cursor, button icon, divider size,
button size} *)
{coord, mouse, icon, sizeD, sizeB} = Switch[dir,
"Vertical", {First,
"FrameLRResize", {"\[RightPointer]", "\[LeftPointer]"}, {5,
fix}, {5, 60}},
"Horizontal", {(max - Last##) &,
"FrameTBResize", {"\[DownPointer]", "\[UpPointer]"}, {fix,
7}, {60, 7}}
];
SetAttributes[{scrollPane, grid}, HoldAll];
(* Framed is required below becase otherwise the horizontal \
version of scrollPane cannot be set to zero height. *)
scrollPane[expr_, size_] :=
Framed[Pane[expr, Scrollbars -> Automatic,
AppearanceElements -> None, ImageSizeAction -> "Scrollable",
ImageMargins -> 0, FrameMargins -> 0, ImageSize -> size],
FrameStyle -> panel, ImageMargins -> 0, FrameMargins -> 0,
ImageSize -> size];
divPane[n_] :=
Deploy#EventHandler[MouseAppearance[Framed[
Item[Button[Dynamic#If[state[[n]], First#icon, Last#icon],
If[state[[n]], prev[[n]] = w;
w[[n]] = max - Sum[w[[i]], {i, n - 1}];
Do[w[[i]] = 0, {i, n + 1, num}]; state[[n]] = False;,
w = prev[[n]]; state[[n]] = True;]
, ContentPadding -> False, ImageSize -> sizeB,
FrameMargins -> 0, ImageMargins -> -1,
Appearance -> "Palette"], Alignment -> {Center, Center}]
, ImageSize -> sizeD, FrameStyle -> None, ImageMargins -> 0,
FrameMargins -> 0, Background -> bg], mouse],
"MouseDown" :> onMouseDownCode#n,
"MouseDragged" :> onMouseDraggedCode#n, PassEventsDown -> True];
onMouseDownCode[n_] := (
old = {w[[n]], w[[n + 1]]};
origo = coord#MousePosition#"CellContentsAbsolute";
);
onMouseDraggedCode[n_] := (
temp = coord#MousePosition#"CellContentsAbsolute" - origo;
w[[n]] = Min[Max[0, First#old + temp], Total#old];
w[[n + 1]] = Total#old - w[[n]];
);
(* Framed is required below because it gives the expression \
margins. Otherwise,
if the scrollPane is set with larger than 0 FrameMargins,
they cannot be shrinked to zero width. *)
grid[content_, size_] :=
Riffle[MapThread[
Dynamic[scrollPane[Framed[#1, FrameStyle -> None], size##2],
TrackedSymbols :> {w}] &, {content, Range#Length#w}],
Dynamic[divPane##, TrackedSymbols :> {w}] & /#
Range#((Length#w) - 1)];
Deploy#Grid[If[dir === "Vertical",
List#grid[cont, {w[[#]], fix} &],
List /# grid[cont, {fix, w[[#]]} &]
], Spacings -> {0, -.1},
ItemSize -> {{Table[0, {Length#w}]}, {Table[0, {Length#w}]}}],
Initialization :> (
(* w = width data list for all panels *)
(* m = number of panels *)
(* state = button states *)
(* prev = previous state of w *)
(* max = total width of all panels *)
num = Length#w; state = True & /# Range#num;
prev = w & /# Range#num; max = Total#w;)
];
SplitPane[val_,
arg___] /; (Head#val === List \[And] And ## (NumberQ /# val)) :=
Module[{x = val}, SplitPane[Dynamic#x, arg]];
Let's try a vertically splitted pane:
w = {200, 50, 100, 300};
SplitPane[
Dynamic#w, {Manipulate[Plot[Sin[x (1 + a x)], {x, 0, 6}], {a, 0, 2}],
Null, CompleteGraph[5], "121234"}]
Here is a horizontally splitted pane:
SplitPane[{50, 50, 50,
50}, {Manipulate[Plot[Sin[x (1 + a x)], {x, 0, 6}], {a, 0, 2},
ContentSize -> 300], Null, CompleteGraph[5], "121234"},
Direction -> "Horizontal"]
Vertical and horizontal panes combined:
xpane = {200, 300};
ypane = {200, 50};
SplitPane[Dynamic#xpane, {
Manipulate[Plot[Sin[x (1 + a x)], {x, 0, 6}], {a, 0, 2}],
Dynamic[
SplitPane[Dynamic#ypane, {CompleteGraph[5], "status"}, Last#xpane,
Paneled -> False, Direction -> "Horizontal"],
TrackedSymbols :> {xpane}]
}, 300, Direction -> "Vertical"]
I would like to hear your ideas/comments on this solution.