New answers tagged graphics
3
You can also arrange the lines on a circle like a pie chart:
ClearAll[llpOnCircle]
llpOnCircle[dt_, colors_, filling_: True, r1_: 1, r2_: 3/2, scale_: 1] :=
MapIndexed[{Darker @ colors[[#2[[1]]]],
Line[(r1 + #[[2]] scale) {Cos[#[[1]]], Sin[#[[1]]]} & /@ #],
If[filling == True,
{Opacity[.5], Lighter@colors[[#2[[1]]]] ,
...
4
I think the failure to discretize your first Graphics object is a bug.
But, instead of creating graphics objects and then converting them to MeshRegion objects with DiscretizeGraphics, I think it is simpler to use Region functionality instead, since Rectangle is already a Region primitive. When working with Region primitives you need to use ...
8
Clear["Global`*"]
AllData = Import["https://pastebin.com/raw/DsVfiMZN", "Table"];
datai = Table[
data[20*i] = AllData[[All, 2*i + 1 ;; 2*i + 2]], {i, 0, 17}];
ploti = Table[
p[20*i] = ListLinePlot[data[20*i],
PlotRange -> {{0.5, 7.5}, {0, 0.6}},
Axes -> False,
PlotStyle -> Black,
ImageSize -> 36],
{i, 0, 17}];
...
2
A custom layout combining grid embedding and multipartite embedding:
ClearAll[multipartiteOnGrid]
multipartiteOnGrid[{r_, c_}, columnpositions_] /; c == Length @ columnpositions :=
Module[{grd = Partition[Tuples[Range /@ {c, r}], r],
prts = columnpositions /.
{All -> r, i_Integer?Negative :> r + 1 + i} /. Span[a_, b_] :> Range[a, b]},
...
4
You can use the option Epilog or Prolog to add graphics primitives (lines, points, texts, etc.) to your plot:
Plot[2 Pi + 2 Pi x Sin[6 Pi x], {x, 0, 1},
Epilog -> {Red, Line[{{.8, 0}, {.8, 7}}]}]
Plot[2 Pi + 2 Pi x Sin[6 Pi x], {x, 0, 1},
Prolog -> {Red, Line[{{.8, 0}, {.8, 7}}]}]
same picture
12
SeedRandom[1234]
colors = RandomColor[4];
centers = Tuples[{-1, 1}/2, {2}];
Graphics[MapThread[{Opacity[.5], #, EdgeForm[{Darker@#, Thick}], Translate[Disk[], #2]} &,
{colors, centers}]]
colors = {Red, Green, Blue, Yellow};
labels = {"Paperwork Process", "MentalProcess", "Human Aspect", "Technical Tools"};
Graphics[{MapThread[{EdgeForm[{Darker@#, ...
3
The midpoints of the four circles(radius r) lie on a square(sidelength a)
Change Circle to Disk to get colored circles.
With[{a = 0.5, r = 1}, Graphics[{ EdgeForm[Black], Opacity[.2],
FaceForm[Blue], Disk[{a, a}, r], Circle[{-a, a}, r],Circle[{-a, -a}, r] , Circle[{ a, -a}, r]}]]
3
You could try using "MultipartiteEmbedding" as the vertex layout method, and perhaps adjust vertex partitions accordingly. Here is a stab at it:
graphData = KeyValueMap[Labeled[#2["From"] -> #2["To"], #1] &] @ Association @ streams;
Graph[
graphData, VertexShapeFunction -> "Square", VertexSize -> Large,
VertexLabels -> Placed["Name", ...
2
Here's a function that lets you color the overlap any way you want:
directedangle[a_, b_] := If[
Sign@Det[{a, b}] >= 0,
VectorAngle[a, b],
2 π - VectorAngle[a, b]
]
angles[center_, Point[{pt1_, pt2_}]] := Module[{th1, th2},
th1 = directedangle[{1, 0}, pt1 - center];
th2 = directedangle[{1, 0}, pt2 - center];
{th1, th2} = Sort[{th1, th2}];
...
6
Here's a refinement of Michael's FilledCurve idea, where I use BSplineCurve to generate the circles instead of Line. The following function creates a BSplineCurve that renders as a circle with center c and radius r, where r is measure in points, and not plot coordinates (using points means that the shape of the circle is unaffected by changes in the ...
5
Another way using regions.
If we have two regions defined by disks
R = {r1, r2} = {Disk[{0, 0}, 2], Disk[{1, 1}, 2]};
Graphics[R]
we can effectively paint their intersection.
Show[
Graphics[R],
MeshPrimitives[
DiscretizeRegion[RegionIntersection @@ R],
2
] /. reg : Polygon[_] :> {EdgeForm[White], White, reg} // Graphics,
PlotRange -&...
9
Perhaps:
Graphics[FilledCurve[{
{Line@close@CirclePoints[{0, 0}, 1, 30]},
{Line@close@CirclePoints[{1, 1}, 1, 30]}
}]]
More generally:
close[path_List] := Append[path, First@path];
drawIt[points_List, r_: 2] :=
FilledCurve[{Line@close@CirclePoints[#, r, 40]} & /@ points];
SeedRandom[0];
Graphics[drawIt[RandomReal[{-20, 20}, {20, 2}]]]
3
ClearAll[f, x, y, z, r]
f[x_, y_, z_] := Cos[x] + Cos[y] + Cos[z]
x[t_] := {t, 0, 0}
y[t_] := {1, t, 0}
z[t_] := {1, 1, t}
r[t_] := {t, t, t}
You can use
Through[{x, y, z, r}@t]
or
#[t] & /@ {x, y, z, r}
to get
{{t, 0, 0}, {1, t, 0}, {1, 1, t}, {t, t, t}}
and Apply f at level 1 (@@@) to the resulting list:
funcs = f @@@ %
{2 + Cos[t], 1 + Cos[1] +...
4
It's hard to be sure from your question, but you might just be looking for Plot:
f[x_, y_, z_] := Cos[x] + Cos[y] + Cos[z]
x[t_] := f[t, 0, 0]
y[t_] := f[1, t, 0]
z[t_] := f[1, 1, t]
r[t_] := f[t, t, t]
Plot[
{x[t], y[t], z[t], r[t]},
{t, 0, 1}
]
5
Here is an approach using DiscretizeGraphics and RegionDifference to manually cut the affected objects:
hole=Cylinder[(* the object describing the hole to cut out *)
{
{(-0.1+7.128)/2,(8+1.3)/2,0},
{(-0.1+7.128)/2,(8+1.3)/2,2}},
];
dhole=DiscretizeRegion@hole(* discretized version of hole *);
f2/.
Sphere->Ball/.(* replace Sphere with ...
6
Maybe you can use a tooltip with CurrentValue? For example, here's a random graphics object:
g = Graphics[{
Thickness[.1],
Green,
{
Circle[{0,0}],
Red,
Line[{{0,0},{1,1}}],
{
Blue,
AbsoluteThickness[1],
Polygon[{{0,1},{1,0},{1,1}}]
}
}
}]
Replace every Line, Polygon ...
0
Another approach is to rasterize each region with RegionImage.
outerdisks = RegionDifference[#1, RegionUnion[##2]]& @@@ NestList[RotateRight, {rDisk, bDisk, gDisk}, 2];
diskints = {rgDisk, rbDisk, gbDisk};
complement = RegionDifference[FullRegion[2], RegionUnion[rDisk, bDisk, gDisk]];
Image[ImageAdd @@ MapThread[
ImageMultiply[
RegionImage[#1, ...
3
If we represent each part as a piecewise spline we'll have an exact representation, as opposed to DiscretizeRegion which approximates the regions with polygons.
I'll use splineCircle defined here.
rDisk2 = FilledCurve[{splineCircle[rDisk[[1]], 1, {0, π}],
MapAt[Reverse, splineCircle[bDisk[[1]], 1, {π/3, 2 π/3}], {1}],
MapAt[Reverse, splineCircle[...
4
pts={AngleVector[60°],{1,0},{0,0}};
colors=Join[{r,g,b}={Red,Green,Blue},Blend[#,0.5]&/@{{r,g},{r,b},{g,b}},{White}];
regions=BoundaryDiscretizeRegion/@RegionIntersection/@Rest@Subsets[Disk/@pts];
Graphics[Thread[{EdgeForm/@colors,colors,regions}]]
or
Graphics[Thread[{colors, MeshPrimitives[#,2]&/@regions}]]
If need faster speed, I prefer use ...
2
The rasterizeBackground function originally written by Szabolcs and then improved by Lukas Lang requires further minor update and improvement in order to get it working for your case in recent versions of Mathematica.
Here is a substantially more reliable version of that function which doesn't depend on the buggy AbsoluteOptions (I use here the workaround ...
10
In addtion to Carl's answer, you can also force to rasterize the image with customized resolution. Takes longer but creates higher resolution bitmap images.
g = Show[Graphics[{Red, rDisk}], Graphics[{Blue, bDisk}],
Graphics[{Green, gDisk}],
Graphics[{Blend[{Red, Blue}, 0.5], BoundaryDiscretizeRegion[rbDisk]}],
Graphics[{Blend[{Red, Green}, 0.5], ...
8
You can use BoundaryDiscretizeRegion instead of DiscretizeRegion to avoid the mesh lines when using Antialiasing->True:
Graphics[{
{Red, rDisk},
{Blue, bDisk},
{Green, gDisk},
Antialiasing->True,
BoundaryDiscretizeRegion[rbDisk, MeshCellStyle->{2->Blend[{Red, Blue}]}],
BoundaryDiscretizeRegion[rgDisk, MeshCellStyle->{2-...
1
You can use construct a BSplineFunction using input data:
SeedRandom[1]
pts = RandomReal[1, {10, 3}];
bsf = BSplineFunction[pts, "SplineDegree" -> 1];
You can use bsf with ParametricPlot3D in several ways:
(1) Use a piecewise ColorFunction:
Animate[ParametricPlot3D[bsf[t], {t, 0, 1},
PlotStyle -> Thick,
ColorFunction -> (If[#4 <= m, ...
6
You can use VertexSize and VertexStyle (suggested by Szabolcs in comments) in two ways:
SetProperty[G,
{VertexSize -> Thread[VertexList[G] -> ls],
VertexStyle -> Thread[VertexList[G] -> (ColorData["Rainbow"] /@ Rescale[ls])]}]
or
SetProperty[G,
{VertexSize -> {v_ :> ls[[v]]},
VertexStyle -> {v_ :> (ColorData["Rainbow"]@...
0
Let's generate some points:
pts = {1, 1, #} & /@ Range[0, 1, 0.01];
Now we can utilize MapIndexed:
Graphics3D[MapIndexed[{ColorData["SunsetColors"][First@#2/Length[pts]],
Point@#1} &, pts], Axes -> True]
And Animation:
Animate[Graphics3D[MapIndexed[{ColorData["SunsetColors"][First@#2/Length[pts]],
Point@#1} &, pts[[1 ;; t]]],
...
0
Just a slightly compact way of Bob Hanlon's answer (which I voted for). Note ContourPlot frames and uses Tooltip. The aesthetics and control of Legended may be preferred.
cons = {x >= 5, y >= 8, x + 2 y <= 64, x + y <= 40};
eq = cons /. {(a_ >= b_) :> (a == b), a_ <= b_ :> a == b};
Show[RegionPlot[lab = Fold[And[#1, #2] &, cons],...
1
First an alternative, more streamlined, way to construct outer:
tbl = Transpose[{cVal + cVal #, sVal + sVal #}] & /@ solVals;
outer2 = ListLinePlot[#,
AspectRatio -> Full,
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}] & /@ tbl;
outer2 == outer
True
baseplot = ListLinePlot[Transpose[{cVal, sVal}], PlotStyle -> Red];
ListAnimate[Show[...
1
You can use ListPointPlot3D with the option LabelingFunction to make labeled 3D points and use Show to combine it with graphics produced by Plot3D:
f[x_, y_] := (x - 1.5)^2 + (y - 1)^2
p3d = Plot3D[f[x, y], {x, -3, 5}, {y, -3, 5},
BoxRatios -> 1,
ColorFunction -> (Directive[Opacity[.5], ColorData["Rainbow"][#3]] &),
PlotRange -> {{-...
2
You can add Method -> {"SpherePoints" -> 300}. With this option there are no artifacts:
example[r_] :=
Show[Graphics3D[{Opacity[0.3, GrayLevel[0.8]], Sphere[{0, 0, 0}, r], GrayLevel[0.2],
Opacity[1],
Style[Sphere[{0, 0, 0}, 3],
ClipPlanes -> Hyperplane[vertex, Cos[30 Degree]*3*Normalize[vertex]]]},
Boxed -> False, Method -&...
1
ColorFunction->"WatermelonColors"
5
f1[x_, y_] := 2 x^2 - 3 y - 7
f2[x_, y_] := 3 x + 4 y + 1
cp = ContourPlot[{f1[x, y] == 0, f2[x, y] == 0}, {x, -10, 10}, {y, -5, 50},
PlotRange -> {{-5, 5}, {-5, 6}, All}];
intersections = Graphics`Mesh`FindIntersections[cp];
You can add labels using Epilog + Text:
Show[cp,
Epilog -> {Text[Pane @ #, # + {1.7, .2}] & /@ intersections,
...
5
Recently the function
RandomMandala
was added to the
Wolfram Function Repository.
Here are multi-mandala mode examples run in a notebook with "ReverseColor" stylesheet:
SeedRandom[5798]
Multicolumn[
Table[ResourceFunction["RandomMandala"][
"Radius" -> RandomChoice[{Identity, Log, #^1.618 &, #^0.618 &, ArcCot, ArcSec}][Reverse@Range[8, 2, -...
3
As of V11.1, another available approach is to use RealAbs instead of Abs:
Plot[Evaluate[D[RealAbs[5 - 2 x], x]], {x, -10, 10}]
Note that Abs, as a function of a complex variable, is not differentiable, which I mentioned in a comment earlier.
1
CompleteKaryTree[3, EdgeStyle -> {e_?( EvenQ[#[[2]]]&)-> Green}, EdgeLabels -> "Name"]
or
CompleteKaryTree[3, EdgeStyle -> {e_/;EvenQ[e[[2]]]-> Green}, EdgeLabels -> "Name"]
or
CompleteKaryTree[3, DirectedEdges -> True,
EdgeStyle -> {DirectedEdge[_, _?EvenQ] -> Green},
EdgeLabels -> "Name", EdgeShapeFunction -> "...
3
You can use FontSize -> Scaled[s] in Style to get a font whose point size is a fraction s of the horizontal plot range.
Graphics[{White, EdgeForm[Thickness[0.01]], Rectangle[{0, 0}, {largura, altura}], Black,
Text[Style["TC-01", FontSize -> Scaled[.3]], {largura/2, altura/2}]},
ImageSize -> #] & /@ {50, 100, 300, 500} // Row
frames = ...
2
Quick guess: rectangles are no primitives in DXF. Second guess: rectangles are primitives in DXF but Mathematica's export filter doesn't know it.
In both cases, Mathematica does what it also has to do when sending Polygon objects to the GPU: It splitts each polygon into a set of triangles.
Workaround: If you do not need any filling, but only the lines ...
1
I just checked the solution by Szabolcs and it kinda works for me, only the letter heights are wrong:
{greekLetters, variantForms, archaicalGreekLetters} =
{{\[Alpha], \[CapitalAlpha], \[Beta], \[CapitalBeta], \[Gamma], \[CapitalGamma],
\[Delta], \[CapitalDelta], \[Epsilon], \[CapitalEpsilon], \[Zeta], \[CapitalZeta],
\[Eta], \[CapitalEta], \[...
0
Check this http://www.ams.org/publications/authors/tex/amsfonts and Install "cmmi12", then Use in Wolfram "FontFamily -> "Computer Modern" "
or
You can check https://tex.stackexchange.com/questions/38632/image-with-axis
JjSa
2
An alternative approach using Histogram and WeightedData, as described in the comments:
barheights = {2, 1, 3};
Show[
Histogram[
WeightedData[Range@Length@barheights - 1, barheights],
Length@barheights
],
ListLinePlot[{{1, 3}, {2, 1}, {3, 2}}, PlotStyle -> Red],
Frame -> True,
PlotRange -> All
]
2
You can post-process the BarChart output to change the coordinates of Rectangles:
barheights = {2, 1, 3};
bc = Show[BarChart[barheights , BarSpacing -> 0, Axes -> False],
ListLinePlot[{{1, 3}, {2, 1}, {3, 2}}, PlotStyle -> Red],
Frame -> True]
bc /. Rectangle[a_, b_, c___] :> Rectangle[{-1, 0} + a, {-1, 0} + b, c]
An alternative ...
2
You can use the second argument of Inset to specify the position:
pos = {4, .5};
{plotxx, plotyy, plotww, plotzz} = {Plot[Sin[x], {x, 0, 2 Pi}, PlotStyle -> Red],
Plot[Cos[x], {x, 0, 2 Pi}, PlotStyle -> Blue],
Plot[ Cos[2 x], {x, 0, 2 Pi}, PlotStyle -> Gray],
Plot[ Sin[ 2 x], {x, 0, 2 Pi}, PlotStyle -> Green]};
Show[plotxx, plotyy, ...
1
It seems that PlotRangePadding is hard-coded into ListContourPlot and Mathematica doesn't allow one to change this. But we can play with PlotRange:
ListContourPlot[XX, ColorFunction -> "TemperatureMap",
PlotLegends ->
Placed[BarLegend[{0, 17, 34, 51, 67},
LegendMargins -> {{0, 0}, {10, 5}}, LegendLabel -> "% output",
LegendMarkerSize -> ...
2
Update: A work-around: Post-processing to replace the option value for PlotRangePadding (which, strangely, is {{Scaled[0.02],Scaled[0.02]},{Scaled[0.02],Scaled[0.02]}} regardless of how the user sets this option)
lcp1 = ListContourPlot[XX, ColorFunction -> "TemperatureMap",
PlotLegends -> Placed[BarLegend[{0, 17, 34, 51, 67},
LegendMargins ...
Top 50 recent answers are included
