# Extending a plot over a secondary variable

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$.

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

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] The plot takes some time to evaluate. For fast execution you can reduce the PlotPoints.

• This is perfect; thanks! Feb 7, 2013 at 14:44