Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

[Date Index] [Thread Index] [Author Index]

Search the Archive

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
>
>
>



  • Prev by Date: Re: What should be a simple task....
  • Next by Date: Draw a 3D surface
  • Previous by thread: Generic nested menus implementation
  • Next by thread: Re: Generic nested menus implementation