2D TogglerBar using a 2D (row,column) array of variable dimensions

Question

I want to make a 2D TogglerBar using a 2D (row, column) array of variable dimensions for Manipulate in DynamicModule. The purpose is to design a satellite constellation by picking the number of rings (RowDim) and number of satellites per ring (ColDim). And then to allow that only some of the satellites are operational for a specific task (hence the need of a 2DTogglerBar). I would then construct the constellation and show (on a flat earth) only the ground coverage of the operational satellites. Note that the ground coverage code is omitted. Here is my code so far.

 DynamicModule[
  {
   RowDim, ColDim,
   rcDim0, rDim0, cDim0,
   rMin, rMax,
   cMin, cMax,
   myArray, myArray0,
   myCorners,
   g1, g2, g3, g4,
   row01Values, row010, row01,
   row02Values, row020, row02,
   s1, s2, s3,
   myArray01, myArray02, myArray03, myArray04, myArray05,
   myArray06, myArray07, myArray08, myArray09, myArray10,
   MakeConstellation, satpos,
   rE, rad, alt, inc, walk, timesec, spreadD,
   t, r1, t1, t2, colors
   },

  (* Blank Graphics; *)
  myCorners = {{-180, -090}, {+180, +090}};

  (* Limits on rows & cols/row; *)
  {rMin, rMax} = {1, 10};
  {cMin, cMax} = {1, 20};

  (* Initial dimensions; *)
  rcDim0 = {rDim0 , cDim0} = {10, 20};

  (* Initial activity state; *)
  myArray0 = ConstantArray[0, rcDim0];

  myArray0[[01]] = {3, 5, 8, 9, 11};
  myArray0[[02]] = {};
  myArray0[[03]] = {1, 2, 3, 6, 11};
  myArray0[[04]] = {};
  myArray0[[05]] = {1, 2, 6, 7, 9, 10};
  myArray0[[06]] = {};
  myArray0[[07]] = {};
  myArray0[[08]] = {};
  myArray0[[09]] = {};
  myArray0[[10]] = {};

  MakeConstellation[rings_, sats_, alt_, incD_, walker_, time_, 
    rspreadD_] := Block[
    {
     Rx, Ry, Rz,
     re, err, dtr, gm, tp, cir, sp, dis, aR,
     rottime, angring, angsat, angwalker,
     \[CapitalDelta]\[Theta]R, \[Theta]Ic,
     RINGsT, RotWalker, RotEarth,
     ringrstw, RINGsRevolve, ringrstwi, ringrstwil,
     nR
     },

    Rx[a_] := {{1., 0., 0.}, {0., Cos[a], - Sin[a]}, {0., Sin[a], 
       Cos[a]}};
    Ry[a_] := {{Cos[a], 0., Sin[a]}, {0., 1., 0.}, {-1. Sin[a], 0., 
       Cos[a]}};
    Rz[a_] := {{Cos[a], -1. Sin[a], 0.}, {Sin[a], Cos[a], 0.}, {0., 0.,
        1.}};
    re = 6371.;
    err = 7.2921150*(10^(-5));(* 
    earth's rotation rate radians/(SI sec); *)
    dtr = Pi/180.;
    gm = 3.986005*10^5;(* earth's gravity const km^3/sec^2; *)
    tp = 2*Pi*Sqrt[(re + alt)^3/gm];(* period; *)
    cir = 2*Pi*(re + alt);(* circumference; *)
    sp = cir/tp;(* speed; *)
    dis = Mod[sp*time, cir];
    aR = dis/(re + alt);
    rottime = Ry[(-1)*dis];
    angring = rspreadD*dtr/rings;
    angsat = 2 Pi/sats;
    angwalker = walker*angsat/rings;
    RINGsT = (re + alt)*
      Table[rottime.{Cos[\[Theta]S], 0., Sin[\[Theta]S]}, {\[Theta]S, 
        0, 2 Pi, angsat}];
    RINGsT = Drop[RINGsT, -1];
    \[Theta]Ic = inc - Pi/2;
    RotWalker = Ry[-walker*angsat/rings];
    \[CapitalDelta]\[Theta]R = rspreadD*dtr/rings;
    RotEarth = Rz[(-1)*time*err];
    ringrstw = {RINGsT};
    RINGsRevolve = RINGsT;

    For[nR = 1, nR <= rings, nR = nR + 1,
     RINGsRevolve = (RotWalker).# & /@ RINGsRevolve;
     ringrstw = Append[ringrstw, RINGsRevolve];];

    ringrstwi = Chop@Map[(Rx[\[Theta]Ic].#) &, ringrstw, {2}];
    ringrstwil = {};

    For[nR = 1, nR <= rings, nR = nR + 1,
     RINGsRevolve = 
      RotEarth.Rz[(nR - 1)*\[CapitalDelta]\[Theta]R].# & /@ 
       ringrstwi[[nR]];
     ringrstwil = Append[ringrstwil, RINGsRevolve]];

    Return[ringrstwil];
    ];

  colors = {Red, Green, Blue, Orange, Cyan, Purple, Yellow, Brown, 
    Black, Magenta, Pink};
  r1 = rE/40;
  rE = 6371.;

  g1 = Graphics3D[{RGBColor[.4, .6, 1], Sphere[{0, 0, 0}, rE]}, 
    Lighting -> "Neutral", Boxed -> False, Background -> Black];
  g2 = Graphics[{RGBColor[.8, 1, .8], 
     EdgeForm[{Black, Thickness[0.01]}], 
     Rectangle[Sequence @@ myCorners]}];

  Manipulate[

   Dynamic[myArray = ConstantArray[Range[ColDim], RowDim]];

   {alt, inc, walk, timesec, spreadD} = {2000, 10, 3, t, 360};
   satpos = 
    MakeConstellation[RowDim, ColDim, alt, inc, walk, timesec, spreadD];

   t1 = Table[
     Map[{colors[[k]], Sphere[#, r1]} &, satpos[[k]]], {k, 1, RowDim}];
   g3 = Graphics3D[t1];
   t2 = MapThread[{#1, Line[Append[#2, #2[[1]]]]} &, {colors[[
       1 ;; RowDim]], satpos}];
   g4 = Graphics3D[t2];

   s1 = Show[{g1, g3, g4},
     ImageSize -> 200,
     ViewVector -> {10 rE {1, 0, 0}, {0, 0, 0}},
     ViewVertical -> {0, 0, 1},
     ViewAngle -> 1.5*2 ArcSin[1/10]];

   s2 = Show[{g2, 
      Graphics[
       Text["For ground coverage \n using a flat earth \nof the \
 operational satellites. \n(Omitted.)"]]}, ImageSize -> 300];

   s3 = Column[{s1, s2}, Alignment -> Center];

   Column[{s3,
     Style[
      "Plot the ground coverage \non a flat earth\nfor these \
 satellites:", Bold],
     Dynamic[myArray01 = Sort[myArray01]],
     Dynamic[myArray02 = Sort[myArray02]],
     Dynamic[myArray03 = Sort[myArray03]],
     Dynamic[myArray04 = Sort[myArray04]],
     Dynamic[myArray05 = Sort[myArray05]],
     Dynamic[myArray06 = Sort[myArray06]],
     Dynamic[myArray07 = Sort[myArray07]],
     Dynamic[myArray08 = Sort[myArray08]],
     Dynamic[myArray09 = Sort[myArray09]],
     Dynamic[myArray10 = Sort[myArray10]]
     }],

   Column[
    {
     Style["Select Array Dimensions {RowDim, ColDim}.", Bold],
     "",
     Row[{Control@{{RowDim, rDim0, 
          Style["RowDim: ", Bold, FontFamily -> "Courier New"]}, rMin, 
         rMax, 1, ControlType -> Setter}}],
     Row[{Control@{{ColDim, cDim0, 
          Style["ColDim: ", Bold, FontFamily -> "Courier New"]}, cMin, 
         cMax, 1, ControlType -> Setter}}],
     Control@{{t, 0, "Time (t): "}, 0, 24*60*60, 1, 
       AnimationRate -> 30},
     "",
     Style[StringJoin[ConstantArray["-", 60]], Black, 12],
     Style[
      "1. Adjust myArray to be dimensioned as {RowDim, ColDim}, and", 
      Bold],
     Style[
      "2. Show only the rows up to RowDim & only cols up to ColDim, \
 and", Bold],
     Style[
      "3. Use this information to draw only the coverage of the \
 satellites listed here.", Bold],
     Row[{Control[{{myArray01, myArray0[[01]], "Row 01: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray02, myArray0[[02]], "Row 02: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray03, myArray0[[03]], "Row 03: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray04, myArray0[[04]], "Row 04: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray05, myArray0[[05]], "Row 05: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray06, myArray0[[06]], "Row 06: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray07, myArray0[[07]], "Row 07: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray08, myArray0[[08]], "Row 08: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray09, myArray0[[09]], "Row 09: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     Row[{Control[{{myArray10, myArray0[[10]], "Row 10: "}, 
         Range[ColDim], ControlType -> TogglerBar}]}],
     ""
     }, Alignment -> Left],

   Delimiter,

   ControlPlacement -> Left
   ]
  ]

The 2DTogglerBar for dimensions = {6, 9} might look like this:

glS, I have this.

Clear[data, MaxRows, MaxCols, RowDim, ColDim, t, data, ConNum];

MaxRows = 10;
MaxCols = 15;

Manipulate[
 data = Map[Sort[#] &, data];
 MatrixForm@data[[1 ;; RowDim]],

 Column[
  {
   Style["Select Array Dimensions {RowDim, ColDim}.", Bold],
   Style[StringJoin@ConstantArray["-", 50], White],

   Row[{Control[{{RowDim, 06, 
        Style["RowDim: ", Bold, FontFamily -> "Courier New"]}, 
       Range[MaxRows], ControlType -> SetterBar}]}],
   Row[{Control[{{ColDim, 11, 
        Style["ColDim: ", Bold, FontFamily -> "Courier New"]}, 
       Range[MaxCols], ControlType -> SetterBar}]}],

   Row[{Style["Reset to All Operational: ", Bold], 
     Checkbox[Dynamic[cb02]]}],

   Style[StringJoin@ConstantArray["-", 50], White],
   Style["Select Operational Satellites.", Bold],
   Style[StringJoin@ConstantArray["-", 50], White]
   }
  ],

 Dynamic[Column[
   Table[data = 
     If[cb02 == True, ConstantArray[Range[ColDim], RowDim], 
      ConstantArray[{}, RowDim]];
    With[{k = k}, 
     Row[{Style["Ring " <> ToString[k] <> ": ", Bold], 
       TogglerBar[Dynamic[data[[k]]], Range[ColDim]]}]], {k, RowDim}],
    Dividers -> {All, All}]]
 ]

Any ideas on formatting according to the color scheme of the image?

Hi, is something wrong with this question that no one responds? — kmutiny, Oct 27 '16 at 18:37
You might consider editing your question to be more specific. Stating "Though it does not work" and "This doesn't work obviously" and "This is doing something weird" doesn't seem specific enough. Even a picture of the current output might garner more attention. — JimB, Oct 30 '16 at 20:31
so to be clear, you want the number of controls generated by your code to be editable with the upper control RowDim? — glS, Nov 01 '16 at 16:41

score 1 · Answer 1 · edited Apr 13 '17 at 12:55

1

From this answer on a similar (same?) problem (and the other in the same post) you can write a minimal example to implement such functionality:

Manipulate[
 data,
 {{data, RandomInteger[{1, 10}, 10]}, ControlType -> None},
 {{controlsNum, 2}, 1, 10, 1, Appearance -> "Labeled"},
 Dynamic[
  Column@Table[
    With[{k = k}, Slider[Dynamic[data[[k]]], {1, 10}]],
    {k, controlsNum}
    ]
  ]
 ]

The important points here are the use of Dynamic to dynamically change the number of controller when the value of controlsNum changes, and the use of Slider instead of Control because the former complains for the nonstandard input structure.

Can you adjust your code to replicate this structure?

edited Apr 13 '17 at 12:55

Community

1

answered Nov 01 '16 at 17:15

glS

7,623
1
21
61

I have this.

mxr = 10;
maxc = 15;
Manipulate[data, 
 Column[{Row[{Control[{{rd, 06, Style["Rows: ", Bold]}, Range[mxr], ControlType -> Set-ter}]}], 
   Row[{Control[{{cd, 11, Style["Cols: ", Bold]}, Range[maxc], ControlType -> Setter}]}]}], {{data, ConstantArray[{}, mxr]}, ControlType -> None}, Dynamic[Column[Table[With[{k = k}, TogglerBar[Dynamic[data[[k]]], Range[cd]]], {k,rd}]]]]

– kmutiny Nov 01 '16 at 23:17

How do I delete the previous comment? – kmutiny Nov 01 '16 at 23:27
@kmutiny you delete a comment clicking on the small x next to it – glS Nov 02 '16 at 15:10

2D TogglerBar using a 2D (row,column) array of variable dimensions

1 Answers1

Linked