How to copy a label underneath two graphics with the graphics?

Questions
,
1

I made a code of the following;

(* for writing the variables in the bottom *)
label = StringTemplate["`1` leaves `2` periods `3` loop(s) `4` crossings by S.N."]
          [nn, ln, lop, nn (ln - 1)];
Framed@Labeled[ Grid[List@{ Show[ 
      		If[lop == 1, {plm, p21, par}, {}], 
      		If[lop == 2, {plm, p21, p22, par, par2}, {}],
      		If[lop >= 3, {plm, p21, p22, p23, par, par2, par3}, {}] 
      		 ], klm}],
       Style[label, Blue, Bold, 18],  Bottom]

(* here “lop” is the number of loops, “plm, p21, p22, p23, par, par2, and par3” are parts
of a Torus Knot graphic in the left, and “klm” is a graphic of Kolam pattern in the right*)
The graphic areas inside the red lines are able to be copied in the right mouse menu,
However these labels could not be copied with the graphics.
I want to copy them with the graphics using Mouse right menu “copy the graphic” inside of a red line area.
I would like to all the graphics with the labels be copied in the frame.
Would Anyone support a code,
How to write the common variables which can been copied with the graphics?

2

http://demonstrations.wolfram.com/KnotPatternSimilarToALotusKolam/

4972an01.png
4972an01.png291×283 19.1 KB

3

Hello! Simon Cadrin.
The demo posted by you is the first trial version for comparing Lotus Kolam with Torus Knot contributed by me.
I am submitting an advanced version in such points that animations of lengthening
the Kolam and Knot are synchronous, a multi-loop condition is plotted in the graphics with color lines,
and even when the periods are odd, the leave shapes are symmetry like Michelangelo’s form etc.

I would like to write variables of the condition and result in the plotting area and to copy them with the graphics.

enter code herecaptn = Graphics[ ImageSize -> {380, 20}, PlotLabel -> Style[Row[{"", nn, " leaves, ", ln, " periods, ", lop, If[lop == 1, " loop, ", " loops, "], nn*(ln - 1), " crossings S.N."}], FontSize -> 18, Blue] ]; Grid[ List@{ Show[ If[lop == 1, {plm, p21, par}, {}], If[lop == 2, {plm, p21, p22, par, par2}, {}], If[lop >= 3, {plm, p21, p22, p23, par, par2, par3}, {}] ], klm} ] (*endof Show, List, Grid *) captn (* is not located underneath the graphics, why not? *) ’

In this code, the variables “captn” are written in the upper side, and in an image area.
I would like to write them underneath the graphics. Would you teach me how to code it?
Thanks you
`

4

Hi Nagata Hannya.

It is always easier if you post all the code necessary to reproduce your problem or question.
That being said, if I understand you correctly, you have two problems, you want to put the label under your grid and you want to make it so that the whole image can be copied as one.

The first problem could be solved by using the Labeled[expr,lbl,pos] function. Your grid is the expression, the caption is the label and pos should be “Bottom” if you want it to be placed under your grid. Bottom is the default for Labeled so actually you don’t have to specify a position.

Your second question is trickier and I’m sure someone else has a better suggestion than this but you could always Rasterize the complete image. This would combine your graphics with your text and allow it to be copied together (although the graphics would no longer be vectors, which could be a deal-breaker, depending on what you want to use it for) .

i = 0
Dynamic@Rasterize@Labeled[
   Graphics[{
     Thick, Green, Rectangle[{0, -1}, {2, 1}], ColorData[1][i], 
     Disk[], Blue, Circle[{2, 0}], Yellow, 
     Polygon[{{2, 0}, {4, 1}, {4, -1}}], Purple, Arrowheads[Large], 
     Arrow[{{4, 3/2}, {0, 3/2}, {0, 0}}], Black, Dashed, 
     Line[{{-1, 0}, {4, 0}}]}],
   Style["Color Index: " <> ToString[i], FontColor -> ColorData[1][i]]]
Slider[Dynamic[i], {0, 15, 1}]
5

Dear Patrik Ekenberg-san Thank you very much for your advices. your pointings were correct.
I tried many codes from your sample. Finally I got the following;

(* common variable labels *)
captn = Graphics[      
ImageSize -> {380, 20},(* SphericalRegion\[Rule] True,*)
PlotLabel -> 
Style[Row[{nn, " leaves, ", ln, " periods, ", lop, 
If[lop == 1, " loop, ", " loops, "], nn*(ln - 1), 
" crossings     S.N."}], FontSize -> 18, Blue]
];
(* display all left, right two graphics and common variables*)  
Framed@Labeled[
Grid[ List@{  Show[ 
		If[lop == 1, {plm, p21, par}, {}], (* left graph of Torus Knot*)
		If[lop == 2, {plm, p21, p22, par, par2}, {}],
		If[lop >= 3, {plm, p21, p22, p23, par, par2, par3}, {}] 
		 ], klm} ] ,  (* right graph of Lotus Kolam *)   (* end of Show, List, Grid *)
Style[captn], Bottom ]  (* end of Framed@Labeled *)  
] , (* end of Module *)

I could not change two plottings(graphs ) to one graph, as the size of each of which were too large.
I could not make your Style[ “variable name” <> ToString[ multi-variable] ],
and I could not make it as an image and located it at the bottom.
I modified the code to the attached code. Thank you very much. Nagata,

6

additional post by Nagata,

My code makes three graphics, the third one is only 4 variable-labels underneath the graphics.
and I copy each graphic as an image using the Mouse right menu (copy the graphic) and
combine them to one image using another painting software. Thank all. Nagata

7

You can save the entire graphic, including the label, by selecting the cell (click on the cell bar at the very right), then right-clicking to get a menu, and then using Save Graphic As. This works even without rasterizing. You can also Export the graphic and get the same result. I don’t know of a method to select the entire graphic with the mouse.

8

Dear David Keith -san
Thank you very much for teaching the nice method to copy (get) an entire image as a cell of the graphics
including any messages and manipulation bars once operation.

9

Dear Patrik Ekenberg-san and David Keith-san
I found the original code in this discussion was good for copying (getting) an entire image including any messages and manipulation bars on one operation of cell-copy of a graphic-cell.
thanks again Nagata,

10

Dear All
the previous message “the original code was correct” was not correct.
As the code

label = StringTemplate["`1` leaves `2` periods `3` loop(s) `4` crossings by S.N."]
          [nn, ln, lop, nn (ln - 1)];

can not change automatically a singular or plural form of the unit “loop”, like the following.

captn = Graphics[      
ImageSize -> {380, 20},
PlotLabel -> Style[Row[{nn, " leaves, ", ln, " periods, ", lop, If[ lop == 1, " loop, ", " loops, "], nn(ln - 1), 
" crossings     S.N."}], FontSize -> 18, Blue]   ];

I return to the previous code again of the label (caption) as a label of a Graphic..

11

Using template expressions, you can get a StringTemplate to change:

label = StringTemplate[
   "`1` leaves `2` periods `3` <*If[`3`>1,\"loops\",\"loop\"]*> `4` \
crossings by S.N."][nn, ln, lop, nn (ln - 1)]

The:

<*If[`3`>1,\"loops\",\"loop\"]*>

is the template expression that returns the string “loops” if template argument number 3 is greater than 1, else it returns the string “loop”. This is equivalent to the expression below:

label = TemplateObject[{
    TemplateSlot[1], " leaves ",
    TemplateSlot[2], " periods ",
    TemplateSlot[3],
    " ", TemplateExpression[If[TemplateSlot[3] > 1, "loops", "loop"]],
     " ",
    TemplateSlot[4], " crossings by S.N."},
   InsertionFunction -> TextString, CombinerFunction -> StringJoin][
  nn, ln, lop, nn (ln - 1)]

Just as a side note, I should point out that by adding [nn, ln, lop, nn (ln - 1)] at the end of your assignment, you are evaluating the TemplateObject. The assignment to the symbol ‘label’ is thus a String, rather than a TemplateObject and should stay constant when the values of nn, ln and lop changes.

In[43]: Head[label]
Out[43]: String
12

thanks Patrik Ekenberg-san
I tried

label = StringTemplate[
"`1` leaves `2` periods `3` <*If[`3`== 1,\"loop\",\"loops\"]*> `4` crossings     S.N."]  [nn, ln, lop, nn (ln - 1)];

I got what I want. (please neglect the attached images. I don’t know how to remove them)
thanks again

13

Dear All, I got the following code. I think this consists of a simple structure of “label = Style[..]” and
" Labeled[ Grid[..], label, Bottom]".
It was based on these discussions and modified from the advice by the technical support of Wolfram. Thank again.

Manipulate[
  label = Style[
                Row[{"X-axis width of ", y, If[y == 1, " Pi-unit", " Pi-units"], 
                "(left) and ", w, If[w == 1, " Pi-unit", " Pi-units"], "(Right)"}
                ], FontSize -> 18, Bold, Blue]; (*endof Style*)
  Labeled[
      Grid[{{   (*the sample graphics*)
            Show[Plot[Sin[x], {x, 0, y*Pi}], ImageSize ->Small],         
            Show[Plot[Cos[x], {x, 0, w*Pi}], ImageSize -> Medium]}}
       ],(*endof Grid*)
       label, Bottom (*Can be Bottom, Left, Top, or Right*)
    ],(*endof Labeled*)
   {y, 1, 10, 1}, {w, 1, 10, 1}
](*endof Manipulate*)