Mean Preserving PDF Spreading

Question

I have a histogram representing the PDF (probability density function) of an unknown discrete RV. The histogram is asymmetrical. Is there a known way in Mathematica to increase/decrease the variance of the distribution while preserving the Mean?

Thanks

Answer 1

mpsF[k_] := Mean[#] + N@Sqrt[k] (# - Mean[#]) &; (* thanks: ybeltukov *)

Example:

dist = BinomialDistribution[40, .1];
sample = N@RandomVariate[dist, 100];
sample2 = mpsF[10][sample];

Through@{Mean, Variance}@sample
(* {4.18, 4.57333} *)
Through@{Mean, Variance}@sample2
(* {4.18, 45.73333} *)

Alternatively, define a function to apply a mean-preserving-spread transformation to a distribution:

mpsTDF[k_] := TransformedDistribution[Mean @ # + Sqrt[k] (z - Mean @ #), Distributed[z, #]] &

Examples:

Through@{Mean, Variance}@ mpsTDF[3][NormalDistribution[μ, σ]]
(* {μ, 3 σ^2} *)

Through@{Mean, Variance}@# & /@ {ChiSquareDistribution[ν], mpsTDF[3][ChiSquareDistribution[ν]]}
(* {{ν, 2 ν}, {ν, 6 ν}} *)