How to maintain integer values in dynamically linked sliders? - wolfram-mathematica

I want to use a pair of sliders to set integer values for two variables nLo and nHi, each of which can individually range from 1 to 100, but subject to the restriction that nHi >= nLo. So I set up a slider for each variable that has a range that depends dynamically on the other variable:
nLo = 1; nHi = 100;
Column[
{
Labeled[Slider[Dynamic[nLo], {1, Dynamic[nHi], 1},
Appearance -> "Labeled"], "nLo", Left
],
Labeled[Slider[Dynamic[nHi], {Dynamic[nLo], 100, 1},
Appearance -> "Labeled"], "nHi", Left
],
Dynamic[{nLo, nHi}]
}
]
The problem is that as soon as I adjust nHi, its value becomes real (displays with a decimal point) rather than integer. I presume that this is because the slider for nHi can't tell that its first range argument Dynamic[nLo] is actually an integer and so it defaults to real values instead. Any suggestions as to how to force nHi to remain integer valued? (Linux Mathematica v8.0.1)

Alternatively you could do something like
nLo = 1; nHi = 100;
Column[{Labeled[
Slider[Dynamic[nLo], {1, Dynamic[nHi], 1},
Appearance -> "Labeled"], "nLo", Left],
Labeled[Slider[
Dynamic[nHi, (nHi = Round[#]) &], {Dynamic[nLo], 100, 1},
Appearance -> "Labeled"], "nHi", Left],
{Dynamic[nLo], Dynamic[nHi]}}]

Either I fail to understand the requirements of the solution, or this code may only function correctly in Mathematica 7.
Interesting problem. This appears to work:
nLo = 1; nHi = 100;
Column[{Labeled[
Slider[Dynamic[nLo], {1, Dynamic[nHi], 1},
Appearance -> "Labeled"], "nLo", Left],
Labeled[Slider[
Dynamic[nHi], {Dynamic[Unevaluated#Round#nLo], 100, 1},
Appearance -> "Labeled"], "nHi", Left],
Dynamic[{nLo, nHi}]}]

Related

slicing 3D plot and dynamic number of controls MATHEMATICA

I am going to have a n-dimensional function and I would like to able plot 2D planes for the rest of the variables fixed to a number. For example:
u = w^2 y^3 + x^5 z^4 + I z^6 + I z^2 Sin[y + x - 1]+k*Sin[w*pi]
I have 5 variables in here and lets assume I want to fix z w plane and plot with sliding y,z, and k. I have many issues to fix to get what I want to do,
1- As it is the code is not working. I need to figure out to update the limsL and limsR for the sliders. If I remove the doloop and the limits at least I dont get the RED error bar. I need to update those values maybe using a button to get all the data and second button to plot.
2- But even with default limits for sliders [0,1] I do not get a plot. The values are updated at the interface. Under varying variables but does not effect the u function. And actually I prefer variables stay as z,y,x etc and not to get numerical values.
Manipulate[DynamicModule[{u =
z Sin[\[Pi] x] + Cos[\[Pi] y] + y^6 Cos[2 \[Pi] y], vars = {x, y, z}, varlims = {{1, 2}, {3, 4}, {5, 6}}, poi = {x, y},
svars = {z, r}, data = Table[RandomReal[], {20}]}, Column[{Style["Ploter", "Function"],
Row[{"Function ", InputField[u]}, Spacer[20]],
Row[{"Variables ", InputField[Dynamic[vars]]}],
Row[{"Variable limits ", InputField[Dynamic[varlims]]}],
Row[{"Plane of interest", InputField[Dynamic[poi]]}],
Row[{"Varying variables", InputField[Dynamic[svars]]}],
Plotslices[u, vars, varlims, poi, svars, size],
Dynamic[
countersvar = Dimensions[svars][[1]];
limsL = ConstantArray[0, countersvar];
limsR = ConstantArray[0, countersvar];
Do[
v = svars[[i]];
posv = Position[vars, v][[1]];
lv = varlims[[posv, 1]][[1]];
rv = varlims[[posv, 2]][[1]];
limsL[[i]] = lv;
limsR[[i]] = rv;
, {i, countersvar}];
Grid[
Table[With[{i = i}, {svars[[i]],
Slider[Dynamic[svars[[i]], {limsL[[1]], limsR[[i]]}]],
Dynamic[svars[[i]]]}], {i, Dimensions[svars][[1]]}]]]
}]], {size, {Small, Medium, Full}}, ControlPlacement -> Bottom,ContinuousAction -> False, Initialization :> (
Plotslices[u_, vars_, varlims_, poi_, svars_, size_] :=
Module[{v1, v2, lv1, lv2, rv1, rv2, posv1, posv2},
v1 = poi[[1]];
v2 = poi[[2]];
posv1 = Position[vars, v1][[1]];
posv2 = Position[vars, v2][[1]];
lv1 = varlims[[posv1, 1]][[1]];
lv2 = varlims[[posv2, 1]][[1]];
rv1 = varlims[[posv1, 2]][[1]];
rv2 = varlims[[posv2, 2]][[1]];
psl =
Plot3D[u, {v1, lv1, rv1}, {v2, lv2, rv2},
PerformanceGoal -> "Quality", Mesh -> None,
ColorFunction -> Function[{v1, v2, z}, Hue[z]],
ImageSize -> size];
Return[psl];];
)
]
I am sorry for the formatting . I tried to put it together crtl+K but it did not work.

why is a wordcloud not generated in mathematica with this code?

data = EntityValue[CountryData[], {"Name", "Population"}];
WordCloud[data]
All I get is this:
WordCloud[{{"Afghanistan", Quantity[35623235, "People"]}, {"Albania",
Quantity[3248655, "People"]}, {"Algeria",
Quantity[37473690, "People"]}, {"American Samoa",
Quantity[54719, "People"]}, {"Andorra",
Quantity[85458, "People"]}, {"Angola", .....
And not any graphic
I was able to get a word cloud in version 10.0 by using Heike's code, but I had to remove the part concerning a custom distance function since it slows down this version unbelievably.
data = << "http://pastebin.com/raw/02YJ9Ntx";
range = {Min[data[[All, 2]]], Max[data[[All, 2]]]};
words = Style[#1, FontFamily -> "Times", FontWeight -> Bold,
FontColor ->
Hue[RandomReal[], RandomReal[{.5, 1}], RandomReal[{.5, 1}]],
FontSize -> Rescale[#2, range, {12, 70}]] & ### data;
wordsimg =
ImagePad[#, -3 -
BorderDimensions[#]] & /# (Image[
Graphics[Text[Framed[#, FrameMargins -> 2]]]] & /# words);
wordsimgRot =
ImageRotate[#, RandomReal[2 Pi], Background -> White] & /# wordsimg;
iteration2[img1_, w_] :=
Module[{imdil, centre, diff, dimw, padding, padded1, minpos},
dimw = ImageDimensions[w];
padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1];
imdil =
Binarize[
ImageCorrelate[Binarize[ColorNegate[padded1], 0.05],
Dilation[Binarize[ColorNegate[w], .05], 1]]];
centre = ImageDimensions[padded1]/2;
minpos =
Reverse#Nearest[Position[Reverse[ImageData[imdil]], 0],
Reverse[centre]][[1]];
Sow[minpos - centre];
diff = ImageDimensions[imdil] - dimw;
padding[pos_] := Transpose[{#, diff - #} &#Round[pos - dimw/2]];
ImagePad[#, (-Min[#] {1, 1}) & /# BorderDimensions[#]] &#
ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]]
Then you can get two different word clouds, with or without random rotations,
{Fold[iteration2, wordsimgRot[[1]], Rest#wordsimgRot],
Fold[iteration2, wordsimg[[1]], Rest#wordsimg]}
These compare quite well with what you get in version 10.3 with WordCloud[data]

How to fix the procedure

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.

solve rotationtransform

I have an issue with the reconstrution of a affine transformation matrix.
The translation matrix reconstructions works just fine, but not the rotation.
Thank you guys!
(*Works just fine*)
Clear["Global`*"]
data = RandomReal[10, {100, 3}];
data0 = TranslationTransform[{1, -1, 1}]#data;
{dX0, dY0, dZ0} /.
Solve[data0 == TranslationTransform[{dX0, dY0, dZ0}]#data, {dX0, dY0,
dZ0}]
(*Yields {} ????*)
Clear["Global`*"]
data = RandomReal[10, {10, 3}];
data0 = RotationTransform[10 , {1, 0, 0}]#data;
Solve[data0 == RotationTransform[aZ0 Degree, {0, 0, 1}]#data, {aZ0}]
You have too many equations for only one var.
data = RandomReal[1, {10, 3}];
data0 = RotationMatrix[1/2, {1, 0, 0}].# & /# data;
Solve[Thread[data[[1]] == RotationMatrix[aZ0, {1, 0, 0}].data0[[1]]][[2]], {aZ0}]
(*
-> -0.5
*)

Split pane gui object

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.

Resources