How can we use TransformedDistribution to infer the sampling distribution of the sample mean?

Question

As we know, TransformedDistribution can infer a distribution of a transformation like

TransformedDistribution[A*X + B, X \[Distributed] NormalDistribution[μ, σ]]

NormalDistribution[A μ + B, σ Abs[A]]

But can we use it get the sampling distribution of the sample mean? Such as $X_1,X_2,\cdots,X_n \sim \text{NormalDistribution}[μ, σ]$ and then the $\overline{X}=\frac{X_1,X_2,\cdots,X_n}{n}\sim \text{NormalDistribution}[μ, σ/\sqrt{n}]$.

Can we do such symbolic derivation? My current try is

TransformedDistribution[Mean[{x, y, z}], Table[i \[Distributed] NormalDistribution[μ, σ], {i, {x, y, z}}]]

NormalDistribution[μ, Abs[σ]/Sqrt[3]]

I have to say it is not a real symbolic derivation. I hope to get a $\text{NormalDistribution}[μ, σ/\sqrt{n}]$ result. I am not sure I have missed anything.

---

PS: I mean, I don't want to get the number $3$ in the result. I hope to use $n$ parameters to get $\text{NormalDistribution}[μ, σ/\sqrt{n}]$. The result has that symbol $n$. But I am not sure MMA can do this. Like a real symbolic derivation.

Answer 1

Update: If you do not consider this cheating:

TransformedDistribution[w[n] / n, w \[Distributed] WienerProcess[μ, σ]]

NormalDistribution[μ, σ/Sqrt[n]]

Also

SliceDistribution[WienerProcess[μ/n, σ/n], n]

NormalDistribution[μ, σ/Sqrt[n]]

and

TransformedDistribution[x/n, x \[Distributed] SliceDistribution[WienerProcess[μ, σ], n]]

NormalDistribution[μ, σ/Sqrt[n]]

Original answer:

tdist[n_Integer] := TransformedDistribution[Mean[Array[x, n]], 
      Array[x, n] \[Distributed] ProductDistribution[{NormalDistribution[μ, σ], n}], 
   Assumptions -> {σ > 0}]

tdist /@ Range[4] // Column

n = 3;
mnd = MultinormalDistribution[Array[Subscript[μ, #] &, n], 
    Array[Subscript[σ, ##] &, {n, n}]];

TransformedDistribution[Mean[Array[Subscript[x, #] &, n]], 
   Array[Subscript[x, #] &, n] \[Distributed] mnd]

Answer 2

This answer also does not use TransformedDistribution but does come up with the correct variance and that the distribution is normal using an unspecified sample size. (My other answer only deals with getting the correct variance.) But I'm assuming that if TransformedDistribution can't be made to work, then you want some method that works for an unspecified sample size.

This solution uses moment generating functions. (One could also use characteristic functions.)

The moment generating function of a normal distribution with mean $\mu$ and variance $\sigma^2$ is

mgf = MomentGeneratingFunction[NormalDistribution[μ, σ], t]

$$e^{\frac{\sigma ^2 t^2}{2}+\mu t}$$

The moment generating function of a sum of normals is found by raising the mgf to the power $n$:

mgfSum = mgf^n /. Exp[a_]^n -> Exp[a n] // ExpandAll

$$e^{\frac{1}{2} n \sigma ^2 t^2+\mu n t}$$

Finally get the mgf of the mean which is the sum divided by $n$:

mgfxbar = mgfSum /. t -> t/n // ExpandAll

$$e^{\frac{\sigma ^2 t^2}{2 n}+\mu t}$$

Doing all of this in a single command is

MomentGeneratingFunction[NormalDistribution[μ, σ], t/n]^n /. Exp[a_]^n -> Exp[a n] // ExpandAll

$$e^{\frac{\sigma ^2 t^2}{2 n}+\mu t}$$

So the sample mean also has a normal distribution with mean $\mu$ and variance $\sigma^2/n$ because a moment generating function uniquely identifies the distribution.

Answer 3

The following might be an approach to get moments using an unspecified sample size. (Admittedly, it's bit circular/odd/obtuse. I'm sure it can be explained better.)

The sample mean is

xbar = Sum[x[i], {i, 1, n}]/n

This can be represented using the PowerSymmetricPolynomial function:

xbar = PowerSymmetricPolynomial[1]/n

where PowerSymmetricPolynomial[k] represents

Sum[x[i]^k, {i, 1, n}]

If you're willing to allow the expectation of PowerSymmetricPolynomial[k] for $k=0,1,2$ to be n, n Moment[1], and n Moment[2], respectively, then we write some expectation rules:

expectationRules = {PowerSymmetricPolynomial[0] -> n,
  PowerSymmetricPolynomial[1] -> n Moment[1],
  PowerSymmetricPolynomial[2] -> n Moment[2]}

We also write some notational rules to put things in customary form:

notationRules = {Moment[1] -> μ, Moment[2] -> σ^2 + μ^2, CentralMoment[2] -> σ^2}

Putting this altogether using the function MomentConvert:

Eofxbar = xbar /. expectationRules /. notationRules
(* μ *)

varxbar = MomentConvert[(xbar - Eofxbar)^2, "CentralMoment"] /. expectationRules /. notationRules
(* σ^2/n *)

Answer 4

Clear["Global`*"]

$Assumptions = Element[m, Reals] && s > 0;

The distribution of the Mean of n i.i.d. normal random variables is

dist[n_Integer?Positive] := dist[n] =
  TransformedDistribution[
   Sum[x[k], {k, 1, n}]/n,
   Table[x[k] \[Distributed] NormalDistribution[m, s], {k, 1, n}]]

The distributions are all normal

Union[Head /@ (dist /@ Range[5])]

(* {NormalDistribution} *)

The Mean is constant

μ[n_] = FindSequenceFunction[Mean[dist[#]] & /@ Range[5], n]

(* m *)

The Variance is

var[n_] = FindSequenceFunction[Variance[dist[#]] & /@ Range[5], n]

(* s^2/n *)

The StandardDeviation is

σ[n_] = Sqrt[var[n]] // Simplify

(* Sqrt[1/n] s *)

The general result is then

NormalDistribution[μ[n], σ[n]]

(* NormalDistribution[m, Sqrt[1/n] s] *)

Checking,

And @@ Table[dist[n] == NormalDistribution[μ[n], σ[n]], {n, 1, 20}]

(* True *)

Answer 5

If I correctly understand the question, it can be done as follows.

Table[TransformedDistribution[Total[Table[x[i], {i, 1, n}]]/n, 
Table[x[i] \[Distributed] NormalDistribution[\[Mu], \[Sigma]], {i, 
1, n}]], {n, 1, 4}]

{NormalDistribution[\[Mu], \[Sigma]], NormalDistribution[\[Mu], Abs[\[Sigma]]/Sqrt[2]], NormalDistribution[\[Mu], Abs[\[Sigma]]/Sqrt[3]], NormalDistribution[\[Mu], Abs[\[Sigma]]/2]}

Addition. How about that tricky way (TransformedDistribution deals only with concrete sums.)?

n = 3; z = TransformedDistribution[Total[Table[x[i], {i, 1, n}]]/n, 
Table[x[i] \[Distributed] NormalDistribution[\[Mu], \[Sigma]], {i, 1, n}]];
Clear[n]; Replace[z, 3 -> n, 3]

NormalDistribution[\[Mu], Abs[\[Sigma]]/Sqrt[n]]

Answer 6

This is doesn't work, but I've not deleted it as I think it's interesting

You can do a lot of this purely symbolically. For example, you can define a transformed distribution giving the sum of an arbitrary number of IID random variables (with an arbitrary distribution).

\[ScriptD] = 
  TransformedDistribution[1/n Sum[Indexed[x, i], {i, 1, n}], 
   Indexed[x, i] \[Distributed] \[ScriptCapitalD]];

You can apply Mean and Variance to this...

{Mean[\[ScriptD]], Variance[\[ScriptD]]};

... but it doesn't do anything useful, until you substitute a specific distribution...

{Mean[\[ScriptD]], 
  Variance[\[ScriptD]]} /. {{\[ScriptCapitalD] -> 
    NormalDistribution[μ, σ]}, {\[ScriptCapitalD] -> 
    ExponentialDistribution[1/μ]}}
(* {{μ, σ^2}, {μ, μ^2}} *)

And as you wished, substituting specific distributions give the distributions of the sample mean

\[ScriptD] /. {{\[ScriptCapitalD] -> 
     NormalDistribution[μ, σ]}, {\[ScriptCapitalD] -> 
     ExponentialDistribution[1/μ]}} // FullSimplify
(* {NormalDistribution[μ, σ], 
 ExponentialDistribution[1/μ]} *)

Unfortunately, as you'll note the answers are wrong. It assumes that all the Indexed[x,i] are the same value