# Kurtosis of made up distribution

Take a look at the image below. Blue line indicates standard normal pdf. The red zone is supposed to be equal to the sum of grey areas (sorry for awful drawing).

I wonder can we create a new distribution with higher peak by shifting grey zones to the top (red zone) of the normal pdf? If such transformation can be made, than what do you think about the kurtosis of this new distribution? Leptokurtic? But it has the same tails as the normal distribution does! Undefined?

There will be an infinite number of distributions that look very similar to your drawing, with a variety of different values for kurtosis.

With the particular conditions in your question and given we hold the crossover point to be inside, or at least not too far outside $\pm 1$, it should be the case that you get a slightly larger kurtosis than for the normal. I will show three cases where that happens, and then I’ll show one where it is smaller — and explain what causes it to happen.

Given that $\phi(x)$ and $\Phi(x)$ are the standard normal pdf and cdf respectively, let’s write ourselves a little function

$$f(x) = \begin{cases} \phi(x) &\mbox{;}\quad |x| > t \\ a+b.g(x) & \mbox{;}\quad |x| ≤ t \end{cases} \$$

for some continuous, symmetric density $g$ (with corresponding cdf $G$), with mean $0$, such that $b = \frac{\Phi(t)\, –\, ½\, –\, t.\phi(t)}{G(t)\, –\, ½\, –\, t.g(t)}$ and $a = \phi(t)-b.g(t)$.

That is, $a$ and $b$ are chosen to make the density continuous and integrate to $1$.

Example 1 Consider $g(x) = 3\, \phi(3x)$ and $t=1$, which looks something like your drawing, here generated by the following R code:

f <- function(x, t=1,
dg=function(x) 2*dnorm(2*x),
pg=function(x) pnorm(2*x),
b=(pnorm(t) - 0.5 - t*dnorm(t))/ (pg(t) - 0.5 - t*dg(t)),
a=dnorm(t)-b*dg(t) ) {
ifelse(abs(x)>t,dnorm(x),a+b*dg(x))
}

f1 <- function(x) f(x,t=1,dg=function(x) 3*dnorm(3*x),pg=function(x) pnorm(3*x))
curve(f1,-4,4,col=2)
lines(x,dnorm(x),col=3)


Now the calculations. Let’s make a function to evaluate $x^pf_1(x)$:

fp <- function(x,p=2) x^p*f1(x)


so we can evaluate the moments. First the variance:

 integrate(fp,-Inf,Inf)  # should be just smaller than 1
0.9828341 with absolute error < 1.4e-07


Next the fourth central moment:

 integrate(fp,-Inf,Inf,p=4) # should be just smaller than 3
2.990153 with absolute error < 8.3e-06


We need the ratio of those numbers, which should have about 5 figure accuracy

 integrate(fp,-Inf,Inf,p=4)$value/(integrate(fp,-Inf,Inf)$value^2)
 3.095515


So the kurtosis is about 3.0955, slightly larger than for the normal case.

Of course we could compute it algebraically and get an exact answer, but there’s no need, this tells us what we want to know.

Example 2 With the function $f$ defined above we can try it for all manner of $g$’s.

Here’s the Laplace:

library(distr)
D <- DExp(rate = 1)
f2 <- function(x) f(x,t=1,dg=d(D),pg=p(D))
curve(f2,-4,4,col=2)
lines(x,dnorm(x),col=3) fp2 <- function(x,p=2) x^p*f2(x)

integrate(fp2,-Inf,Inf)  # should be just smaller than 1
0.9911295 with absolute error < 1.1e-07
integrate(fp2,-Inf,Inf,p=4) # should be just smaller than 3
2.995212 with absolute error < 5.9e-06
integrate(fp2,-Inf,Inf,p=4)$value/(integrate(fp2,-Inf,Inf)$value^2)
 3.049065


Unsurprisingly, a similar result.

Example 3: Let’s take $g$ to be a Cauchy distribution (a Student-t distribution with 1 d.f.), but with scale 2/3 (that is, if $h(x)$ is a standard Cauchy, $g(x) = 1.5 h(1.5 x)$, and again set the threshold, t (giving the points, $\pm t$, outside which we ‘switch’ to the normal), to be 1.

dg <- function(x) 1.5*dt(1.5*x,df=1)
pg <- function(x) pt(1.5*x,df=1)

f3 <- function(x) f(x,t=1,dg=dg,pg=pg)
curve(f3,-4,4,col=2)
lines(x,dnorm(x),col=3) fp3 <- function(x,p=2) x^p*f3(x)

integrate(fp3,-Inf,Inf)  # should be just smaller than 1
0.9915525 with absolute error < 1.1e-07

integrate(fp3,-Inf,Inf,p=4) # should be just smaller than 3
2.995066 with absolute error < 6.2e-06

integrate(fp3,-Inf,Inf,p=4)$value/(integrate(fp2,-Inf,Inf)$value^2)
 3.048917


And just to demonstrate that we have actually got a proper density:

 integrate(f3,-Inf,Inf)
1 with absolute error < 9.4e-05


Example 4: However, what happens when we change t?

Take $g$ and $G$ as the previous example, but change the threshold to $t=2$:

f4 <- function(x) f(x,t=2,dg=dg,pg=pg)
curve(f4,-4,4,col=2)
lines(x,dnorm(x),col=3) fp4 <- function(x,p=2) x^p*f4(x)

integrate(fp4,-Inf,Inf,p=4)$value/(integrate(fp2,-Inf,Inf)$value^2)
 2.755231


How does this happen?

Well, it’s important to know that kurtosis is (speaking slightly loosely) 1+ the squared variance about $\mu\pm\sigma$: All three distributions have the same mean and variance.

The black curve is the standard normal density. The green curve shows a fairly concentrated distribution about $\mu\pm\sigma$ (that is, the variance about $\mu\pm\sigma$ is small, leading to a kurtosis that approaches toward 1, the smallest possible). The red curve shows a case where the distribution is “pushed away” from $\mu\pm\sigma$; that is the kurtosis is large.

With that in mind, if we set the threshold points far enough outside $\mu\pm\sigma$ we can push the kurtosis below 3, and still have a higher peak.