Tag Info

New answers tagged

5

You can use EdgeShapeFunction: styles={Red, Directive[Dashed, Blue], Orange, Directive[Purple, Dashing[.01]], Green, Green}; i = 1; Graph[{a -> b, a -> b, a -> b, a -> b, a -> e, e -> b}, EdgeShapeFunction -> ({Arrowheads[Large],Thick,styles[[i++]],Arrow@#} &), VertexLabels->"Name"] If you have at most two edges ...


5

It looks like the new default plot colors in Mathematica 10 take into account colorblindness. http://www.wolfram.com/mathematica/new-in-10/enhanced-visualization/improved-styles-for-color-vision-impairment.html Here's a screengrab from that page.


8

I presume you're plotting a Fresnel zone plate. DensityPlot[Sin[50 Sqrt[1 + x^2 + y^2]]^2, {x, -1, 1}, {y, -1, 1}, PlotPoints -> 100, ColorFunction -> GrayLevel, Frame -> None] And if you'd like to overlap two Fresnel plates, just use Manipulate: Manipulate[ DensityPlot[ Sin[50 Sqrt[1 + x^2 + y^2]]^2 + Sin[50 Sqrt[1 + (x + dx)^2 + ...


3

I think a ContourPlot will do nicely here, as you suggested. The coloring can be obtained with the built-in GrayLevel color function. You can choose how dense the contour lines are by either plotting over a larger domain than the unit square, or by changing the coefficients to $x^2$ and $y^2$ within the $\cos$ function. The negative sign is there to ...


2

As @Mr.Wizard pointed out, multiple interesting solutions to your problem have been proposed on this site. I just wanted to add an observation here. I realize that you did not say so explicitly, but I would think that many users would try some combination of ListPointPlot3D for this kind of task. However, it has been my impression when using the *3D list ...


2

Might you be looking for this? The modifications are in the addition of the zeros table (though it would be much better to write down an analytical expression) and the rule for Epilog acts on it accordingly to generate the points. In my example, though, they are black for a small slope and become brighter red/green for larger negative/positive slopes. You ...


2

For illustrative purposes: f[t_] := {Sqrt[2] Cos[t], Sqrt[2] Cos[t] Sin[t]}/(1 + Sin[t]^2) r = Range[0, 2 Pi, 0.05]; cf = ColorData["Rainbow"][1 - #/(2 Pi)] &; lp = ListPlot[{f@#} & /@ r, PlotStyle -> (cf /@ r), AspectRatio -> Automatic, ImageSize -> 400]; g = Graphics[{cf@#, PointSize[0.01], Point[f@#]} & /@ r, ImageSize -> ...


3

I have always felt that Mathematica's ListPlot needed this feature. It is possible that a feature like this has been added in version 10.1, but prior to that, the best I know of is to use Graphics directly, which isn't nearly as hard as it sounds: points = Table[{x^4, Sin[x^4]}, {x, 0, (2*Pi)^(1/4), 0.01}]; colors = Map[Hue[2/3*(#[[1]]/(2*Pi))] &, ...


1

This seems to work: list = Style @@@ ColorData["Crayola", "ColorRules"]; Export["test.rtf", Cell[BoxData @ ToBoxes @ #, "Output"] & /@ list]


1

The challenge for me was concatenating styled strings. To concatenated the styled text for output, just put a space between them. With that the styles export successfully: Export["test.rtf", Style["Arff", Red] Style["Meow", Blue] ] That made the text is colored correctly when opened with Word on Windows. You can also try: ...


9

clicks = {}; insert = 0; data = RandomReal[100, {50, 2}]; You can add the points in clicks using Epilog: Column[{ListPlot[Button[Tooltip@#, If[insert < 5 && ! MemberQ[clicks, #], AppendTo[clicks, #]; insert++;]] & /@ N@data, ImageSize -> 400, Epilog -> Dynamic[{ Directive[Opacity[.7, Red], PointSize[Large]], ...


4

Here's an approach using ParametricPlot3D, in which spheres are plotted and then sliced off using the option RegionFunction. It's not clear to me how you intend to have the inner regions "blank" as they are occluded, but the options to Show let you vary the appearance. outerSphere[sphereCenter_: {0, 0, 0}, regionLimit_: 0.6, color_, opacity_] := Module[ ...


7

Here is an alternative to RegionPlot that potentially produces higher quality: it's based on Tube with varying radius, as I also used in this answer: With[ {a = 1, R = .7, n = 40, xMax = 1.5}, Manipulate[ Graphics3D[ GeometricTransformation[ {CapForm[None], {Opacity[.5], Pink, #, Cyan, GeometricTransformation[#, {{-1, 0, 0}, ...


4

MapIndexed can be used to apply styling to elements conditionally based upon the their indices within the matrix. For example: format[v_, {_, 1}] := framed[v, White, Blue] format[v_, {_, 2}] := MatrixForm[v, TableSpacing -> {None, None}] format[v_, {_, 2, 1, _} | {_, 2, _, 4}] := framed[v, Black, Darker[Yellow, 0.01]] format[v_, _] := v framed[v_, f_, ...


4

mfnested = MapAt[MatrixForm, nested, {{}, {;; , ;;}}]; colF = MapAt[Function[{i}, Item[i, Background -> #2[[1]]]], #, #2[[2]]] &; Fold[colF, mfnested, {{Yellow, {{1, All, 2, 1, 1, All}, {1, All, 2, 1, All, -1}}}, {Lighter@Blue, {{All, All, 1}}}}] Grid[MapAt[Grid[#, Background -> {{-1 -> Yellow}, {1 -> Yellow}}] &, ...


8

The function domCol below is about 100 times faster than DominantColors. Basic plan: Create enough color bins throughout the color space occupied by the image; count the number of pixels in each bin; return the sorted colors. The function works in the LAB color space so we can use EuclideanDistance for the distance between colors. The centers of the bins ...


5

Use of ColorQuantize Much faster. Not exactly the same, but close and for an art project is OK I think. i = ExampleData[{"TestImage", "Lena"}]; QuaCol[i_, n_] := RGBColor /@ Union[Flatten[ImageData[ColorQuantize[i, n]], 1]]


5

The problem is not with DominantColors Try varying the number of colours selected by running this snippet. I vary the number of selected colours from 1 to 10, and measure the time to calculate DominantColours ten times: Table[ First@AbsoluteTiming@ Table[DominantColors[p, i], {p, RandomChoice[pieces, 10]}] , {i, 10}] (* {6.544491, 7.658153, ...



Top 50 recent answers are included