Tag Info

New answers tagged

0

I guess this could be solved by defcol[n_] := ColorData[1, "ColorList"][[n]]; Legended[Plot[{Sin[x], Sin[x]^2, Cos[x]}, {x, -2 \[Pi], 2 \[Pi]}], Placed[LineLegend[ {defcol[1], defcol[2], defcol[3]}, {"S", "S2", "C"}, LegendLayout -> "Row"], {0.5, -0.1}]] The position of Legend is defined by option {0.5, -0.1} This could be applied for any ...


2

After tracing through ColorFunction, I found the gradients live in the list DataPaclets`ColorDataDump`gradientSchemeMain and "RedBlueTones" corresponds to the 14th position. DataPaclets`ColorDataDump`gradientSchemeMain[[14, 5]] (* {RGBColor[0.450385,0.157961,0.217975],RGBColor[0.599449,0.262748,0.294618], ...


1

With the caveat that this has an answer up to scaling, one can write a function that creates a NearestFunction object that converts from RGBColor triplets to z-values at the unit interval: ClearAll[colorSchemeToUnitZ]; colorSchemeToUnitZ[ColorScheme_String, resolution_: 100] /; (MemberQ[ ColorData["Physical"]~Join~ColorData["Gradients"], ...


0

You could do this: pixelData = ImageData[Import["img.jpg"], "Real32"]; fit[u_, v_, w_] = Normal[LinearModelFit[Table[Append[List @@ Blend["RedBlueTones", #] &[t], t], {t, 0, 1, 1/1000}], Flatten[Table[u^i v^j w^k, {i, 0, 2}, {j, 0, 2}, {k, 0, 2}]], {u, v, w}]]; Plot[fit @@ Function[Blend["RedBlueTones", #]][t] - t, {t, 0, 1}](*Error of fit*) getZ[x_, ...


7

Translate can translate a single graphics primitive by certain offsets, but it's not really "moving" anything. Rather it creates a copy and puts it on the specified location. If you give it several locations it will create several copies. RGBColor[RandomReal[],RandomReal[],RandomReal[]] will only be called once because each is a copy of the other. But if you ...


1

Specifying EdgeForm resolves the country borders. Latitude and longitude...well here is a clumsy way. Depending on your desired grid you may have to clean up conversion. myc[name_] := If[name == "UnitedStates", Red, Lighter[Gray]] lat = Quiet[ Line /@ Table[ Table[GeoGridPosition[GeoPosition[{j, k, 0}], "WinkelTripel"][[1, {1, 2}]], {j, ...


7

The reason your original code fails is that the TreeFrom object is only formatted as Graphics object, meaning that it converted for display rather that as part of the normal evaluation sequence. You can convert to and from box form to recover your Graphics object: tf = TreeForm[a + b^2 + c^3 + d]; gr = tf // ToBoxes // ToExpression gr /. (x_Framed ...


2

Building on swish's answer, I would write nodes = Cases[Network`GraphPlot`ExprTreePlot[a + b^2 + c^3 + d], _Framed, ∞]; This has the advantage of allowing you to work with the individual node objects; for example: nodes[[2]] If want output that looks like your printed output just evaluate Column@nodes


4

From this answer Network`GraphPlot`ExprTreePlot[a+b^2+c^3+d] /. (x_Framed :> Print[x])


3

Original Bresenham I guess I can come of with a somewhat shorter implementation without using Reap and Sow. If someone is interested, it follows almost exactly the pseudo-code here bresenham[p0_, p1_] := Module[{dx, dy, sx, sy, err, newp}, {dx, dy} = Abs[p1 - p0]; {sx, sy} = Sign[p1 - p0]; err = dx - dy; newp[{x_, y_}] := With[{e2 = 2 err}, ...


0

Another approach to this problem is to use the image processing functions and operate directly on the image of the lines. Here we import the two lines from the OPs question, and take the DistanceTransform. Finding the value of the distance transform at the orange point gives the distance (in pixels) of that point from that line. img = ...


4

Wrong use of Graph in this case I believe. I think the following does what you're after: Graphics3D[{FaceForm[], EdgeForm[Blue], PolyhedronData["GreatRhombicosidodecahedron", "Faces"], PointSize[Large], Red, Point /@ PolyhedronData["GreatRhombicosidodecahedron", "VertexCoordinates"]}, Boxed -> False]


5

I was surprised that Graph supports 3D coordinates at all (!!). Layout algorithms supported in Graph are 2D only. The problem doesn't seem to be with Graph itself but the Graphics3D object it translates to. Here's a smaller example of the same: Show@Graph[{1 -> 2}, VertexCoordinates -> {1 -> {0, 0, 0}, 2 -> {1, 0, 0}}] Show converts it to a ...


6

Maybe try something like ClearAll@plotter plotter[s_, h_] := plotter[s, h] = ListPlot[RecurrenceTable[{x[t + 1] == N[(x[t]^2 + x[t] (1 - x[t]) (1 - s h))/(x[t]^2 + 2 x[t] (1 - x[t]) (1 - s h) + (1 - x[t])^2 (1 - s))], x[0] == 7}, x, {t, 0, 16}] , PlotRange -> {0, 1} ] Manipulate[plotter[s, h], {{s, 1}, 1, 5, 1}, ...


1

Rasher's code will be usefull here but we also have to Scale all the obcjets which is easy but no so simple as - in case of Plot. Graphics[ Scale[#, {1, -1}, {0, 0}] &@{Circle[{2, 2}], Arrow[{{3, 2}, {5, 3}}]} , Axes -> True, AxesOrigin -> {0, 0}, BaseStyle -> {15, Bold}, AxesStyle -> {Arrowheads@.05, Arrowheads[{-.05, 0}]}, Ticks ...


3

I reported this to WRI tech support on March 9th and, finally received an answer today. As I promised in a comment to the question, here it is (somewhat edited). My apologies for the delay in getting back to you. Just wanted to let you know that I was unable to find a resolution for this issue and have forwarded an incident report to the ...


5

It is always nice to have alternative solutions. The following sets up a function which holds its value until a larger value is presented to it. rMax[ts_] := Block[{max = -\[Infinity], rmax}, rmax[x_ /; x <= max]:= max; rmax[x_]:= (max = x; x); rmax /@ ts ] Lets generate some data and extract out the states. SeedRandom[1321]; s = ...


4

Module[{s=4}, Show[ ListLinePlot[{SeedRandom[s];RandomFunction[WienerProcess[],{0,1,0.01}]},AxesOrigin->{0,0}], ListLinePlot[{SeedRandom[s];Apply[Transpose[{#1,FoldList[Max,First[#2],Rest[#2]]}]&, Transpose[First[Normal[RandomFunction[WienerProcess[],{0,1,0.01}]]]]]},AxesOrigin->{0,0}]]] Some, ahem, fannying around with First[Normal... ...


0

Here is another way to achieve what you want. It is neither very elegant nor very efficient, but should do what I think you try to achieve: highlight[text_String, rules_List] := Module[{positions, overlap = Underlined}, positions = SortBy[ Flatten[Thread[StringPosition[text, #1] -> #2] & @@@ rules, 1], First ]; positions = ...


2

Using the code for mark, from linked question: f[string_, cases_] := Module[{pos, agg, res}, pos = StringPosition[string, cases]; agg = {Switch[#[[ 1, 2]], 1, Blue, 2, Brown, _, Red], #[[ ;; , {1}]] } & /@ GatherBy[Tally@Flatten[Range @@@ pos], Last]; mark[string, agg] ] f["TheBrownFox", {"TheBrown", "BrownFox"}] ...


13

I have made several pictures very similar to this, using code similar to the one below: MakePic[f_, g_, off_, nlines_, col_, dim_] := Module[{g1, cf, lines}, g1 = ParametricPlot[{f[t], g[t + off]}, {t, 0, 2 Pi}, AspectRatio -> 1, Axes -> None, PlotStyle -> {{col, Thick, Opacity[0.2]}}]; lines = Line@Table[{f[t], g[t + off]}, {t, ...


13

A highly related concept would be envelope. Ruled surface could be a possible generalization to 3D. A simple way to find a family of lines given thier envelope curve is to use its tangent line family. Example 1: Suppose we have a curve describe in parameter u: pt = {Cos[u/2] Cos[u], Cos[u/2] Sin[u], .8 Sin[u]}; ParametricPlot3D[pt, {u, 0, 4 π}] So its ...


5

If I understand the question correctly, you want to plot $f(a,x)$ as a function of $a$ and $x$, except that $a$ takes discrete values and $x$ lies in a continuous range. Maybe something like f[a_, x_] := Exp[-x] x^(a - 1)/(a - 1)! Then the graph of $f$ isn't a surface but a collection of curves $x\mapsto f(a,x)$, one for each discrete value of $a$. You ...


2

You can combine the plots with something like Show: p1 = Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, PlotRange -> {{-3, 3}, {-2, 2}, {-1, 1}}] p2 =ListPlot3D[Flatten[Table[{x, y, Sin[-x + y^2] + .1}, {x, -3, 3, .1}, {y, -2, 2, .1}], 1], ColorFunction -> "SouthwestColors"] ...


16

I think you should not be looking at Graph, which is for graph plotting. This is really a graphics question. Looking at your example, I see one or more curves split into (equal?) segments, and then the division points connected with straight lines. So we can base this on this answer (please check there for the code). After dividing a single curve into ...


3

In the upcoming version (10?) there are useful BooleanRegion functions: {a, b} = {Disk[{-1/3, 0}, 1], Disk[{1/3, 0}, 1]}; RegionPlot@BooleanRegion[Xor, {a, b}] {a, b} = {Disk[{0, 0}, 2], Disk[{2, 0}, 2]}; RegionPlot[RegionDifference[a, b], Epilog -> {EdgeForm@Black, FaceForm@None, a, b}] Furthermore, regions can be more easily highlighted: {a, ...


1

Here is a demonstration of the problem. I don't know why it is happening exactly though, but it seems that a workaround is simply to keep the Magnification at or below 100%. SetAttributes[setOpt, Listable]; setOpt[cell_, mag_] := SetOptions[cell, Magnification -> mag]; probCell = With[{t = Table[Random[], {10000}]}, ...


3

Rotate is a quite strightforward function; it does what you want. You use Rotate on something that is not a Graphics primitive? No problem, it will give what you ask: Rotate[longvariablename, Pi/2] That is the problem in your approach: Y20 is not a graphics primitive so it will be treated as above. So you see you can't pass it to Show. It's no ...


4

You could do this already with AdministrativeDivisionData and GeoGraphics on Raspberry Pi. In general - some taste of the future: divisions = EntityValue[Entity["AdministrativeDivision", {_, "Sweden"}], "Entities"] GeoGraphics[{EdgeForm[Red], Opacity[0.1], Polygon[divisions]}]


3

How easy or hard this is depends on what data source you have. When I tackled this problem I couldn't find any ideal data source, I did however find a map on Wikimedia Commons in the SVG graphics format. Each municipality is stored as a polygon, and each polygon has an identification number. Upon further discovery, we realize that these ids are not random, ...


5

There is no built in option, however for the US it's very easy because the coordinates of the state borderlines are all over the Internet. This led me to one such data set. I'll include how I cleaned it up, like this: data = Import["http://econym.org.uk/gmap/states.xml"]; name[{"name" -> n_, ___}] := n coordinates[XMLElement["point", {"lat" -> lat_, ...


9

The order of arguments in Show makes a difference in two ways: The Graphics expression produced by Show will inherit options from the first argument The first argument will appear in the bottom layer, the last one in the top layer. The most common problem (1) causes is that the plot range is inherited from the first argument, causing parts of the second ...


3

There are several ways to do this. The structure of your 1d output is not optimal, because you get something like {{x1},{x2},...} which means a nested list. To make it short, if you want to use ListLinePlot, you can do it with the help of Epilog, which draws your first and last points on the final graphics: oneDim = RandomWalk[500, 1]; ...


4

Ok, here it is 1D, not sure if I understood the question right, but see if this what you want randomWalk[n_, d_] := Table[{RandomReal[{-1, 1}], 0}, {n}]; data = randomWalk[50, 1]; ListPlot[data, PlotStyle -> PointSize[.01], PlotRange -> {Automatic, {-.1, .1}}, Epilog -> {PointSize[.02], Red, Point[data[[1]]], Blue, Point[data[[-1]]]}]


4

Translate is probably the most efficient way to represent and display such a figure. With[{r = 30}, Graphics3D[{ Translate[Cuboid[], Union @@ (Permute[#, SymmetricGroup[3]] & /@ Coords[r]) ], {Green, Opacity[0.1], Sphere[{0, 0, 0}, r]} } ] ]


2

To answer the question of how to set the point size to precisely one pixel: use AbsolutePointSize[1]. PointSize specifies the point diameter relative to the graphics width. Points whose size is controlled by this directive change size when the graphics is resized. AbsolutePointSize will use printer's points for printable vector graphics (such as PDF) ...


3

data = Flatten[ Table[Table[{i, j} k, {i, 1, 50, .3}, {j, 1, 50, .3}], {k, 1, 10, .3}], 2]; Dimensions@data (*{833776, 2}*) You can also do something like: (here I've assumed that you know what is the range of the data - 500) m = SparseArray[Rule[IntegerPart[#], #2 ] & @@@ Tally[(200. Round[data/500., 1/200.] + 1.)]]; ...


2

Yes, this is surely possible because the graphics created with the Drawing Tools is just a normal Graphics object. Let me give you an example. I made a new drawing and assigned it to a variable: Now I can work with img in the same way I would do it with other graphics. For instance you could look at the code you have created: InputForm[img] (* ...


3

New, not the best but can do r = 50; da = Pi/(4. r); sa = da; ea = Pi/2. - da; Composition[ Graphics3D[{#, GeometricTransformation[#, ReflectionTransform /@ {{0, 0, 1}, {0, 1, 1}}] }, Axes -> True, PlotRange -> All, ImageSize -> 600] &, Cuboid /@ # &, {# - Sign[#], #} & /@ # &, Select[#, FreeQ[#, ...


5

Focusing only on syntax I think your code looks pretty good, but there are a few things I note that I think could be improved. The method f @@ # & /@ expr can be replaced with f @@@ expr, which is shorthand for Apply[f, expr, {1}]. See Apply. You can use the listability of Plus to write {x, y, z} - 1 instead of {x - 1, y - 1, z - 1} ...


0

OP has said: For example, I want the y direction of the cursor to correspond to pulling the z axis toward or away from me (the camera), and the x direction to rotate the graphic around the z axis. I don't know in which version it was introduced but "RotationControl" -> "Globe" does exactly what you are asking for. Graphics3D[Cuboid[], Method -> ...



Top 50 recent answers are included