File:R sin(theta) Surface Plot.png

From testwiki
Jump to navigation Jump to search
Original file (800 × 648 pixels, file size: 72 KB, MIME type: image/png)

This file is from Wikimedia Commons and may be used by other projects. The description on its file description page there is shown below.

Description Polar surface plot of r sin(θ)
Date
Source self-made
 This diagram was created with Mathematica.
Author Inductiveload
Permission
(Reusing this file)
Public domain I, the copyright holder of this work, release this work into the public domain. This applies worldwide.
In some countries this may not be legally possible; if so:
I grant anyone the right to use this work for any purpose, without any conditions, unless such conditions are required by law.
Mathematical Function Plot
Description Ploar Surface Plot of r sin(θ)
Equation
Co-ordinate System Polar
r Range 0 .. 1
θ Range -0 .. 2π

Mathematica Code

The rationale for this code can be found on Wikibooks, here. Note the it is slightly modified to allow for antialising.

This uses Chris Hill's antialiasing code to average pixels and produce a less jagged image. The original code can be found here.
dtheta = Pi/20;                                     (*Give a radial gridline \
spacing of Pi/20 radians*)
rmax = 1;                                                     (*Define the \
maximum radius*)
dr = rmax/10;                                        (*Give 10 \
circumferential grid lines*)
f[r_, theta_] := r  Sin[theta]; (*This is the function definition*)

data = Table[
      f[r, theta],
      {theta, 0, 2Pi, dtheta},
      {r, 0, rmax, dr}];

gr1 = ListPlot3D[
    data,
    MeshRange -> {{0, rmax}, {0, 2Pi}},
    TextStyle -> {FontSize -> 60},
    BoxStyle -> {AbsoluteThickness[4]},
    MeshStyle -> {AbsoluteThickness[4]},
    AxesLabel -> {"", "", z},
    ImageSize -> 200,
    DisplayFunction -> Identity]

gr2 = Graphics3D[gr1];

substitution = {r_, theta_, z_} -> {r Cos[theta], r Sin[theta], z};
gr3 = ReplaceAll[gr2, p : Polygon[pts_] :> ReplaceAll[p, substitution]]

aa[gr_] := Module[{siz, kersiz, ker, dat, as, ave, is, ar},
    is = ImageSize /. Options[gr, ImageSize];
    ar = AspectRatio /. Options[gr, AspectRatio];
    If[! NumberQ[is], is = 288];
    kersiz = 4;
    img = 
    ImportString[ExportString[gr, "PNG", ImageSize -> (is kersiz)], "PNG"];
    siz = Reverse@Dimensions[img[[1, 1]]][[{1, 2}]];
    ker = Table[N[1/kersiz^2], {kersiz}, {kersiz}];
    dat = N[img[[1, 1]]];
    as = Dimensions[dat];
    ave = Partition[Transpose[Flatten[
          ListConvolve[ker, dat[[All, All, #]]]] & /@ 
            Range[as[[3]]]], as[[2]] - kersiz + 1];
    ave = Take[
    ave, Sequence @@ ({1, Dimensions[ave][[#]], kersiz} & /@ \
Range[Length[Dimensions[ave]] - 1])];
    Show[Graphics[Raster[
      ave, {{0, 0},
         siz/kersiz}, {0, 255}, ColorFunction -> RGBColor]], PlotRange -> \
{{0, siz[[1]]/kersiz}, {0, siz[[2]]/kersiz}}, ImageSize -> is, 
    AspectRatio -> ar]
    ]

aa[gr3]

Captions

Add a one-line explanation of what this file represents

Items portrayed in this file

depicts

26 August 2007

File history

Click on a date/time to view the file as it appeared at that time.

Date/TimeThumbnailDimensionsUserComment
current16:53, 26 August 2007Thumbnail for version as of 16:53, 26 August 2007800 × 648 (72 KB)wikimediacommons>Inductiveload

The following page uses this file: