Tag Info

Hot answers tagged

20

The following is something I made while trying to solve another (similar) problem (* FindCurvedPath Replacement*) ClearAll[findCurvedPath2, findClosedPath2]; findClosedPath2[inptList_] := Append[#, #[[1]]] &@findCurvedPath2[inptList] findCurvedPath2[inptList_] := Block[{$RecursionLimit = Round[2.1 Length@inptList], ...


12

Since your image is binary, you can just pick out the top-most point in each column of the data matrix: img = Import["http://i.stack.imgur.com/Z7rKJ.jpg"]; dat = Transpose[ImageData@EdgeDetect[img]]; {c, r} = Dimensions[dat]; points = r - Min[Flatten@Position[dat[[#]], 1]] & /@ Range[c]; np = Interpolation[points, InterpolationOrder -> 1]; ...


11

I was stuck for a while with a not really acceptable result, but then @belisarius posted his answer and I was able to refine my code with the usage of his findCurvedPath2 function. So I am able to post my solution to the problem. First, import and process the image: img = Binarize@Import["http://i.stack.imgur.com/Z7rKJ.jpg", "JPEG"]; imgc = ...


8

It really helps others reading your code if you split things up and name parts of the code. Let's start with the polynomial. polynomial[k_] := Total[x^Range[0, 20, 3]] + k x^3; and the function that finds the roots, and the function that visualizes them roots[poly_, x_] := roots[poly, x] = Through@*{Re, Im} /@ (x /. NSolve[poly, x]) frame[k_, opacity_] ...


8

Off[Solve::ztest]; var = {R, r, a, p, s}; assume = Join[ Thread[var > 0], {R > r, Element[n, Integers], n > 2}]; eqns = { R == s*Csc[Pi/n]/2, r == s*Cot[Pi/n]/2, a == n*s^2*Cot[Pi/n]/4, p == n*s}; sol = Reverse[Assuming[assume, Simplify[Solve[ Join[eqns, assume], #, Reals][[1]] & /@ Select[ ...


4

Manipulate[ {Text[Style["Area =" <> ToString[N@n Cos[ (180 Degree)/n] Sin[(180 Degree)/n]], Italic]], Graphics[ {Circle[], {Yellow, Polygon[Table[{Cos[θ], Sin[θ]}, {θ, 0, 2 π, 2 π/n}]]}}]}, {n, 3, 50, 1}]


4

For the vertices to be correctly movable their primitives must be positioned using the indexes of GraphicsComplex rather than direct Graphics coordinates. This way all primitives with the same index move together. I don't know of a way to make VertexRenderingFunction use these indexes natively, though I have not explored it. However since the default ...


4

Most of your lines are "multipoint" and your color function doesn't support them well. You can enforce "two points lines" by doing something like this (I'm following your map code styling here): Show[Graphics[{AngleColor[#[[2]] - #[[1]]], Line[#]}] & /@ Partition[#, 2, 1] & /@ # & /@ testD, Background -> Black, ImageSize -> 800] ...


2

DiscretizeGraphics already hands out a MeshRegion, so you could go along these lines: meshonly = With[{coords = MeshCoordinates[displot]}, MeshCells[displot, 1] (* 0: points, 1: lines, 2: faces ... *) /. Line[{a_, b_}] :> Line[{coords[[a]], coords[[b]]}]] Graphics3D@meshonly This will also work for your the more exotic shape you ...


2

I understand the down voting for this question. However, for fun: p[n_] := {Cos[2 Pi #/n], Sin[2 Pi #/n]} & /@ Range[0, n] piapp[n_] := With[{pg = Polygon[p[n]]}, Graphics[{Circle[], Red, pg, Text[Style[N@n Sin[2 Pi/n]/2, White, 16], {0, 0}]}, ImageSize -> 300]] anim = Table[ Row[{ piapp[num], ListPlot[Table[{j, N@j Sin[2 ...


1

Are you sure NIntegrate won't work? ρ[θ_?NumericQ,ϕ_?NumericQ] := sol[θ,ϕ] SphericalPlot3D[ρ[θ,ϕ], {θ, 0, π}, {ϕ, 0, 2 π}] NIntegrate[ρ[θ,ϕ]^3/3 Sin[θ], {θ, 0, π}, {ϕ, 0, 2 π}] Assuming that sol[θ,ϕ] returns the value of your function.


1

It is a bug. although adding one non-polygon to the list makes everything work: GeoRegionValuePlot[ Join[{Entity["City", {"LosAngeles", "California", "UnitedStates"}] -> Quantity[577.6458106034206`, ("People")/("Miles")^2]}, Thread[nmpgons -> nmpopdensity]], ColorFunction -> ColorData["Rainbow"]]


1

LayeredGraphPlot[set, EdgeRenderingFunction -> ({If[MemberQ[set /. Rule -> List, Reverse@#2] && ! SameQ @@ #2, Black, Blue], Arrow[#1, 0.1]} &)] Remove the SameQ check if you want self-loops to be considered a hit. If you expect lager graphs, probably wise to pre-compute some stuff... Per OP comment, ...


1

data = {{-0.5, 0.2}, {0.7, 0.1}, {1.4, -0.1}}; pr = {{-1.5, 4}, {-1, 1}}; L0 = ListPlot[data, PlotStyle -> {Black, PointSize[Large]}, Frame -> True, AspectRatio -> First[1/Divide @@ (Differences /@ pr)], PlotRange -> pr]



Only top voted, non community-wiki answers of a minimum length are eligible