Re: Generic nested menus implementation
- To: mathgroup at smc.vnet.net
- Subject: [mg100659] Re: [mg100649] Generic nested menus implementation
- From: Leonid Shifrin <lshifr at gmail.com>
- Date: Wed, 10 Jun 2009 17:10:26 -0400 (EDT)
- References: <200906100934.FAA11783@smc.vnet.net>
Hi all,
a quick follow - up:
There is a bug in the function <localMaxPositions> that returns the
positions of the locally maximal numbers in a list. Here is a better (and
hopefully correct) version:
Clear[localMaxPositions];
localMaxPositions[lst_List] :=
Part[#, All, 2] &@
ReplaceList[
MapIndexed[List,
lst], {___, {x_, _}, y : {t_, _} .., {z_, _}, ___} /;
x < t && z < t :> y];
Sorry for this.
Regards,
Leonid
On Wed, Jun 10, 2009 at 2:34 AM, Leonid Shifrin <lshifr at gmail.com> wrote:
> Hi all,
>
> since already two people asked for this feature, and I got interested
> myself, I assume that this topic may be of general interest, and this is my
> reason to start a separate thread. Here I present my first attempt at
> generic multilevel menu implementation. The code is probably full of bugs,
> and also perhaps many parts could be done easier but I just did not figure
> it out, so I will appreciate any feedback. The examples of use follow.
>
>
>
> THE CODE
>
>
> -----------------------------------------------------------------------------------------------------------------------
>
> (* checking recursive pattern *)
>
> Clear[menuTreeValidQ];
> menuTreeValidQ[{_String, {___String}}] := True;
> menuTreeValidQ[item_] := MatchQ[item, {_String, {___?menuTreeValidQ} ..}];
>
> (* This can probably be done much better *)
>
> Clear[localMaxPositions];
> localMaxPositions[ls_List] :=
> Module[{n = 0, pos, part},
> pos = Position[part = Split[Partition[ls, 3, 1], Last[#1] == First[#2]
> &],
> x_ /; MatchQ[x, {{s_, t_, u_}} /; s <= t && u <= t] ||
> MatchQ[x, {{s_, t_, _}, ___, {_, u_, p_}} /; s <= t && u >= p]];
> List /@ Flatten[Fold[
> Function[{plist, num}, n++;
> Join[plist[[1 ;; n - 1]], Range[plist[[n]], plist[[n]] + num - 1],
> plist[[n + 1 ;;]] + num - 1]], pos, Length /@ Extract[part, pos]] +
>
> 1]];
>
>
> (* By leaves I here mean, for every branch, those with locally
> largest distance from the stem. Level would not do *)
>
> Clear[leafPositions];
> leafPositions[tree_] :=
> Extract[#, localMaxPositions[Length /@ #]] &@
> Reap[MapIndexed[Sow[#2] &, tree , Infinity]][[2, 1]];
>
>
> Clear[mapOnLeaves];
> mapOnLeaves[f_, tree_] := MapAt[f, tree, leafPositions[tree]];
>
>
> Clear[replaceByEvaluated];
> replaceByEvaluated[expr_, patt_] :=
> With[{pos = Position[expr, patt]},
> With[{newpos =
> Split[Sort[pos, Length[#1] > Length[#2] &],
> Length[#1] == Length[#2] &]},
> Fold[ReplacePart[#1, Extract[#1, #2], #2, List /@ Range[Length[#2]]] &,
> expr, newpos]]];
>
>
> (* converts initial string-based menu tree into more complex expression
> suitable for menu construction *)
>
> Clear[menuItemsConvertAlt];
> menuItemsConvertAlt[menuitemTree_, menuMakers : {(_Symbol | _Function) ..},
> actionF_, representF_: (# &), representLeavesF_: (# &)] :=
> Module[{g, actionAdded, interm, maxdepth, actF},
> actionAdded =
> mapOnLeaves[If[# === {}, Sequence @@ #, representLeavesF[#] :> actF[#]]
> &,
> menuitemTree];
> interm =
> MapIndexed[
> Replace[#, {x_String, y : ({({_RuleDelayed} | _RuleDelayed) ..})} :>
> representF[x, {Length[#2]/2}] :> g[Length[#2]/2][x, Flatten@y],
> 1] &, {actionAdded}, Infinity];
> interm =
> Fold[replaceByEvaluated,
> interm, {_Replace, HoldPattern[# &[__]], HoldPattern[Length[{___}]],
> HoldPattern[Times[_Integer, Power[_Integer, -1]]], _Flatten}][[1, 2]];
> maxdepth = Max[Cases[interm, g[x_] :> x, Infinity, Heads -> True]];
> With[{fns = menuMakers},
> replaceByEvaluated[interm /. g[n_Integer] :> menuMakers[[n]],
> HoldPattern[fns[[_Integer]]]] /. actF :> actionF
> ] /; maxdepth <= Length[menuMakers]]
>
>
> (* main menu-building function *)
>
> Clear[createNestedMenu];
> createNestedMenu::invld = "The supplied menu tree structure is not valid";
>
> createNestedMenu[menuItemTree_, ___] /; Not[menuTreeValidQ[menuItemTree]]
> :=
>
> "never happens" /; Message[createNestedMenu::invld];
>
> createNestedMenu[menuItemTree_?menuTreeValidQ, menuCategories_, actionF_,
> representF_: (# &), representLeavesF_: (# &)] :=
>
> Module[
> {menuVars, menuNames, menuDepth = Depth[Last@menuItemTree]/2,
> setHeld, setDelayedHeld, heldPart, subBack, subBackAll, makeSubmenu,
> addSpaces, menuCategs = menuCategories, standardCategory = " Choose
> "},
>
> Options[makeSubmenu] = {Appearance -> "Button",
> FieldSize -> {{1, 8}, {1, 4}}, Background -> Lighter[Yellow, 0.8],
> BaseStyle -> {FontFamily -> "Helvetica", FontColor -> Brown,
> FontWeight -> Plain}};
>
> menuCategs = PadRight[menuCategs, menuDepth + 1, standardCategory];
>
> (* Make variables to store menu names and values *)
> Block[{var, name}, {menuVars, menuNames} =
> Apply[ Hold, Evaluate[Table[Unique[#], {menuDepth}]]] & /@ {var,
> name}];
>
> (* Functions to set/extract held variables *)
> setHeld[Hold[var_], rhs_] := var = rhs;
> setDelayedHeld[Hold[var_], rhs_] := var := rhs;
> heldPart[seq_Hold, n_] := First[Extract[seq, {{n}}, Hold]];
>
> (* Functions to close the given menu/submenus*)
> subBack[depth_Integer] :=
> (If[depth =!= menuDepth + 1, setHeld[heldPart[menuVars, depth], ""]];
> setHeld[heldPart[menuNames, depth - 1], menuCategs[[depth - 1]]]);
> subBackAll[depth_Integer] := subBack /@ Range[menuDepth + 1, depth, -1];
>
> (* Function to create a (sub)menu at a given level *)
> makeSubmenu[depth_] :=
> Function[{nm, actions},
> subBackAll[depth + 1];(* remove lower menus if they are open *)
> If[depth =!= 1, setHeld[heldPart[menuNames, depth - 1], nm]];
> setDelayedHeld[heldPart[menuVars, depth],
> Dynamic@
> ActionMenu[menuNames[[depth]],
> If[depth === 1, actions,
> Prepend[actions, "Back" :> subBackAll[depth]]], AutoAction -> True,
>
> Sequence @@ Options[makeSubmenu]]]];
>
> (* Function to help with a layout *)
> addSpaces[x_List, spaceLength : (_Integer?Positive) : 10] :=
> With[{space = StringJoin @@ Table[" ", {spaceLength}]},
> MapIndexed[ReplacePart[Table[space, {Length[x]}], ##] &, x]];
>
> (* Initialization code *)
> subBackAll[2];
> menuItemsConvertAlt[
> {menuNames[[1]], {menuItemTree}}, makeSubmenu /@ Range[menuDepth],
> actionF, representF, representLeavesF][[1, 2]];
>
> (* Display the menus *)
> Dynamic[
> Function[Null,
> Grid[addSpaces[{##}, 5], Frame -> True, FrameStyle -> Thick,
> Background -> Lighter[Pink, 0.8]], HoldAll] @@ menuVars]
> ]; (* End Module *)
>
>
>
> -----------------------------------------------------------------------------------------------------------
>
> EXAMPLES and explanation
>
> So, the input for a menu should be a tree structure like this:
>
> In[1] = menuItems =
>
> {"Continents", {{"Africa", {{"Algeria", {"Algiers",
> "Oran"}}, {"Angola", {"Luanda",
> "Huambo"}}}}, {"North America", {{"United States", {"New \
> York", "Washington"}}, {"Canada", {"Toronto", "Montreal"}}}}}};
>
> The root of the tree ("Continents" in this case) is not used later (but
> needed for consistency), so can be any string.
> The second necessary ingredient is a list of categories (strings) of the
> length equal to the depth of the menu to be constructed, or less (in which
> case some subcategories will be shown with a standard header "Choose"). The
> last mandatory ingredient is a function representing the action to be taken
> upon clicking on the lowest-level menu item (leaf).
>
> This is how we create the menu:
>
> In[1] = createNestedMenu[menuItems, {"Continent", " Country ", " City
> "}, Print]
>
> In this case, all categories are given explicilty, and when we click on an
> "atomic" menu element (not representing further menu sub-levels), it is
> printed. You can also omit some sub-categories, they will be substituted by
> "Choose"
>
> In[2] = createNestedMenu[menuItems, {"Continent"}, Print]
>
> There are additional optional parameters, which allow us to represent
> different submenu items in different way - functions
> representF and representLeavesF. The first one governs the appearance of
> the non-atomic submenu elements and takes the level of a submenu as a
> second
> argument. The second governs the appearance of atomic menu elements
> (leaves). For example:
>
> In[3] =
> createNestedMenu[menuItems, {"Continent", " Country ",
> " City "}, Print, (Style[#, FontColor ->
> Switch[#2, {1}, Brown, {2}, Blue, {3}, Green, _True,
> Orange], #]) &, Style[#, Red] &]
>
> I went through some pains to ensure that the menu will work also on less
> regular menu trees, where leaves may have different distance from the stem,
> like here:
>
> In[4] =
> menuTreeValidQ@
> (compMenuItems = {"Company",
> {{"Services",
> {"Training", "Development"}},
> {"Products",
> {{"OS tools", {}},
> {"Application software", {}}
> }},
> {"News",
> {{"Press releases", {}},
> {"Media coverage", {}}
> }},
> {"Company",
> {{"Vacancies", {{"Developer", {"Requirements"}}, {"Tester",
> {}}}},
> {"Structure", {}}}
> }
> }})
>
> Out[4] = True
>
>
>
> We create the menu as before:
>
> In[5] = createNestedMenu[compMenuItems, {"Main"}, Print]
>
> where I omitted sub-categories.
>
> Notice that the syntax I chose is such that, whenever the submenu contains
> only atomic elements, they can either all be represented by just strings,
> or
> wrapped in lists as {element,{}}, but not mixed. But if menu contains a mix
> of atomic and non-atomic elements, atomic elements must be wrapped in lists
> as above. For example, the more "politically correct"
> way to represent the first example structrure is this:
>
> {"Continents", {{"Africa", {{"Algeria", {{"Algiers", {}}, {"Oran", \
> {}}}}, {"Angola", {{"Luanda", {}}, {"Huambo", {}}}}}}, {"North \
> America", {{"United States", {{"New York", {}}, {"Washington", {}}}}, \
> {"Canada", {{"Toronto", {}}, {"Montreal", {}}}}}}}}
>
> The menuTreeValidQ predicate can be used to test if the structure is valid
> or not.
>
> Hope that I don't waste everyone's time and bandwidth.
> All feedback is greatly appreciated.
>
> Regards,
> Leonid
>
>
>
- References:
- Generic nested menus implementation
- From: Leonid Shifrin <lshifr@gmail.com>
- Generic nested menus implementation