New answers tagged

1

GUIScreenShot is basically an easy to use wrapper for java.awt.Robot's screen shot functionality. So it's probably that. I haven't looked at that for a while, but I don't think there's a way to .. recognize that some function is changing the screen dimming.


4

This may be messy indeed, but it gets us scalable vector graphics: w = 10; r = 1.2; h = 3.5; dt = π/40; pts = { {0, 0}, {w, 0}, Sequence@@Table[{w, 0} + r { Sin[t], 1 - Cos[t]}, {t, dt, π/2 - dt, dt}], {w + r, r}, {w + r, h}, Sequence@@Table[{w, h} + r { Cos[t], Sin[t]}, {t, dt, π/2 - dt, dt}], {w, h + r}, {0, h + r}, Sequence@@Table[{0, ...


3

Using a tweaked version of my answer here and a graphics expression which draws the rectangle outline separately: texturedShape[img_, shape_] := Module[{g, p, ar, i}, g = Graphics[shape, PlotRangePadding -> 0]; p = Polygon[AbsoluteOptions[g, PlotRange][[1, 2]] /. {{l_, r_}, {b_, t_}} :> {{l, b}, {l, t}, {r, t}, {r, b}}, ...


3

In the same spirit of Sjoerd's answer, you can "steal" the theme-generated directives and replace them in the target plot. With a dummy plot created using the desired theme, dummyPlot = Plot[{1, 2, 3}, {x, 0, 1}, PlotTheme -> "Monochrome"] You can collect the generated directives, directives = Cases[dummyPlot, Directive[a__] :> List@a, ...


11

Example plot: Plot[{Cos[x], Sin[x], Tan[x]}, {x, 0, 2 π}] Now, just copy this plot from the notebook (using ctrl-C) and paste it in the front of following expression: /. a : RGBColor[__] :> ColorConvert[a, "Grayscale"] The result:


3

Not sure about your strategy generating the data, but provided you have already defined {rGraphicsList, bGraphicsList, blGraphicsList}, then you can do ListAnimate[ Show @@@ Transpose[ {rGraphicsList, bGraphicsList, blGraphicsList} ] ] Here @@@ stands for Apply as in Apply[f,expr,{1}] or f@@@expr replaces heads at level 1 of expr by f. ...


5

Your creation of xy[t_]=... is not a good idea in the sense that xy[anything] produces a static table. Try xyPointList = Module[{t}, Table[If[t < 1, {x[0] = 0, y[0] = RandomReal[{-1, 1}]}, {x[t] = x[t - 1] + RandomReal[{0, 1}], y[t] = y[t - 1] + RandomReal[{-1, 1}]}], {t, 0, 10}]] (* {{0, 0.0251049}, {0.211352, 0.0367706}, ...


4

I am precomputing an Array of random numbers from 0 to 1 for x and -1 to 1 for y that will be the displacements. To that I Prepend {0,0} to define a fixed initial position. Then I Accumulate that list for a successive accumulated totals of elements. Then use Interpolation so the function is also defined at any arbitrary position between points. xy = ...


1

Indeed, there is a bug, as I noted in a related answer, and a bug report has been submitted by @Peeter Joot in 2013. As a temporary fix for the issue (hoping that the bug will get resolved in the near future after more than two years), you could use the following modification of the plotting function in the question: volumetricPlot[latticeType_] := Module[ ...


1

If there is a need to preserve initial structure of the code, some condition may be an option: Manipulate[ dom = {-10, 10}; If[Not[NumericQ[f]] || Not[Between[f, dom]], f = 0]; Plot[a Sin[2 Pi f t/12], {t, 0, 12}, PlotRange -> {{0, 12}, {-1, 1}}, AspectRatio -> 0.5, Frame -> True, Axes -> True, ImageSize -> 800], Row[{ ...


1

You can avoid trouble by choosing reasonable values for the range and increment of your controls. The following choices work well. Manipulate[ Plot[a Sin[2 Pi f t/12], {t, 0, 12}, PlotRange -> {{0, 12}, {-1, 1}}, AspectRatio -> 0.5, Frame -> True, ImageSize -> 700], Row[{ Control[{{f, 1, "frequency"}, 0, 10, 0.01, ...


1

Why not just use EdgeForm and FaceForm directly instead? points = {{0, 0}, {4, 0}, {3, 3}}; triangle = Triangle[points]; circle = Insphere[points]; Graphics[{ circle, { FaceForm[{Yellow,Opacity[0]}], EdgeForm[{Thick,Black}], triangle } }]


3

To make it automatic without rasterizing use ImageSize->Full: Graphics[Text@Framed@Style[FooBarFooBarFooBarFooBarFooBarFooBar, 18], ImageSize -> Full] or Graphics[Text@Framed@Style[FooBarFooBarFooBarFooBarFooBarFooBar, 18], ImageSize -> {Full, Automatic}]


3

It looks like the front end method to determine the width does not account for the full size of the frame. To fix/work around you can add margins to the text and rasterize before passing it to Graphics: Graphics[ Rasterize[ Text[Framed[Style[FooBarFooBarFooBarFooBarFooBarFooBar, 18], ImageMargins -> 50]], RasterSize -> 800]] EDIT As ...


1

I think MarcoB suggestion, made in a comment, should be put on record. x = Sin[(π t)/3] (Exp[Cos[(π t)/2]] - Sin[π t] + Sin[(π t)/(3 12)]^5); y = Cos[(π t)/3] (Exp[Sin[(π t)/2]] - Cos[π t] + Sin[(π t)/(3 12)]^5); With[{a = 0, b = 30 π}, ListPlot[Table[{x, y}, {t, a, b, .02}]]]


1

The simplest way I thick is to use Dynamic["your function"] instated of 1 in your controller. Control[{{A, 0.1, "Amplitude"}, 0, Dynamic["your function"], 0.01, Appearance -> {"Labeled", "Closed"}}] I think this will give you want you want, (assuming the function of the end is f+1): Manipulate[ Plot[A Sin[2 Pi f t/12], {t, 0, 12}, PlotRange -> ...


4

As Sjord C. de Vries says in the comments the required stencils can be made with the standard graphics functions. Probably it is better or easier to use some of the new Region and finite element functions. 2D grid Here is code using Graphics primitives: points = Table[{i, j}, {i, 1, 6}, {j, 1, 5}]; grid = Join[ Map[Line /@ Partition[#, 2, 1] &, ...


7

Try this ContourPlot[Cos[x - y] + Sin[x^2 + 3 y], {x, -3, 3}, {y, -3, 3}, PlotTheme -> "Monochrome",ContourStyle -> Directive[White, Opacity@.1]] You can also use ColorFunction -> ColorData["GrayTones"] for gray shades or even write your own following the reference.


4

The width returned by Rasterize is not always correct, as you found out, and since you aren't going to Rasterize before building your tree then the size of the raster graphics is irrelevant in this case. This is the best way to get the size of the text cell (thanks to Sjoerd C. de Vries), {w1, h1} = ImageDimensions@ImageCrop@Graphics@ExpBox[Fooooo/2]; {w2, ...


2

I find it difficult to understand this question but I shall assume you have a series of Polygon expressions in a GraphicsComplex. v = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}; gr = Graphics[GraphicsComplex[v, Polygon[{1, 2, 3, 4}]]]; If you use Normal you get the actual coordinates from v: Normal[gr] // InputForm Graphics[{Polygon[{{1, 0}, {0, 1}, {-1, 0}, ...


2

You need this method i think: P1 = Plot[Sin[x], {x, 0, 6}]; P2 = Plot[Sin[x], {x, 0, 6}, AxesStyle -> Opacity[0]]; Overlay[{P1, P2}]


8

Normal[# /. a : Arrow[{__List}, Except[_List]] :> Thread @ a] gives a quick fix for these examples.


2

A workaround This long-term bug is a constant source of pain for Mathematica users for many years. After years of customization of plots "by hands" I have figured out what happens and developed a general approach which allows to get the expected output with as little pain as possible. It was even necessary to develop special technical vocabulary in order to ...


10

Hunting through the stylesheets is effective, but does not necessarily give you the current value being used if it has been modified. Instead, use CurrentValue[{StyleDefinitions , "GraphicsAxes"}] (* {Arrowheads -> {}, LineColor -> GrayLevel[0.4], Thickness -> Absolute[0.2]} *) CurrentValue[{StyleDefinitions , "GraphicsFrame"}] (* {LineColor -> ...


6

The styles "GraphicsAxes" and "GraphicsFrame" are defined in the stylesheet "Core.nb". To access to this file use the menu : format/edit stylesheet Then in the notebook that appears click on Default.nb In the new notebook that appears click on Core.nb Then the notebook core.nb appears. Go to section :"style for Mathematica System-specific ...


5

DateObject seems to get the job done, e.g.: "Yayoi" -> Interval[{DateObject[{-300}], "250"}]


2

You could export it in one of the formats supported by the printer. For example: g = Graphics3D[Ball[]]; Export["ball.stl", g]


10

The way to figure this out is first to listen to the error messages. You got as an error An improperly formatted option was encountered while reading a Graphics. If you are new to Mathematica that may not mean anything to you, but it is answered by #1 below. Next strategy is to cut everything out until it works. Here Graphics[{{RGBColor[0.976577, ...


3

I would not claim that the following is smarter, but it is different in most respects. It gathers contiguous triangles with parallel normal vectors, extracts the vertices and eliminates duplicates, constructs polygons from those vertices, and plots the polygons to form the desired object. poly = MeshPrimitives[ConvexHullMesh[point], 2]; cros[x_] := ...


13

tl;dr Playing with your code I found that using Rasterize is a mayor pain in the behind because of various reasons (RasterSize is, at least for me, not working as advertised in the documentation; I found no easy way to remove padding around letters and get a nice $n \times n$ representation of each letter, get each letter the appropriate size, issues with ...


2

Not very clean: v = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}; r = Normal /@ {Graphics[GraphicsComplex[v, Polygon[{1, 2, 3, 4}]]], Graphics[GraphicsComplex[v, {Red, Line[{1, 2, 3, 4, 1}]}]]}; r /. {Red, Line[x__]} :> (FilledCurve@Line@x)


3

Here is an example using geometrical region functions: Manipulate[ pointoncircle = RegionIntersection[ Circle[{0, 0}, r], Circle[{1, 0}, 1], HalfPlane[{{0, 0}, {1, 0}}, {1, 1}] ]; ray = HalfLine[{{0, r}, pointoncircle[[1]]}]; pointonaxis = RegionIntersection[ray, InfiniteLine[{{0, 0}, {1, 0}}]]; Graphics[{ Circle[{0, 0}, r], ...


3

I changed your image processing code a bit, by removing the unnecessary DeleteSmallComponents and removing the white lines using Closing. I also added a line to detect the pixel above the center. img = Import["http://i.stack.imgur.com/nQmQI.png"]; edge = MorphologicalPerimeter[Closing[ColorNegate@img, DiskMatrix[1]]]; coordinatescontour = ...


15

ColorFunction and Epilog were around in version 7. However, ColorFunction did get an update in version 9 so I am not certain if this will work in version 7. Animate[ ParametricPlot[circle[t], {t, Max[0, u - .2], u}, PlotRange -> {{-dMax, dMax}, {-dMax, dMax}}, ColorFunction -> Function[{x, y, w}, Opacity[w, Blue]], Frame -> True, Axes ...


2

Look what you get: Table[(x^3 - 2 x)^Log[x], {x, 0.1, 1, 0.1}] {23.9206 - 33.4926 I, 1.52163 + 4.25002 I, -1.56727 + 1.16885 I, -1.27875 - 0.344258 I, -0.625532 - 0.901147 I, -0.0342845 - 1.00769 I, 0.426687 - 0.882703 I, 0.749933 - 0.632977 I, 0.938908 - 0.322649 I, 1. + 0. I} You can plot the real and imaginary part: Plot[Evaluate@ReIm[(x^3 - 2 ...


4

This basically directly computes the angle that a line drawn from the origin to the point makes with the horizontal axis, and uses this to sort: list = {{100, 200}, {200, 300}, {300, 300}, {320, 150}, {250, 210}, {350, 220}, {380, 100}, {390, 300}}; ordList = SortBy[list, Apply[N[ArcTan[#1, #2]] &]] (* {{380, 100}, {320, 150}, {350, 220}, {390, 300}, ...


14

Let us imagine that we move polyhedron faces a bit: name = "Icosahedron"; {poly, net} = PolyhedronData[name, {"Faces", "NetFaces"}]; Graphics3D[Normal@poly /. Polygon@pts_ :> Polygon@Transpose[.9 Transpose@pts + .1 Mean@pts]] Now we can construct a graph in the following way: each face corresponds to a triangle fan (gray lines below). The center ...


2

Intuitive noobish way to program this. Table[CoefficientList[(x + 1)^i, x], {i, 0, 10}] I hope this helps other beginners :) use MatrixForm to visualise!


0

data={{150630102506,17.1429}, {150630102606,17.1429}, {150630102706,19.0476}, {150630102806,20.}, {150630102906,15.2381}, {150630103006,27.619}, {150630103106,20.}, {150630103206,16.1905}, {150630103306,14.2857}, {150630103406,18.0952}, {150630103506,12.381}, {150630103606,19.0476}, ...


3

This is more or less directly cribbed from the help: Manipulate[Graphics[{color, Polygon[CirclePoints[sides]]}], {{sides, 3,"Number of Sides"}, 3, 17, 1}, {color, Green}]


3

I believe this is the natural and idiomatic way to do it: Manipulate[Graphics[{colour, Polygon[CirclePoints[sides]]}], {sides, 3, 17, 1}, {{colour, Orange}, {Green -> "Green", Orange -> "Orange"}} ]


3

TabView is for viewing. You can associate color changes with the second argument of TabView but it will be easier to just use what is designed for that, like SetterBar. Moreover, the less inside Dynamic the better so instead of creating whole Graphics you can just tell the FrontEnd to take care of that colour and Polygon. DynamicModule[{p = 3, colour = ...


3

For example (Partial order here is vertex reachability) SeedRandom@42; << Combinatorica` g = System`RandomGraph[{9, 7}, VertexLabels -> "Name"]; g1 = System`Graph[VertexList@g, DirectedEdge @@@ EdgeList@g]; ShowGraph[ HasseDiagram[ MakeGraph[VertexList[g1], GraphDistance[g1, #1, #2] =!= Infinity &]], VertexNumber -> ...


5

This also works for me in 10.1.0 under Windows 7 x64. Take a look at your rendering settings; referencing Graphics3D: Opacity limitations this is affected by DepthPeelingLayers for example. plot = Graphics3D[{Opacity[0.1], Line[RandomVariate[ MultinormalDistribution[{0, 0, 0}, {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}], 1000]]}]; Table[ Show[plot, ...


16

Komei Fukuda investigated the problem and developed a few nice software packages to address it and optimise the computation complexity. This answer uses Fukuda's codebase. Just to help understanding the non-triviality of the problem, here are a few simple but pathological cases and the debunking of two conjectures: Is every unfolding of a convex polytope ...


1

Saved as a movie in mov format: SetDirectory@NotebookDirectory[]; Figure1[c_] := Plot[c + Log[2, x], {x, -2, 2}]; {a, b} = {2, 3}; m1 = Manipulate[ Show[Figure1[c], PlotRange -> {{-a, a}, {-b, b}}], {c, -1, 3, .0001} ]; Export["movie.mov", m1]; Figure2[c_] := Plot[c + Log[2, x + c], {x, -3, 3}]; {a, b} = {3, 3}; m2 = Manipulate[ ...


3

Perhaps this example could be helpful: pts = RandomReal[1, {10, 2}]; ch = VoronoiMesh[pts]; mp = MeshPrimitives[ch, 2]; ml = MeshPrimitives[ch, 1]; mpt = MeshPrimitives[ch, 0]; Graphics[Riffle[RandomColor[Length@mp], mp]~Join~{Red, Thick, ##} & @@ ml~Join~{Blue, PointSize[0.02], ##} & @@ mpt]


23

Intro This is completely different approach, since what we know about the net is not enough and the relation between faces and net faces isn't included, let's create the net from the polyhedron. The only issue with the present code is that the net is generated automatically and doesn't have to be the same as the one in PolyhedronData. The idea is to ...


19

TL;DR; The mapping from "Icosahedron" faces' indices to net faces' indices is given by: {9 -> 10, 19 -> 20, 8 -> 19, 10 -> 17, 7 -> 9, 20 -> 8, 12 -> 18, 13 -> 15, 6 -> 7, 3 -> 6, 2 -> 16, 4 -> 13, 16 -> 5, 5 -> 4, 1 -> 14, 15 -> 11, 14 -> 3, 18 -> 2, 11 -> 12, 17 -> 1} but the answer isn't ...


1

Here's some fake data: pts = RandomReal[{-.2, .2}, 37] + (Cos[.1 #] & /@ Range[-1, 35]) // Thread[{Range[-1, 35], #}] & Make a plot without the frame that clips the data in the x direction but not in the y direction (by having an extended y range): plot = ListPlot[pts, InterpolationOrder -> 3, Joined -> True, Frame -> False, Axes ...



Top 50 recent answers are included