a new sort of Gaussian noise

From: Roger L. Bagula (rlbtftn_at_netscape.net)
Date: 07/08/04

  • Next message: Roger Bagula: "[Fwd: Removal Notification]"
    Date: Thu, 08 Jul 2004 20:21:15 GMT
    
    

      Last night I noticed that the second derivative of the projective line
    was a parametric

    cardioid which has genus one. I realized that I might be able to
    get a new noise effect by making a random projection from the
    cardioid to the real line and from there to a Gaussian noise.
    It works and it apparently gives an effect much like shot noise/
    tunneling effects
    in transistors.
    These also seems to be a cut off effect in the amplitudes which divides
    them into two distinct parts.
    I'm attaching both the notebook striped of pictures and pictures of the
    notebook( deleted for newsgroup posts: I posted the pictures to alt.fractals)
    I call the noise a martingale as that is the traditional name for
    functionally random noises
    different than the standard probability distributions (pdf, I hate such
    abrivations).
    Respectfully, Roger L. Bagula

    tftn@earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
    URL : http://home.earthlink.net/~tftn
    URL : http://victorian.fortunecity.com/carmelita/435/

    (***********************************************************************

                        Mathematica-Compatible Notebook

    This notebook can be used on any computer system with Mathematica 3.0,
    MathReader 3.0, or any compatible application. The data for the notebook
    starts with the line of stars above.

    To get the notebook into a Mathematica-compatible application, do one of
    the following:

    * Save the data starting with the line of stars above into a file
      with a name ending in .nb, then open the file inside the application;

    * Copy the data starting with the line of stars above to the
      clipboard, then use the Paste menu command inside the application.

    Data for notebooks contains only printable 7-bit ASCII and can be
    sent directly in email or through ftp in text mode. Newlines can be
    CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

    NOTE: If you modify the data for this notebook not in a Mathematica-
    compatible application, you must delete the line below containing the
    word CacheID, otherwise Mathematica-compatible applications may try to
    use invalid cache data.

    For more information on notebooks and Mathematica-compatible
    applications, contact Wolfram Research:
      web: http://www.wolfram.com
      email: info@wolfram.com
      phone: +1-217-398-0700 (U.S.)

    Notebook reader applications are available free of charge from
    Wolfram Research.
    ***********************************************************************)

    (*CacheID: 232*)

    (*NotebookFileLineBreakTest
    NotebookFileLineBreakTest*)
    (*NotebookOptionsPosition[ 5498, 191]*)
    (*NotebookOutlinePosition[ 6395, 220]*)
    (* CellTagsIndexPosition[ 6351, 216]*)
    (*WindowFrame->Normal*)

    Notebook[{
    Cell[BoxData[
        \(Clear[x, a]\)], "Input"],

    Cell[BoxData[
        \( (*\
          adding\ a\ genus\ \((\ g = 1\ Cardioid)\)\ effect\ to\ a\ noise\ as\ a\
            martingale*) \)], "Input"],

    Cell[BoxData[
        \( (*\ seems\ to\ simulate\ effects\ like\ shot\ noise\ in\ transisters*)
          \)], "Input"],

    Cell[BoxData[
        \( (*\ by\ Roger\ L . \ Bagula\ 8\ july\ 2004 \[Copyright]\ *) \)],
      "Input"],

    Cell[BoxData[
        \( (*\ second\ derivative\ of\ projective\ line\ is\ a\ Cardioid*) \)],
      "Input"],

    Cell[BoxData[
        \(\(x2[s_] = \(4\ \((\(-1\) + 3\ s\^2)\)\)\/\((1 + s\^2)\)\^3; \)\)],
      "Input"],

    Cell[BoxData[
        \(\(y2[s_] = \(4\ s\ \((\(-3\) + s\^2)\)\)\/\((1 + s\^2)\)\^3; \)\)],
      "Input"],

    Cell[BoxData[
        \(\(r4 = Simplify[x2[s]^2 + y2[s]^2]; \)\)], "Input"],

    Cell[BoxData[
        \(\(g3 = ParametricPlot[{x2[s], y2[s]}, {s, \(-10\), 10}]; \)\)], "Input"],

    Cell[BoxData[
        \(\(g4 =
          ParametricPlot[{2*\((1 - 1.25*Cos[s])\)*Cos[s] + 0.5,
              2*\((1 - 1.25*Cos[s])\)*Sin[s]}, {s, \(-10\), 10}]; \)\)], "Input"],

    Cell[BoxData[
        \(Show[g3, g4]\)], "Input"],

    Cell[BoxData[
        \( (*\ solution\ of\ approximate\ cardioid\ in\ s*) \)], "Input"],

    Cell[BoxData[
        \(Solve[
          2*\((1 - 1.25*a)\)*b*\((1 + s\^2)\)\^3 - 4\ s\ \((\(-3\) + s\^2)\) ==
            0, s]\)], "Input"],

    Cell[BoxData[
        \( (*\
          function\ made\ from\ solutions\ as\ the\ projective\ line\ of\ a\
            \(cardioid : \
              second\ function\ taken\ as\ closer\ to\ the\ cardioid\)*) \)],
      "Input"],

    Cell[BoxData[
        \(\(s[a_, b_] =
          Root[\(-0.8`\)\ b + 1.`\ a\ b - 4.80000000000000071`\ #1 -
                2.40000000000000035`\ b\ #1\^2 + 3.`\ a\ b\ #1\^2 +
                1.60000000000000008`\ #1\^3 - 2.40000000000000035`\ b\ #1\^4 +
                3.`\ a\ b\ #1\^4 - 0.8`\ b\ #1\^6 + 1.`\ a\ b\ #1\^6&, 1]; \)\)],
      "Input"],

    Cell[BoxData[
        \(Plot[s[Cos[2*Pi*t], Sin[2*Pi*t]], {t, \(-1\), 1}]\)], "Input"],

    Cell[BoxData[
        \( (*\
          plot\ of\ line\ random\ to\ Gaussian\ distribution\ height\ at\ that\
              point\ on\ the\ line\ of\ a\ Cardioid\ random\ instead\ of\ a\
              \(circle\ : \ a\) = \ Cos[2*Pi*Random[]], b = Sin[2*Pi*Random[]]*)
          \)], "Input"],

    Cell[BoxData[
        \( (*\ Gauss_dist[] = Exp[\(-s[a, b]^2\)/2]/Sqrt[2*Pi]\ *) \)], "Input"],

    Cell[BoxData[
        \(SeedRandom[]\)], "Input"],

    Cell[BoxData[
        \(\(noise =
          Table[Re[Exp[\(-s[Cos[2*Pi*Random[]], Sin[2*Pi*Random[]]]^2\)/2]/
                Sqrt[2*Pi]], {n, 1, 500}]; \)\)], "Input"],

    Cell[BoxData[
        \(ListPlot[noise, PlotRange -> All, \ PlotJoined -> \ True]\)], "Input"],

    Cell[BoxData[
        \(\(noiseI =
          Table[Im[Exp[\(-s[Cos[2*Pi*Random[]], Sin[2*Pi*Random[]]]^2\)/2]/
                Sqrt[2*Pi]], {n, 1, 500}]; \)\)], "Input"],

    Cell[BoxData[
        \(ListPlot[noiseI, PlotRange -> All, \ PlotJoined -> \ True]\)], "Input"],

    Cell[BoxData[
        \(\(noiseAbs =
          Table[Abs[
              Exp[\(-s[Cos[2*Pi*Random[]], Sin[2*Pi*Random[]]]^2\)/2]/
                Sqrt[2*Pi]], {n, 1, 500}]; \)\)], "Input"],

    Cell[BoxData[
        \(ListPlot[noiseAbs, PlotRange -> All, \ PlotJoined -> \ True]\)], "Input"],

    Cell[BoxData[
        \(\(ba = Table[Floor[2500*noiseAbs[\([n]\)]], {n, 1, 500}]; \)\)], "Input"],

    Cell[CellGroupData[{

    Cell[BoxData[
        \(b0 = \(Dimensions[ba]\)[\([1]\)]\)], "Input"],

    Cell[BoxData[
        \(500\)], "Output"]
    }, Open ]],

    Cell[CellGroupData[{

    Cell[BoxData[
        \(bmax = Max[ba]\)], "Input"],

    Cell[BoxData[
        \(4252\)], "Output"]
    }, Open ]],

    Cell[CellGroupData[{

    Cell[BoxData[
        \(bmin = Min[ba]\)], "Input"],

    Cell[BoxData[
        \(0\)], "Output"]
    }, Open ]],

    Cell[BoxData[
        \(\(c = Table[Count[ba, n], {n, Floor[bmin], bmax}]; \)\)], "Input"],

    Cell[BoxData[
        \(ListPlot[c, PlotJoined -> True]\)], "Input"]
    },
    FrontEndVersion->"Macintosh 3.0",
    ScreenRectangle->{{0, 1920}, {0, 1060}},
    WindowSize->{1294, 878},
    WindowMargins->{{72, Automatic}, {Automatic, 13}},
    PrintingCopies->1,
    PrintingPageRange->{1, Automatic},
    MacintoshSystemPageSetup->"\<\
    00/0004/0B`000003509H?ocokD"
    ]

    (***********************************************************************
    Cached data follows. If you edit this Notebook file directly, not using
    Mathematica, you must remove the line containing CacheID at the top of
    the file. The cache data will then be recreated when you save this file
    from within Mathematica.
    ***********************************************************************)

    (*CellTagsOutline
    CellTagsIndex->{}
    *)

    (*CellTagsIndex
    CellTagsIndex->{}
    *)

    (*NotebookFileOutline
    Notebook[{
    Cell[1709, 49, 44, 1, 27, "Input"],
    Cell[1756, 52, 139, 3, 27, "Input"],
    Cell[1898, 57, 112, 2, 27, "Input"],
    Cell[2013, 61, 98, 2, 27, "Input"],
    Cell[2114, 65, 101, 2, 27, "Input"],
    Cell[2218, 69, 99, 2, 47, "Input"],
    Cell[2320, 73, 99, 2, 47, "Input"],
    Cell[2422, 77, 71, 1, 27, "Input"],
    Cell[2496, 80, 92, 1, 27, "Input"],
    Cell[2591, 83, 166, 3, 27, "Input"],
    Cell[2760, 88, 45, 1, 27, "Input"],
    Cell[2808, 91, 83, 1, 27, "Input"],
    Cell[2894, 94, 130, 3, 32, "Input"],
    Cell[3027, 99, 209, 5, 27, "Input"],
    Cell[3239, 106, 331, 6, 66, "Input"],
    Cell[3573, 114, 82, 1, 27, "Input"],
    Cell[3658, 117, 275, 5, 43, "Input"],
    Cell[3936, 124, 90, 1, 27, "Input"],
    Cell[4029, 127, 45, 1, 27, "Input"],
    Cell[4077, 130, 157, 3, 27, "Input"],
    Cell[4237, 135, 90, 1, 27, "Input"],
    Cell[4330, 138, 158, 3, 27, "Input"],
    Cell[4491, 143, 91, 1, 27, "Input"],
    Cell[4585, 146, 172, 4, 27, "Input"],
    Cell[4760, 152, 93, 1, 27, "Input"],
    Cell[4856, 155, 93, 1, 27, "Input"],

    Cell[CellGroupData[{
    Cell[4974, 160, 65, 1, 27, "Input"],
    Cell[5042, 163, 37, 1, 26, "Output"]
    }, Open ]],

    Cell[CellGroupData[{
    Cell[5116, 169, 47, 1, 27, "Input"],
    Cell[5166, 172, 38, 1, 26, "Output"]
    }, Open ]],

    Cell[CellGroupData[{
    Cell[5241, 178, 47, 1, 27, "Input"],
    Cell[5291, 181, 35, 1, 26, "Output"]
    }, Open ]],
    Cell[5341, 185, 86, 1, 27, "Input"],
    Cell[5430, 188, 64, 1, 27, "Input"]
    }
    ]
    *)

    (***********************************************************************
    End of Mathematica Notebook file.
    ***********************************************************************)

    -- 
    Respectfully, Roger L. Bagula
    tftn@earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
    URL :  http://home.earthlink.net/~tftn
    URL :  http://victorian.fortunecity.com/carmelita/435/ 
    -- 
    Respectfully, Roger L. Bagula
    tftn@earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
    URL :  http://home.earthlink.net/~tftn
    URL :  http://victorian.fortunecity.com/carmelita/435/ 
    

  • Next message: Roger Bagula: "[Fwd: Removal Notification]"