1
$\begingroup$

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:

2D TogglerBar

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?

$\endgroup$
  • $\begingroup$ Hi, is something wrong with this question that no one responds? $\endgroup$ – kmutiny Oct 27 '16 at 18:37
  • $\begingroup$ 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. $\endgroup$ – JimB Oct 30 '16 at 20:31
  • $\begingroup$ so to be clear, you want the number of controls generated by your code to be editable with the upper control RowDim? $\endgroup$ – glS Nov 1 '16 at 16:41
  • $\begingroup$ Yes. And with ColDim. $\endgroup$ – kmutiny Nov 1 '16 at 16:47
  • 1
    $\begingroup$ did you see this answer? $\endgroup$ – glS Nov 1 '16 at 16:57
1
$\begingroup$

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?

$\endgroup$
  • $\begingroup$ 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}]]]] $\endgroup$ – kmutiny Nov 1 '16 at 23:17
  • $\begingroup$ How do I delete the previous comment? $\endgroup$ – kmutiny Nov 1 '16 at 23:27
  • $\begingroup$ @kmutiny you delete a comment clicking on the small x next to it $\endgroup$ – glS Nov 2 '16 at 15:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.