New answers tagged graphics
2
You can use First to extract the graphics primitives of any graphics expression, including e.g. the output of RegionPlot. Then you can simply apply your GeometricTransformation to that:
Manipulate[
Graphics3D[
Rotate[
First@RegionPlot3D[Ellipsoid[{0, 0, 0}, {1, 1, 2}], Mesh -> Full],
θ,
{0, 0, 1}
]
],
{θ, 0, 2 π}
]
4
I faced with the same issue.
Using Mathematica's function ExportString[…, "ExpressionJSON"] I attempted to export the whole tree of graphical functions and wrote a parser in JS.
It was uploaded to GitHub, here is the link.
There is a primitive construction with a lot of "switch-case" statements. Each of them implements self function like changing the color ...
0
A bit too late to the party, I found that there's no way to add texture to the rabbit using @Simon's method, thus I created one of my own. Effect first!
One rabbit only, correct texture for the rabbit for most part.
The code is as follows, and could be downloaded here:
mappedstereogram[img_Image, depth_Image, bg_Image, n_List: {5, 3},
shift_: 40, ...
2
You can use the special form ImageSize -> 1 -> {a,b} for setting image size:
Row[Table[Labeled[
VoronoiMesh[pts, PlotRangePadding -> 0, Frame -> True, ImageSize -> 1 -> 20 {s, 1}],
"s = " <> ToString[s], Top], {s, { .8, 1, 1.3, 2}}], Spacer[5]]
4
What if you scale underlying points of MeshRegion? That way you have complete control and you can use geometric transformation functions like ScalingTransform, RotationTransform, etc.
(* mesh comes form OP's code *)
newCrds = ScalingTransform[{2, 1}] /@ MeshCoordinates[mesh]
MeshRegion[newCrds, MeshCells[mesh, 2], Frame -> True]
0
I have a similar code made by Apple, just for reference.
Clear["Global`*"]
rotate[p4_, p2_] := Evaluate[Simplify@RotationTransform[1. Pi/3, p2][p4]];
generate[p1_, p5_] := Module[{p2, p3, p4},
p2 = (p5 - p1)/3 + p1;
p4 = 2 (p5 - p1)/3 + p1;
p3 = rotate[p4, p2];
{p1, p2, p3, p4}];
data[0]=N@{{ 0, 0}, {1, 0}};
data[n_] := data[n] = Flatten[{...
2
I was able to do it using Texture,
hk0 = Texture@
Show[ListDensityPlot[Shk0, InterpolationOrder -> 1,
AspectRatio -> Automatic,
ColorFunction -> ColorData["SunsetColors"]], hk0Outline,
Frame -> False];
hhl = Texture@
Show[ListDensityPlot[Shhl, InterpolationOrder -> 1,
AspectRatio -> 1/Sqrt[2],
...
21
I think OP may want animation with transition effects. Compare these two effects:
Then translation
Clear["`*"]
cf = Compile[{{M, _Real, 2}, t},
With[{A = M[[1]], B = M[[2]]},
With[{P = (A + B + t Cross[B - A])/2}, {{A, P}, {B, P}}]], RuntimeAttributes -> Listable
];
f[n_] := Flatten[Nest[cf[#, 1] &, {{{0, 0}, {1, 0}}}, Floor@n], Floor@n];...
1
You could set more initial points:
RegionPlot[region[h4in[g[x + I y]]], {x, 0, 1}, {y, -0.5, 0.5},
PlotPoints -> 30]
9
Update: Generalizing the ideas behind methods 1 and 2 to round the corners of arbitrary convex polygons:
ClearAll[inSphere, rndCorners]
inSphere[{p1_, p2_, p3_}, rad_] := Module[{rl = Min[ArcLength[Line[{p1, p2}]],
ArcLength[Line[{p2, p3}]], rad + rad/Sin[VectorAngle[p1 - p2, p2 - p3]/2]]},
MeshCoordinates @ DiscretizeRegion @
Insphere[{p2, p2 + ...
6
Update 3
This is my final update except for typo corrections. I hope it provides a useful answer to the OP's question.
I don't believe the OP's problem can be solved by fooling around with RoundingRadius. I think one needs to write a function that will generate a polygon that Graphics will render as a NURC (Non-Uniform-Rounded-Corners) rectangle and which ...
1
Generally, I really recommend image processing docs - lots useful stuff there:
http://reference.wolfram.com/language/guide/ImageProcessing.html
http://reference.wolfram.com/language/guide/ColorProcessing.html
DistanceTransform resolution depends on your original image resolution which you can control in Graphics:
dpts = ImageAdjust[DistanceTransform[...
8
MaTeX returns plain Graphics, usually with some FilledCurve inside. You can disassemble it and try to modify it.
Here I try an idea where we make the strokes very thick to create an outline of the graphics.
ClearAll[outline]
outline[thickness_: 6, colour_: White][ma_] :=
Show[
Insert[ma,
EdgeForm@Directive[CapForm["Round"], JoinForm["Round"], ...
22
A simple way to make Dragon Curve is using AnglePath. Define a function that generates points for the Dragon curve:
dragonPTS[k_]:=AnglePath[{Pi/2,-Pi/2}[[1+Nest[Join[#,{0},Reverse[1-#]]&,{0},k]]]]
k is an integer number of iterations. Try it out:
Graphics[Line[dragonPTS[10]]]
Now generate a list of the transitions:
Table[Graphics[Line[dragonPTS[k]]]...
0
Using the code presented above, I obtained the following results. It seems that for negative values the function is zero or does not exit . I expect to have similar behavior as a depict a positive region.
6
I evaluated the OP's code with V12.0 running on MacOS 10.13.4. It reproduced his image as I thought it would. Some of the corners of the default "Square" end caps extend beyond the curve boundary causing the artifacts the OP observed. On the other hand, setting the end caps to None or "Butt" produced voids. So the only form I recommend is:
Graphics[{...
5
Use
FrameTicks -> {{Automatic, Automatic},
{MapAt[DatePlus[#, {6, "Month"}] &,
rotatedDateTicksF[15][{2000}, DatePlus[{2000}, {15, "Year"}]], {All, 1}],
Automatic}}
to get
0
For the first part of what you asked, is the following what you had in mind?
Animate[Plot3D[Sqrt[(x^2 + y^2)/(x*y + n)], {x, -20, 20}, {y, -20, 20},
PlotRange -> All], {n, -10, 10}]
So, just have a free parameter n and allow it to take values in a specific range whilst animating the plot. This results in the following
You can hit pause and then ...
1
a = Plot[x, {x, 0, 2}];
b = Plot[x^2, {x, 0, 2}];
c = Plot[x^3, {x, 0, 2}];
defaultMMAcolor=RGBColor[0.368417, 0.506779, 0.709798]
Show[a /. {defaultMMAcolor -> Black},
b /. {defaultMMAcolor -> Red},
c /. {defaultMMAcolor -> Pink}]
1
Is this something that you had in mind?
Generate a random plot
A = Plot[x^3, {x, -3, 3}]
And then
Show[A /. _RGBColor -> Red]
The above is the simplest resolution I know off and I have used in the past. I found this answer on this site. I am giving the link, where you can also find more sophisticated approaches you can check
Regarding the question ...
10
Related link: https://mp.weixin.qq.com/s/oz1c3crqgC5WMbUFGxLDMQ
Clear["`*"];
next = Table[Indexed[A,{x,y}],{x,4},{y,2}]/.
v:{a_,b_,c_,d_}:>
Compile[{{A,_Real,2},t},
{
ScalingTransform[{1,1}Cos[t],d]@RotationTransform[t,d]@TranslationTransform[d-a]@v,
ScalingTransform[{1,1}Sin[t],c]@RotationTransform[t-Pi/2,c]@TranslationTransform[...
10
Here is one possibility:
branch[Polygon[{u_, v_, r_, s_}], q_?NumericQ] := Module[{a = Norm[r - s], b, h, v1, v2},
b = a Sqrt[1 - q^2];
h = r q^2 + s (1 - q^2) + b q Normalize[Cross[r - s]];
v1 = a q Cross[Normalize[h - s]]; v2 = -b Cross[Normalize[h - r]];
{Polygon[{s, h, h + v1, s + v1}], Polygon[{h, r, r + v2, h + v2}]}]
...
14
Grid
ClearAll[labeledGrid]
labeledGrid[cs_: "GrayTones", is_: {80, 80},
sty_: Directive["TR", FontSize -> 16, Black]] :=
Module[{tbl = Map[Item[Pane[Style[If[NumericQ@#, NumberForm[#, 2], #], sty],
Alignment -> Center, ImageSize -> is],
Background -> If[NumericQ@#, ColorData[cs][(1 + #)/2], None]] &,
Prepend[...
8
Readapting my answer here: DensityPlot with text
dim = Dimensions@ccm;
temp = Transpose[{mem}~Join~Transpose@Round[ccm, .01]];
table = Prepend[temp, Flatten@{"", mem}];
background =
Join[{None,
None}, {Flatten[
Table[{i, j} -> ColorData["GrayTones"][table[[i, j]]], {i, 2,
1 + dim[[1]]}, {j, 2, 1 + 3}], 1]}];
Grid[table
, Frame -&...
9
How about using MatrixPlot?
epilog = MapIndexed[Text[Style[Round[#, .01], 10], #2 - 1/2] &, Transpose@Reverse@ccm, {2}];
ticks = Transpose[{Range@Length@mem, mem}];
MatrixPlot[ccm,
Epilog -> epilog,
FrameTicks -> {ticks, ticks, ticks, ticks},
PlotRangePadding -> None,
ColorFunction -> (ColorData["GrayTones"][(1 + #)/2] &),
...
4
As suggested in the comments, the problem is the anti-aliasing. Setting it to false solves the problem.
Table[Graphics[{Line[{{0, 0}, {1, 1}}],
Table[Line[{{1/10, 0}, {1/10 + 1, 1}}], n],
Inset[n, {1/2, 1}]}
] // Style[#, Antialiasing -> False]&
, {n, {1, 2, 5, 10, 100, 1000}}]
5
Numerically all 100 differences between 100 corresponding elements of matrices correspond fall into just 5 symmetric values:
Round[Union[Flatten[mat1-mat2]],.0001]
{-0.0025,-0.0019,-0.0015,-0.001,0.,0.001,0.0015,0.0019,0.0025}
Which looks a lot like some small noise imposed on:
{-25,-20,-15,-10,0,10,15,20,25}/10000
It is actually quite easy to ...
6
For plotting all your parameters need to be numerically defined. Please read docs a bit on plotting as this is quite simple. You got Inactive sum that you should Activate. Use Evaluate inside plotting functions to speedup plotting up. Read up docs on all functions I mentioned and used.
Plot3D[Evaluate[Activate[sol /. K -> 1]], {x, -5, 5}, {t, 0, 2}, ...
1
If you want round corners, StadiumShapeis a possibility :
data = {{0, 0}, {1, 0}, {2, 1}}
Graphics[Line[data]]
Graphics[StadiumShape[#, 0.25] & /@ Partition[data, 2, 1]]
Top 50 recent answers are included
