6
$\begingroup$

I would like to create an interactive grid, whereby one number from a grid is selected by the cursor ("3" in the example below), and all other numbers in the grid are highlighted that are related to the chosen number, and each successive number after that. In the example below, "3" is the selected number, and the highlighted numbers are double the previous one.

I am not sure whether a loop, or a direct function (in this case, clearly multiplying by powers of 2) would be the best approach - I assume the function-apply approach would be the quickest for large grids.

Below is an example:

enter image description here

generated with:

m = 10;(*size of the grid*)

premade = Transpose@Partition[Range@100, m];

col[n_] := Table[{n - 0.5, i - 0.5}, {i, 1, m}]

Graphics[{  
  {Red, Opacity[0.3], Rectangle[{0, 2}, {01, 3}]},
  {Red, Opacity[0.3], Rectangle[{0, 5}, {01, 6}]},
  {Red, Opacity[0.3], Rectangle[{1, 1}, {02, 2}]},
  {Red, Opacity[0.3], Rectangle[{2, 3}, {03, 4}]},
  {Red, Opacity[0.3], Rectangle[{4, 7}, {05, 8}]},
  {Red, Opacity[0.3], Rectangle[{9, 5}, {10, 6}]},

  Table[Text[Style[premade[[#, i]], Large, FontFamily -> "Times"],col[i][[#]]] & 
    /@ Range@m, {i, 1, m}]}, 
    GridLines -> {Range@m, Range@m}, PlotRange -> {{0, m}, {0, m}}, 
    Axes -> False, Frame -> True, 
    GridLinesStyle -> Directive[GrayLevel[0.8], Dashed]]

NOTE: All columns will be separate lists.

$\endgroup$
6
  • $\begingroup$ Are you aware of Dynamic[], Manipulate[] and friends? $\endgroup$ Commented Nov 21, 2013 at 12:54
  • $\begingroup$ @ belisarius, Yes, but unsure of how to progress from here in terms of searching through all lists as one set of data, mapping data to coordinates, etc. $\endgroup$
    – martin
    Commented Nov 21, 2013 at 13:02
  • 1
    $\begingroup$ Related mathematica.stackexchange.com/questions/31535/… $\endgroup$
    – DavidC
    Commented Nov 21, 2013 at 16:03
  • $\begingroup$ @ David Carraher, huh! I wouldn't have thought to look under sieve related questions! Very interesting link :) $\endgroup$
    – martin
    Commented Nov 21, 2013 at 18:15
  • $\begingroup$ Yes. Sometimes connections appear in the strangest of places. $\endgroup$
    – DavidC
    Commented Nov 21, 2013 at 18:25

2 Answers 2

7
$\begingroup$

Here is what I would propose related to the use of Graphics:

DynamicModule[{color = Red, m = 10, premade, col, posnum, posFriends, 
  unSortedPos, posMouse = {0, 0}, positionColor = {{0, 0}}},
 (*Initialization code*)
 premade = Transpose@Partition[Range@(m*m), m];
 col[n_] := Table[{n - 0.5, i - 0.5}, {i, 1, m}];

 EventHandler[
  Graphics[
   {
     Dynamic@{[email protected], Red, Rectangle /@ positionColor},
     Table[Text[Style[premade[[#, i]], Large, FontFamily -> "Times"], 
           col[i][[#]]] & /@ Range@m, {i, 1, m}]
   }, 
   GridLines -> {Range@m, Range@m}, PlotRange -> {{0, m}, {0, m}}, Axes -> False, 
   Frame -> True, GridLinesStyle -> Directive[GrayLevel[0.8], Dashed], ImageSize -> 350], 

 {"MouseDown" :> (posMouse = Floor[MousePosition["Graphics", Graphics], 1]; 
  posFriends[premade, posnum@premade];)}],

 Initialization :> 
 (
  posFriends[list_, start_] :=
   (unSortedPos = (# - {1, 1} & /@ 
    Flatten[Position[list, #]&/@ Select[Table[start*2^(i-1), {i, 1, 10}], # <= m*m&], 1]);
    positionColor = Reverse@unSortedPos[[#]] & /@ Range@Length@unSortedPos;
   );
  posnum[list_] := list[[Last@posMouse + 1, First@posMouse + 1]];
 )
]

enter image description here

$\endgroup$
3
  • $\begingroup$ @ Öskå, perfect! Thank you so much for the time you spent on this! :) $\endgroup$
    – martin
    Commented Nov 21, 2013 at 16:31
  • $\begingroup$ If I could give more than +1, I would :) - very grateful! $\endgroup$
    – martin
    Commented Nov 21, 2013 at 16:37
  • 1
    $\begingroup$ You are very welcome, I'm glad I could help :) $\endgroup$
    – Öskå
    Commented Nov 21, 2013 at 16:46
6
$\begingroup$

This colors based upon a divisibility criteria:

DynamicModule[{x = 11}, 
 Grid@Map[Button[ToString@#, x = #, 
                 Background -> Dynamic[If[Divisible[#, x], Green, Red]], 
                 ImageSize -> 30] &, RandomInteger[{1, 10}, {5, 5}], {2}]]

Mathematica graphics

Edit

If you want it less "buttonlike" and more "gridlike":

DynamicModule[{x = 11}, 
 Grid[Map[Button[ToString@#, x = #, 
                 Background -> Dynamic[If[Divisible[#, x], Green, Red]], 
                 ImageSize -> {40, 40}, Appearance -> "Frameless"] &, 
          RandomInteger[{1, 10}, {5, 5}], {2}], 
     Frame -> All, FrameStyle -> Dashed, Spacings -> {.2, .2}]]

enter image description here

$\endgroup$
3
  • $\begingroup$ @ belisarius, this is great :) I will have a play with it - I would ideally like to keep the same format as above as I would like to overlay another plot on top of it - is this possible? $\endgroup$
    – martin
    Commented Nov 21, 2013 at 13:30
  • 1
    $\begingroup$ @martin Plot[Sin[x], {x, 0, 1}, Epilog -> Inset@DynamicModule[{x = 11}, Grid@Map[ Button[ToString@#, x = #, Background -> Dynamic[If[Divisible[#, x], Green, Red]], ImageSize -> 30, Appearance -> "Frameless"] &, RandomInteger[{1, 10}, {5, 5}], {2}]]] $\endgroup$ Commented Nov 21, 2013 at 13:35
  • $\begingroup$ @ belisarius, thank you very much for your edit - this is closer to what I am after :) $\endgroup$
    – martin
    Commented Nov 21, 2013 at 16:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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