4
$\begingroup$

Apologies for the vague title; couldn't really think of a better way of putting it.

I have a function $F$ of two variables, $\rho\in[0,\infty)$ and $f\in[0,1]$, that I wish to create a plot over (e.g. with CountourPlot or DensityPlot). I can numerically generate the entire curve of $F$ over $f$ for a particular value of $\rho$ relatively cheaply, but I can't directly compute $F$ for individual values of $f$.

Is there an efficient way of taking such a curve and plotting it for a range of $\rho$ without Mathematica having to evaluate the function independently at every $(\rho,f)$?

Here's how I compute $F$:

Lorentz[data_] := Module[{xs, ys},
   xs = Range[0, Length[data]];
   ys = Prepend[Accumulate[Sort[data]], 0];
   Transpose[{xs/Last@xs, ys/Last@ys}]];

L = Interpolation[Lorentz[data], InterpolationOrder -> 1];
F = 1 - L[1 - #] &;

data is a list of real numbers generated according to the value of $\rho$.

Essentially, I generate a Lorentz curve numerically as a list of $(x,y)$ tuples, turn it into a function via Interpolation, reflect it a couple of times, and that's my function $F$.

Improve this question
$\endgroup$
  • 1
    $\begingroup$ For this specific problem it will be nice if you can supply us the code for $F(\rho,f)$. $\endgroup$ – PlatoManiac Feb 7 '13 at 12:35
  • $\begingroup$ @PlatoManiac I've added the details. $\endgroup$ – Will Vousden Feb 7 '13 at 12:47
  • 1
    $\begingroup$ related: wolfram demonstrations Lorenz Curve and Gini Coefficient $\endgroup$ – kglr Feb 7 '13 at 12:58
8
$\begingroup$

Lets change the definition of your function a bit. here n is the number of points you take in the direction of variable f.

Lorentz[rho_, n_: 100] := Module[{data, xs, ys},
  data = RandomVariate[NormalDistribution[1, 3], n];
  xs = Range[0, n];
  ys = Prepend[Accumulate[Sort[data]], 0];
  xs /= Last@xs;
  ys /= Last@ys;
  N@Transpose@{Transpose@{xs, ConstantArray[rho, n + 1]}, ys}
  ];
(* Discretize f direction with 1000 *)
(* Discretize rho direction say {0,5} with 0.1 *)
L = Interpolation[Flatten[Table[Lorentz[i, 1000], {i, 0, 5, .1}], 1],
InterpolationOrder -> 3];
F[f_, rho_] := 1 - L[1 - f, rho];

Now lets plot what you want!

GraphicsGrid[{{Plot3D[F[f, rho], {f, 0, 1}, {rho, 0, 5}, 
Mesh -> False, PlotPoints -> 100, PlotRange -> All, 
Boxed -> False,ColorFunction -> "Rainbow"], 
ContourPlot[F[f, rho], {f, 0, 1}, {rho, 0, 5}, Mesh -> None, 
PlotPoints -> 100, PlotRange -> All,ColorFunction -> "Rainbow",
ContourLabels -> True]}}, ImageSize -> 800]

enter image description here

The plot takes some time to evaluate. For fast execution you can reduce the PlotPoints.

Improve this answer
$\endgroup$
  • $\begingroup$ This is perfect; thanks! $\endgroup$ – Will Vousden Feb 7 '13 at 14:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.