Getting VertexRenderingFunction to (not) scale - wolfram-mathematica

I'm having problem with custom VertexRenderingFunction showing at different sizes for different graphs. An example is below, the default vertex rendering function has the desired behavior since vertices look the same in all graphs, any suggestion how to achieve that with custom vertices?
(source: yaroslavvb.com)
edges = Most[
ArrayRules[GraphData[{"Path", 5}, "AdjacencyMatrix"]]][[All, 1]];
doit[vrf_] :=
Print /# Table[
GraphPlot[Rule ### edges[[k ;;]], VertexRenderingFunction -> vrf,
VertexLabeling -> True], {k, 1, Length[edges]}];
doit[({White, EdgeForm[Black], Disk[#, .1], Black, Text[#2, #1]} &)];
doit[Automatic];
Update, 1 hour later:
Michael Pilat as usual gives the solution, here's what it looks like with (Inset[Graphics[{White, EdgeForm[Black], Disk[{0, 0}, .05], Black,
Text[#2, {0, 0}]}, ImageSize -> 25], #] &) for rendering function
(source: yaroslavvb.com)

Inset a Graphics expression with the ImageSize option to place your vertices:
GraphPlot[Rule ### edges,
VertexRenderingFunction -> (Inset[
Graphics[{White, EdgeForm[Black], Disk[{0, 0}, .05], Black,
Text[#2, {0, 0}]}, ImageSize -> 25], #] &),
VertexLabeling -> True]
ImageSize can take a variety of values from printer's points to a Scaled value.
Inset can also/instead take a size in its fourth argument, but the default setting defers to the ImageSize of the inset Graphics object, which is a little cleaner to use in this case.
Hope that helps!

Related

Same scale for the axes in Graphics (2D)

I'm trying to establish the same scales for two axes while using Graphics. I don't know the potential size ('plotrange') of the picture, so AspectRatio doesn't help. ScalingFunctions can't be applied to Graphics. Is there any equivalent of this?
Something like this? Same axes scales for originally rectangular image.
image = ExampleData[{"TestImage", "Apples"}];
Graphics[{Yellow, Rectangle[{0, 0}, {400, 400}],
Inset[ImageResize[image, {400, 400}], {0, 0}, {0, 0}, 400]},
PlotRange -> {{0, 400}, {0, 400}}, ImageSize -> 400,
Frame -> True]

Sphere Styling and Grid Spacing in Graphics3D

Please consider :
colors = {Red, Green, Blue};
style = {Thickness[.01], Thickness[.01], Thickness[.01]};
cAxes = {{{0, 0, 0}, {0, 0, 1}}, {{0, 0, 0}, {0, 1, 0}}, {{0, 0,
0}, {1, 0, 0}}};
Graphics3D[{{#1, #2, Line##3} & ### Transpose#{colors, style, cAxes},
Blue, Specularity[White, 3], Sphere[{.5, .5, .5}, .1]},
Boxed -> False, FaceGrids -> All,
FaceGridsStyle -> Directive[Black, Dashed]]
Using Yoda`s solution on How to Style Lines
How could I color the Sphere using GrayLevel (I will manipulate it later).
And How could I have denser FaceGrids ? 10 Lines horizontally & Vertically. I also don`t understand why the Edges one are distant to one another.
It's always good practice to group the graphics object and its styles in a list, in case you need to quickly add another one with different styles. By that, I mean write it as {Blue, Specularity[White, 3], Sphere[{.5, .5, .5}, .1]}. Now you can easily add a GrayLevel term before Sphere and it'll work.
For the FaceGrids, I believe you'll have to manually define the lines at your desired spacing for each face. Here's an example for showing how to do it for one face.
Graphics3D[{{#1, #2, Line##3} & ###
Transpose#{colors, style, cAxes}, {Blue, GrayLevel[0.3], Lighting -> "Neutral",
Specularity[White, 3], Sphere[{.5, .5, .5}, .1]}}, Boxed -> False,
FaceGrids -> {{{0, 0, 1},
Transpose#({#, #} & /# Range[0, 1, 0.1])}},
FaceGridsStyle -> Directive[Black, Dashed]]
The faces are defined as ±1 for the corresponding plane and the other two are zero. So {0,0,1} in my example corresponds to the z=1 plane.
The list supplied to FaceGrids can be easily computed for each face, instead of manually entering them, but I'll leave that to you :)
EDIT:
Since you want a uniform mesh all around, define where you want the grid lines drawn as
gridList = Transpose#({#, #} & /# Range[0, 1, 0.1]);
Then, use the following for FaceGrids:
FaceGrids -> Join ## Table[{RotateLeft[j {0, 0, 1}, i], gridList},
{i, {0, 1, 2}}, {j, {-1, 1}}]
Here's how the result should look like with PlotRangePadding -> None:
In addition to Yoda's response:
Lighting -> "Neutral" will allow grayscale object to show up as gray instead of with various colors.
PlotRangePadding -> None will remove the spaces on the grid lines (depending on the setting for PlotRange.)
Yoda beat me to typing out the FaceGrids setting (see documentation). But here is an alternative.
Instead of setting the FaceGrids setting explicitly, youcould also try setting FrameTicks, since by default the FaceGrids follow these, and then style the FrameTicks to be invisible using Opacity.

Make a text string fill a rectangle

Suppose I want a string, say "123", to fill a given rectangle, like so:
Show[Plot[x, {x, 0, 1}],
Graphics[{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]}],
Graphics[Text[Style["123", Red, Bold, 67], {.1, .5}, {-1, -1}]]]
But I hand-tuned the font size there (67) so that it would fill up the rectangle.
How would you make an arbitrary string fill up an arbitrary rectangle?
I believe that this is a known difficult problem. The best answer I could find is from John Fultz.
TextRect[text_, {{left_, bottom_}, {right_, top_}}] :=
Inset[
Pane[text, {Scaled[1], Scaled[1]},
ImageSizeAction -> "ResizeToFit", Alignment -> Center],
{left, bottom}, {Left, Bottom}, {right - left, top - bottom}]
Show[
Plot[x, {x, 0, 1}],
Graphics[{
{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]},
TextRect[Style["123", Red, Bold], {{.1, .5}, {.4, .9}}]
}]
]
Here's an alternate approach that converts the text to a texture that gets mapped to a polygon. This has the feature of stretching the text to fit the region (since it's not really text anymore.)
Show[Plot[x, {x, 0, 1}],
Graphics[{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]}],
Graphics[{Texture[ImageData[
Rasterize[Style["123", Red, Bold], "Image", RasterSize -> 300,
Background -> None]]],
Polygon[{{0.1, 0.5}, {0.4, 0.5}, {0.4, 0.9}, {0.1, 0.9}},
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}]]
As a function for easier comparison:
(* Render string/style s to fill a rectangle with left/bottom corner {l,b} and
right/top corner {r,t}. *)
textrect[s_, {{l_,b_},{r_,t_}}] := Graphics[{
Texture[ImageData[Rasterize[s, "Image", RasterSize->300, Background->None]]],
Polygon[{{l,b}, {r,b}, {r,t}, {l,t}},
VertexTextureCoordinates->{{0,0},{1,0},{1,1},{0,1}}]}]
The suggested solution didn't work when the Plot wasn't there, I used the PlotRange option to solve it. I wrapped it in a function; Opacity, text color, etc; should be made into options;
textBox[text_, color_, position_: {0, 0}, width_: 2, height_: 1] :=
Graphics[{
{
color, Opacity[.1],
Rectangle[position, position + {width, height},
RoundingRadius -> 0.1]
}
,
Inset[
Pane[text, {Scaled[1], Scaled[1]},
ImageSizeAction -> "ResizeToFit", Alignment -> Center],
position, {Left, Bottom}, {width, height}]
}, PlotRange ->
Transpose[{position, position + {width, height}}]];

Specify Point Style in ListPlot in Mathematica

Considering
dacount = {{0, 69}, {1, 122}, {2, 98}, {3, 122}, {4, 69}}
ListPlot[dacount, AxesOrigin -> {-1, 0},
PlotMarkers ->Automatic
PlotStyle-> Lighter[Red, #] & /# Range[0.5, 1, 0.1],
Filling -> Axis, FillingStyle -> Opacity[0.8],
PlotRange -> {{-1, 4.5}, {0, 192}}]
My hope there was for each point to take a different shade of red.
But I can`t understand how to have a style for point which I tried to set as different list.
In your original code, the PlotStyle option won't affect the marker symbols, so you can leave it out. Instead, change your PlotMarkers option to the following:
PlotMarkers -> With[{markerSize = 0.04},
{Graphics[{Lighter[Red, #], Disk[]}], markerSize} & /# Range[0.5, 1, 0.1]]
This will not yet have the desired effect until you replace the list dacount by:
Map[List, dacount]
By increasing the depth of the point list in this way, each point is assigned a marker style of its own from the list in PlotMarkers. So the final code is:
ListPlot[Map[List, dacount], AxesOrigin -> {-1, 0},
PlotMarkers ->
With[{markerSize =
0.04}, {Graphics[{Lighter[Red, #], Disk[]}], markerSize} & /#
Range[0.5, 1, 0.1]], Filling -> Axis,
FillingStyle -> Opacity[0.8], PlotRange -> {{-1, 4.5}, {0, 192}}]
You can also do it the following way:
xMax = Max#dacount[[All, 1]];
Show#(ListPlot[{#}, AxesOrigin -> {-1, 0}, PlotMarkers -> Automatic,
PlotStyle -> (RGBColor[{(#[[1]] + 5)/(xMax + 5), 0, 0}]),
Filling -> Axis, FillingStyle -> Opacity[0.8],
PlotRange -> {{-1, 4.5}, {0, 192}}] & /# dacount)
This plots each point in dacount individually and assigns it a shade of red depending on the x value. The plots are then combined with Show.
I've arbitrarily chosen a scaling and offset for the different shades. You can choose whatever you want, as long as you ensure that the max value is 1.

How to add custom ColorFunction in FillingStyle with Opacity

I want to plot a series of lines with one half-space filled for each line. By setting opacity to something less than 1, I want to make the overlaps stand out. What I have looks something like this:
Plot[Table[x + a, {a, 0, 5}], {x, -1/2, 1/2},
RegionFunction -> Function[{x, y}, y < 5],
Filling -> 5, FillingStyle -> Directive[Opacity[0.25]]]
This is fine. Now I want to also shade the colors for each half space in a particular way. Instead of the flat shading for each at present, say I want to shade it by the y value. I.e., if the flat shade color is blue, the shade of blue is scaled by y (0 most intense or 5 most intense doesn't matter). So at the first overlap, it automatically becomes 2y, 3y when two half-spaces overlay.
How do I do this?
You could try ParametricPlot. For example
ParametricPlot[
Table[{s, i + s/2 + t}, {i, 0, 2}], {s, 0, 1}, {t, 0, 3},
Mesh -> False, PlotStyle -> Automatic,
ColorFunctionScaling -> False,
PlotRange -> {Automatic, {0, 3}},
ColorFunction -> Function[{x, y, s, t},
Directive[Opacity[0.2], ColorData["NeonColors"][y/3]]],
AspectRatio -> 1]
Result:

Resources