Mod Removes Wiki by J. M. is away
14 deleted 18 characters in body
source | link
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
              ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}],1]]/Sqrt@3;
   Return@NestWhile[Append[#, Return@NestWhileList[{#[[-1, 1]] + 1/steps#, f[#[[-1,f[#]} 1]]&@(#[[1]] + 1/steps]}]steps) &, {{0, 1}}, 
                         UnsameQ @@ ({##}[[-1, All[[All, 2]]) &, 2, steps + 1][[steps][[-2, 1]];];1]]
];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}],1]]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
              ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}],1]]/Sqrt@3;
   Return@NestWhileList[{#, f[#]} &@(#[[1]] + 1/steps) &, {0, 1}, 
                         UnsameQ @@ ({##}[[All, 2]]) &, 2, steps][[-2, 1]]
];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]
13 deleted 1 characters in body
source | link
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}]]], 1]1]]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}]], 1]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}],1]]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]
12 added 3 characters in body
source | link
(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}]], 1]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
ListPlot[#Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]

Mathematica graphics


Mathematica graphics

(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}]], 1]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]

Mathematica graphics


(*Function Definition*)
ClearAll[opaFun];
Options[opaFun] = Options[ListPlot];
opaFun[points_, opts : OptionsPattern[]] := Module[{f, steps = 10 },
   f[x_] := Min[Norm /@ Flatten[ImageData@
         ListPlot[points, opts, Axes -> False, PlotStyle -> {Black, Opacity[x]}]], 1]/Sqrt@3;
   Return@NestWhile[Append[#, {#[[-1, 1]] + 1/steps, f[#[[-1, 1]] + 1/steps]}] &, {{0, 1}},
                    UnsameQ @@ ({##}[[-1, All, 2]]) &, 2, steps + 1][[-2, 1]];];
(*Usage*)
opts = {AspectRatio -> 1/2, ImageSize -> 300, Axes -> False};
Timing@ListPlot[#, opts, PlotStyle -> {Black, Opacity[opaFun[#]]}] &@
                  RandomReal[NormalDistribution[], {10000, 2}]

Mathematica graphics

11 added 860 characters in body
source | link
10 added 9 characters in body
source | link
9 deleted 41 characters in body
source | link
8 added 593 characters in body; added 140 characters in body
source | link
7 added 1681 characters in body
source | link
6 added 84 characters in body
source | link
5 added 106 characters in body
source | link
4 deleted 57 characters in body; added 9 characters in body
source | link
3 added 7 characters in body; added 97 characters in body
source | link
2 edited body; added 297 characters in body
source | link
1
source | link