DensityPlot[
Module[{z = -x + I y, i = 0},
While[i < 100 && Abs[z] < 1, z = z^1.5 + -.2; i++]; i],
{y, -.2, .2}, {x, .35, .75}, PlotPoints 150]
ArrayPlot[CellularAutomaton[{1635, {3, 1}}, {{1}, 0}, 500],
ColorFunction (Hue[(.2 + #)/2] &)]
NestList[Subsuperscript[#, #, #] &, ♠, 4]
Graphics[
Riffle[NestList[Scale[Rotate[#, .1], .9] &, Rectangle[], 40], {Black,
White}]]
Graphics[
Table[Rotate[Text[Style[, 130, FontFamily "Times"], {1, 1.5}],
i 2 Pi/5, {0, 0}], {i, 1, 5}]]
GraphicsGrid[
Partition[
PolyhedronData[#, "Net"] & /@
RandomChoice[PolyhedronData["Net", "Defined"], 6], 2]]
ListLinePlot[{Re[#], Im[#]} & /@
Accumulate[Exp[I 1000. Sqrt[Range[2000]]]], AspectRatio Automatic]
ImageCollage[
EntityClass["Country", "GroupOf8"]["Population"] ->
EntityClass["Country", "GroupOf8"]["Flag"]]
GeoRegionValuePlot[
Entity["AdministrativeDivision", {"California", "UnitedStates"}][
"Subdivisions"] -> "PerCapitaIncome"]
SmoothHistogram3D[RandomVariate[BinormalDistribution[0.1], 100],
BoxRatios {1, 1, .8}, MeshShading {Yellow, Blue}, Mesh 10]
words = DictionaryLookup["*jack"]; Graph[
Flatten[Map[(Thread[# <-> DeleteCases[Nearest[words, #, 3], #]]) &,
words]], VertexLabels "Name"]
Colorize[
WatershedComponents[
Blur[Rasterize[
Show[Entity["PopularCurve", "ElsaCurve"]["Image"],
Axes False]]]],
ColorRules Table[c -> ColorData[55][c], {c, 2000}]]
ImageAssemble[
ImagePartition[
Entity["FictionalCharacter", "Spock"]["Image"], {20, 20}, {10, 10}]]
ContourPlot3D[(x^2 + y^2 + z^2)^2 - 2 (x^2 - y^2 - z^2), {x, -2,
2}, {y, -2, 2}, {z, -2, 2}]
GeoGraphics[NightHemisphere[], GeoProjection "Mercator"]
With[{pos =
PixelValuePositions[
Rasterize[Style[Pi, 70, FontFamily -> "Times"],
ImageResolution -> 72], 0]},
Graphics@
MapThread[Text, {Characters@ToString@N[Pi, Length[pos] - 1], pos}]]
ContourPlot[
Abs[1/(x + I y) - Floor[1/(x + I y)]], {x, -1.1, 1.1}, {y, -1.1,
1.1}, Exclusions {}, MaxRecursion 3]
Row[Labeled[
ChemicalData[#, "SpaceFillingMoleculePlot"], #] & /@ {"Water",
"Ethanol", "Caffeine", "Aspirin", "Sucrose"}]
Grid[Partition[
ColorNegate[ColorCombine[#]] & /@
Take[Permutations[
ColorSeparate[Entity["Planet", "Earth"]["Image"]]], 6], 3],
Spacings {0, 0}]
ParametricPlot3D[
1.2^v {Cos[v] (1 + Cos[u]), -
Sin[v] (1 + Cos[u]), -2 (1 + Sin[u])}, {u, 0, 2 Pi}, {v, -15, 6},
PlotRange All, PlotPoints 40]
Rasterize@
Graphics[{Opacity[.05], PointSize[0],
Point[NestList[{Sin[2 #1[[2]]] - Cos[2 #1[[1]]],
Sin[-#1[[1]]] - Cos[2 #1[[2]]]} &, {.5, .5}, 10^6]]}]
Row[Style[#, 8 + 6 #, Hue[#/17, 1, .7]] & /@
First[RealDigits[Pi, 10, 150]]]
SectorChart[RandomReal[10, {10, 300, 2}],
ColorFunction "DeepSeaColors", ChartStyle EdgeForm[None],
PerformanceGoal "Speed"]
Grid@Partition[#["Image"] & /@
Take[Entity["Person", "JackNicholson::4w8dc"]["MovieAppearances"],
6], 3]
Colorize[
Blur[ImageEffect[
ImageAdjust[
ImageResize[ Entity["Person", "AdaLovelace"]["Image"],
300], {-.3, .2}], {"Comics", {.27, .3}}], 2],
ColorFunction "TemperatureMap"]
p = PixelValuePositions[
Binarize[Rasterize[Style[, 80], ImageResolution -> 72]],
0]; Graphics[Line[p[[FindShortestTour[p][[2]]]]]]
MatrixPlot[
Table[(a + b)/((b^2 + a^2 - 2)^3 + b^2 a^3), {a, -2.5, 2,
0.01}, {b, -2.25, 2.25, 0.01}]]
Graphics[
BSplineCurve@
Transpose@{Im@#, Re@#} & /@ (Accumulate[b = 1;
Table[b = .67 E^(#[[i]] I) b, {i, 12}]] & /@
Tuples[{-Pi/3, Pi/6}, 12])]
Graphics[
NestList[Scale[#, 1/2, {0, 0}] &,
CirclePoints[
3] // {Triangle[#], White, Disk[{0, 0}, 1/2], Disk[2/3 #, π/19],
Black, Rotate[Disk[3/8 #, 1/8], 60 °, {0, 0}]} &, 3]]
Print@Dynamic[Image[aa]]; aa = DiskMatrix[10, 300]; Do[
Image[aa = Rescale[aa - GradientFilter[aa, 3]]], {1000}];
ContourPlot[Evaluate[Re[Product[
x + I y - (a + I b), {a, -5, 5}, {b, -5, 5}]]], {x, -5, 5},
{y, -5, 5}, ColorFunction "SolarColors"]
c = EntityValue[CityData[{Large, "France"}],
"Position"]; GeoGraphics[{Red, Thick,
Line@c[[Last[FindShortestTour[c]]]] }]
Grid[Partition[Table[GeoGraphics[GeoDisk[
Entity["City", {"LasVegas", "Nevada", "UnitedStates"}],
Quantity[10^(3 + n), "Meters"]],
GeoProjection "Bonne"], {n, 4}], 2]]
Graphics3D[{Red, Specularity[White, 20],
KnotData[{8, 3}, "ImageData"]},
Boxed False, ViewPoint {0, 0.1, 5}]
ArrayPlot[
CellularAutomaton[{Round[Mod[Total[#]/2.96, 1], 10^-4] &, {},
1}, {{1}, 0}, {{1250, 1500}, {-125, 125}}]]
DiscretizeRegion[
ImplicitRegion[(x^2 + 3 y^2 + z^2 - 1)^3 - x^2 z^3 - y^2 z^3/10 ==
0, {x, y, z}]]
With[{j = Cases[Entity["PopularCurve", "ApplejackCurve"]["Plot"],
_Line, Infinity]}, Graphics[Table[{Hue[0, 1, .9],
Rotate[j, x Degree, {0, 600}]}, {x, 1, 360, 72}]]]
SmoothHistogram[Legended[First /@
StringPosition[ExampleData@{"Text",
"AliceInWonderland"}, #], #] & /@ {"Alice",
"Queen"}, Filling Axis]
a = ImageData[Entity["Person", "ElvisPresley"]["Image"]];
Grid[Partition[
Image /@
Table[a = Rescale[a - GradientFilter[a, 3]], {71}][[
31 ;; 1 ;; -10]], 2]]
Graphics3D[{Red, Table[Rotate[Cuboid[
{-0.9^k, -0.9^k, .05 k}, {0.9^k, 0.9^k, .05 (k + 1)}],
k 0.1, {0, 0, 1}], {k, 0, 60}]}]
ListPlot[{Re[#], Im[#]} & /@ Flatten[
Table[(a + b I)^3, {a, -3, 3, 1/10}, {b, -3, 3, 1/10}]],
AspectRatio 1, Axes False, PlotStyle Red]
t = Table[y[r] /. NDSolve[{y'[x] Sin[x + Sin[x]] +
Cos[y[x]], y[a] b}, y, {x, 0, 15}], {a, 0, 10}, {b, 0,
15}];
Plot[t, {r, 0, 13}, Axes None]
NestList[EdgeDetect, BarcodeImage[
"http://www.wolfram.com/codecards", "QR"], 3]
Row[Style[#, RandomColor[], RandomInteger[
{15, 45}]] & /@ Characters[StringTake[
ExampleData[{"Text", "AliceInWonderland"}], 200]]]
Graphics3D[{RGBColor[#/5], Opacity[.8],
Cuboid[#, # + .8]} & /@ Tuples[
Table[Range[5], {3}]]]
GeoGraphics[{EdgeForm[Black], {GeoStyling[
{"Image", #["Flag"]}], Polygon[#]} &
/@ Entity["GeographicRegion", "Africa"]["Countries"]},
GeoBackground White]
ReliefPlot[GeoElevationData[Entity["Country", "China"]],
ColorFunction "Rainbow"]
Graphics3D@{Riffle[Table[Hue[i/20], {i, 0, Pi, .006}],
Ball[#, .1] & /@ Table[{.01 Cos@t - Cos[99 t] Sin@t,
.01 Sin@t - Sin[99 t], t}, {t, 0, 4, .006}]]}
Graphics[Table[Rotate[Line[Table[{x, (x Pi)
Sin[26 Pi a] Sin[3.1 x]/44}, {x, 0, 2 Pi, .1}]],
2 Pi a, {0, 0}], {a, 0, 1, 1/270}]]
Column[{#, DominantColors[#]}, Alignment Center] & /@ RandomSample[
DeleteMissing[#["Image"] & /@
Entity["Person", "JacksonPollock::wy7ry"][
"NotableArtworks"]], 4]
Graphics[{Thick,
Cases[Entity["PopularCurve", "QueenElizabethIICurve"]["Plot"],
Line[x_] {RandomChoice[ColorData[83, "ColorList"]], Arrow[x]},
Infinity]}]
Normal[PolyhedronData["Icosahedron"]] /. {Polygon[p_]
{Texture[ImageRotate@Entity["Person", "JohannesKepler"]["Image"]],
Polygon[p, VertexTextureCoordinates Tuples[{0, 1}, 2]]}}
SphericalPlot3D[Log[s] + Sin[t], {s, 0, 2 Pi}, {t, 0, 2 Pi},
PlotStyle Yellow, Mesh None, PlotPoints 30,
ViewPoint -> {3, 2, -1}, ViewVertical -> {-1, 0.5, .2}]
s = Sphere; Graphics3D[{s[{-2, 1, 0}], s[{-2, -1, 0}], Yellow,
s[{-4, 0, -1}, 3], Gray, s[{-1, 1, .4}, .2], s[{-1, -1, .4}, .2]},
ViewPoint {3, -1, 0}]
ImageMultiply[
Rasterize@Style[, 300, #] & /@ {Blue, {Red, FontFamily "Times"}}]
s = Sphere; Graphics3D[{s[], s[{0, 0, -3}, 2], Orange,
Cone[{{0, 0, 0}, {0, -2, 0}}, .5], Gray,
s[{{.3, -1, .6}, {-.3, -1, .6}}, .2]}]
