Skip to main content

list manipulation - VoronoiMesh as a TogglerBar



Is it possible to use a VoronoiMesh to define a TogglerBar or SetterBar type Control?


For example, I can customise the looks of a TogglerBar


Control[{{a, 0, ""},
{1 -> Spacer[{.1, .1}], 4 -> Spacer[{.1, 20}],
7 -> Spacer[{.1, .1}], 2 -> Spacer[{20, .1}],
5 -> Spacer[{20, 20}], 8 -> Spacer[{20, .1}],
3 -> Spacer[{.1, .1}], 6 -> Spacer[{.1, 20}],
9 -> Spacer[{.1, .1}]},
Appearance -> "Vertical" -> {3, 3}, ControlType -> TogglerBar}]


enter image description here


But this doesn't change the rectangle-shaped buttons and I don't think this is the way to go about if I want to define a VoronoiMesh with clickable and "toggleable" cells.


I want something like


enter image description here


where each cell is selected/unselected whenever I click it, adding/removing a correspondent number to a list, for example, in the case of a TogglerBar. I would like this to also work as a SetterBar.


Any ideas?


Edit 1: Thank you all for your answers. As a follow up, I'm now interested in developing a TogglerBar-type object that allows users to hold and drag the mouse to select/deselect several cells. If you have time, please take a look at it, I'm a bit a clueless on how to do this, so any hint or idea is welcome.


Edit 2: Following Lukas Lang's answer below, I also tried to vary the grid size in Manipulate


Manipulate[x,
Control[{n, 2, 10, 1}],

Control[{{x, 3, ""},
MeshSetterBar[VoronoiMesh@RandomReal[{0, 1}, {n, 2}]]}]]

However, this doesn't seem to behave as expected. Instead, I get


enter image description here


Any idea why, and how to fix this? I tried Dynamic, but didn't work.


Edit 3: As a third and (hopefully) final edit, thanks to Lukas Lang's answer, I was able to solve the original question. Now I just need to define several toggler-type meshes of the same shape. One naive attempt is simply


Manipulate[Null, Dynamic@Grid[{
{Control[{n, 2, 10, 1}]},
{Control[{{x, {}, ""},

MeshTogglerBar[VoronoiMesh@RandomReal[{0, 1}, {n, 2}]]}]},
{Control[{{y, {}, ""},
MeshTogglerBar[VoronoiMesh@RandomReal[{0, 1}, {n, 2}]]}]}
}]]

enter image description here


Which naturally doesn't yield meshes with the same shape, due to the randomness in defining the points. How can I solve this? I have tried to define the mesh outside, then I lose the dynamic update of the mesh-dependent control. I would like something like the following, where I'm able to independently update similarly shaped meshes


enter image description here



Answer



Here are implementations for a MeshTogglerBar and MeshSetterBar based on my answer here (code below). Both implementations use Mouseover and EventHandler to handle detection of the polygon below the cursor for you. Compared to the NearestFunction approach, this is far more performant (since it is done by the front-end), it also works nicely for other types of meshes, where the cell below the cursor is not necessarily the one with the closest center.



TogglerBar


TogglerBar


SetterBar


SetterBar



MeshTogglerBar[mesh_] := iMeshTogglerBar[#, mesh] &
Dynamic[MeshTogglerBar[mesh_]] ^:=
Dynamic[iMeshTogglerBar[#, mesh] &]
MeshTogglerBar[Dynamic@var_, mesh_] :=
iMeshTogglerBar[Dynamic@var, mesh]

iMeshTogglerBar[Dynamic@var_, mesh_] := Module[
{prims = MeshPrimitives[mesh, 2]},
With[
{
active =
Append[dragAction]@Table[Unique["active"], Length@prims],
n = Length@prims
},
DynamicModule[
active,

Graphics[
{
FaceForm@White, EdgeForm@Blue,
MapIndexed[
With[
{v = active[[#2[[1]]]]},
EventHandler[
Style[
Annotation[#, ""],
TagBoxOptions -> {

BaseStyle -> FEPrivate`Which[
FEPrivate`SameQ[v, True],
{Lighter@Blue, EdgeForm@{Thick, Blue}},
FrontEnd`CurrentValue@"MouseOver",
LightBlue,
True,
{}
]
}
],

{
"MouseEntered" :> FEPrivate`If[
FEPrivate`And[
FrontEnd`CurrentValue[{"MouseButtonTest", 1}],
FEPrivate`UnsameQ[v, dragAction]
],
FEPrivate`Set[v, dragAction];
var[[#2[[1]]]] = dragAction
],
{"MouseDown", 1} :> (

FEPrivate`Set[dragAction, FEPrivate`UnsameQ[v, True]];
FEPrivate`Set[v, dragAction];
var[[#2[[1]]]] = dragAction
)
}
]
] &,
prims
]
},

ImageSize -> Medium
],
Initialization :> (
If[ListQ@var,
var = TrueQ /@ PadLeft[var, n, False],
var = ConstantArray[False, n]
];
MapThread[Set, {Most@active, var}]
)
]

]
]

MeshSetterBar[mesh_] := iMeshSetterBar[#, mesh] &
Dynamic[MeshSetterBar[mesh_]] ^:= Dynamic[iMeshSetterBar[#, mesh] &]
MeshSetterBar[Dynamic@var_, mesh_] := iMeshSetterBar[Dynamic@var, mesh]
iMeshSetterBar[Dynamic@var_, mesh_] :=
DynamicModule[
{active},
Graphics[

{
FaceForm@White,
EdgeForm@Blue,
MapIndexed[
EventHandler[
Style[
Annotation[#, ""],
TagBoxOptions -> {
BaseStyle -> FEPrivate`Which[
FEPrivate`SameQ[active, #2[[1]]],

{Lighter@Blue, EdgeForm@{Thick, Blue}},
FrontEnd`CurrentValue@"MouseOver",
LightBlue,
True,
{}
]
}
],
{"MouseClicked" :> (
FEPrivate`Set[active, #2[[1]]]; var = #2[[1]]

)
}
] &,
MeshPrimitives[mesh, 2]
]
},
ImageSize -> Medium
],
Initialization :> (active =var)
]


SeedRandom[1]

mesh = VoronoiMesh@RandomReal[{0, 1}, {10, 2}]

Dynamic@x

MeshSetterBar[Dynamic@x, mesh]

Dynamic@x


MeshTogglerBar[Dynamic@x, mesh]

Notes


Some notes on the implementation (you can find some more in my answer linked above):



  • Since everything is handled by the front-end, these controls will have excellent performance

  • For the MeshTogglerBar, we have to generate a list of state variables (one per cell). This is because the front-end cannot manipulate lists, so each cell needs a separate variable

  • The default values of the state variables are set in the Initialization property of the DynamicModule to ensure that the values are not prematurely inserted anywhere.

  • The dynamic styling is done via TagBoxOptions -> {BaseStyle -> {...}}. This is done since we need to set the styles via an option for the front-end-only solution to work. The Annotation[...]/TagBoxOptions trick is to ensure that any type of primitive is styled, not only Polygons.


  • The controlled variables are kept separate from the DynamicModule variables used to store the state of the control. This ensures that the front-end ↔ kernel communication is kept to a minimum (i.e. only when a click has happened is the kernel variable updated).

  • For the MeshTogglerBar, we trigger on both "MouseEntered" and "MouseDown" to enable dragging over many elements to toggle them. The state of the first element is stored in dragAction, to ensure that dragging sets all elements to the same state instead of toggling them back and forth


  • The iMeshTogglerBar/iMeshSetterBar functions are there so the control can be easily used inside Manipulate:


    Manipulate[
    x,
    {{x, 3}, MeshSetterBar[mesh]}
    ]



  • Similarly, the Dynamic[MeshSetterBar[_]]/Dynamic[MeshTogglerBar[_]] type definitions are to ensure that the controls work inside of Manipulate when the controls depend on other variables:


    Manipulate[x,
    {n, 2, 10, 1},
    {{x, 3, ""}, MeshSetterBar[VoronoiMesh@RandomReal[{0, 1}, {n, 2}]]}
    ]

    The additional definition is necessary, since Manipulate wraps control specifications in Dynamic if any other manipulate variables occur in the specifications. This prevents Manipulator from seeing the Function expression, since it is not evaluated. The additional upvalue forces evaluation into something with an explicit Function in those cases.




Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...