Econometric Functions

A Warning Note!!!:  Mathematica's built-in Regress[] function assumes data in the form \(TraditionalForm
      \`{{\(x\_1\)\_1, \(x\_2\)\_1, ..., \(x\_k\)\_1, y\_1}, {\(x\_1\)\_2, 
          \(x\_2\)\_2, ..., \(x\_k\)\_2, y\_2}, ..., {\(x\_1\)\_T, 
          \(x\_2\)\_T, ..., \(x\_k\)\_T, y\_T}}\) but the simpleLinRegress[ ] here and used in some of the other functions assumes data of the form: \(TraditionalForm
      \`{{y\_1, \(x\_1\)\_1, \(x\_2\)\_1, ..., \(x\_k\)\_1}, {y\_2, 
          \(x\_1\)\_2, \(x\_2\)\_2, ..., \(x\_k\)\_2}, ..., {y\_T, 
          \(x\_1\)\_T, \(x\_2\)\_T, ..., \(x\_k\)\_T}}\).  This seemed to me to make more sense than the other presentation because we normally think of equations as reading from left to right with the regressand on the left-hand side and the regressors on the right.  It is also in line with the data ordering used in packages like Shazam.

simpleLinRegress[ ]: A Simple Linear Regression function built for speed not features

simpleLinRegress::usage = "simpleLinRegress[data_MatrixQ] takes a \
rectangular matrix of real numbers and performs a linear regression or \
weighted linear regression of the first column on the other columns. The \
output is a non-rectangular list of three lists -- the estimated \
coefficients, the fitted values and the residuals."

GLSWeights::usage  =  "GLSWeights is an option to simpleLinRegress \
that takes either the value Automatic, corresponding to OLS, or a list of \
real numbers corresponding to the weights to be used in a WLS \
procedure."

IncludeConstant::usage  =  "IncludeConstant is an option to \
simpleLinRegress that indicates whether or not a constant should be added to \
the data matrix."

simpleLinRegress::wtnum = "Either the vector of weights is not a \
vector of real numbers with the same number of element as the data sample \
size, or you have tried to apply WLS to a model with a single explanator and \
no constant."

simpleLinRegress::notnum  =  "Some of the data supplied is \
non-numeric."

Options[simpleLinRegress] = {GLSWeights -> Automatic, 
        IncludeConstant -> True}

SetOptions[simpleLinRegress, GLSWeights -> Automatic, 
      IncludeConstant -> True]

\(simpleLinRegress[data_?MatrixQ, \ opts___?OptionQ] := \ 
      If[And\  @@ \ \((NumericQ\  /@ \ 
              Flatten[data])\), 
		Module[{𝓌, 𝒸}, 𝓌\  = \ \(GLSWeights\  /. {opts}\)\  /. 
              Options[simpleLinRegress]; 
		𝒸\  = \ \(IncludeConstant\  /. {opts}\)\  /. 
              Options[simpleLinRegress]; 
		With[{𝓎 = 
                If[Not[𝒸] && \ \(Dimensions[
                          data]\)[[2]] == 
                      2, Flatten[First /@ data], 
                  First\  /@ \ data], 
							\ \ 𝓍\  = \ 
                If[𝒸, 
                  Transpose[
                    Join[{Table[1, {Length[data]}]}, 
                      Transpose[Rest\  /@ \ data]]], 
                  If[\(Dimensions[
                          Rest\  /@ 
                            data]\)[[2]] == 1, Flatten[Rest\  /@ \ data], Transpose[Rest\  /@ \ data]]], 𝓃 = 
                Length[data]}, 
			Module[{betas, yhat, \ 
                resids}, 
				Which[𝓌 === 
                  Automatic, \(betas\  = \ 
                    If[Not[𝒸] && \(Dimensions[
                              Rest\  /@ 
                                data]\)[[2]] == 
                          1, {\((1/\((𝓍 . 𝓍)\))\)*\((𝓍 . 𝓎)\)}, 
                      Flatten[
                        Inverse[\((Transpose[\ 𝓍] . \ 𝓍)\)] . \((Transpose[\ 𝓍] . 𝓎)\)]];\), 
					\((Length[𝓌] == 𝓃\ )\) && \((Length[𝓌] > 
                      1\ )\) && \ \((And\  @@ \ \((NumericQ\  /@ \ 𝓌)\))\), \ \(betas\  = 
                    Inverse[
                        Transpose[\((𝓌*𝓍)\)] . \((𝓍)\)] . \((\((Transpose[𝓌*𝓍])\) . \((𝓎)\))\);\), True, \ 
                Message[
                  simpleLinRegress::wtnum]; \ $Failed]; 
				yhat\  = 
                If[Not[𝒸] && \ \(Dimensions[
                          data]\)[[2]] == 
                      2, 𝓍*
                    betas[[1]], \ 𝓍 . betas]; 
				resids\  = \ 𝓎 - 
                  yhat; 
				{betas, yhat, resids}]]], 
        Message[simpleLinRegress::notnum]]\)

ARLagOrderSelectionTable[ ]

This function has been updated thanks to helpful comments by Virgil Stokes.

\(ARLagOrderSelectionTable::usage = "ARLagOrderSelectionTable[data,maxp] takes a time series (vector of real numbers) and generates a table of various Information Criteria used for selecting the optimal lag order in an AR model describing the time series. It also presents the estimated coefficients of each implied AR model (with the constant first).  This function depends on the simpleLinRegress[] function."\)

\(ARLagOrderSelectionTable[data : {__Real}, \ 
          maxp_Integer]\  /; \ \((maxp\  < \ Length[data])\)\  := 
	
      Module[{σ2, βs\ , \ T = Length[data]}, 
		Table[
          With[{result = 
                simpleLinRegress[
                  Transpose[
                    Table[Drop[RotateRight[data, k], j], \ {k, 0, j}]], 
                  IncludeConstant -> True]}, σ2[j] = 
              Plus\  @@ \((\((result[[3]])\)^2)\); βs[j] = 
              First[result];], {j, maxp}]; \ 
	
        Join[{{"p", \*""(σ^2)"", "AIC(p)", "AICC(p)", "SC(p)", \ "Hannan-Quinn(p)", "coefs"}}, 
          Table[{i, σ2[i], Log[\((σ2[i])\)^2] + \ 2\ i\ /T, \ 
              T*\ Log[\((σ2[i])\)^2] + 
                T\ \((1\  + \ i/T)\)/\((1 - \((i + 2)\)\ T)\), 
              Log[σ2[i]] + i\ Log[T]/T, \ 
              Log[σ2[i]]\  + \ 
                2\ i\ *Log[Log[T]]/T, {βs[i]}}, {i, 1, 
              maxp}]\ ]\ ]\)

LjungBoxStatistic[ ]

LjungBoxStatistic::usage = 
      "LjungBoxStatistic[data,k] takes a vector of real numbers and \
generates the Ljung-Box(k) test statistic and critical value. The Ljung-Box \
test statistic is used for establishing serial correlation and is distributed \
as Chi-square(k)."

Needs["Statistics`NormalDistribution`"]

ljungboxcompiledteststat = 
      Compile[{{x, _Real, 1}, {k, _Integer}},  
        (∑_(i = 1)^k)(
            (Plus@@(Drop[x, -i]×Drop[x, i])/
                    ((Sqrt[Plus])@@(Drop[x, -i]^2) 
                        (Sqrt[Plus])@@(Drop[x, i]^2)))^2 
              ((Length[x] (Length[x] - 2))/(Length[x] - i)))]

\(LjungBoxStatistic[data : {__Real}, k_Integer] := 

      TableForm[
        	{{"test stat", "5% critical value"}, {
            ljungboxcompiledteststat[data, k], 
            Quantile[ChiSquareDistribution[k], 0.95]}}]\)

CochraneOrcutt[ ]

CochraneOrcutt::usage = 
      "CochraneOrcutt[data] takes a matrix of real numbers and performs the \
Cochrane-Orcutt iterative procedure for estimating linear models in the \
presence of AR(1) serial correlation in the errors."

Needs["Statistics`NormalDistribution`"];
Needs["Statistics`ContinuousDistributions`"];
Needs["Statistics`DataManipulation`"];
Needs["Statistics`DescriptiveStatistics`"];
Needs["Statistics`MultiDescriptiveStatistics`"];
Needs["Statistics`LinearRegression`"];
Needs["Statistics`DataSmoothing`"];

CochraneOrcutt[data_?MatrixQ] :=  
      FixedPoint[
        With[{e = 
                simpleLinRegress[#, IncludeConstant -> True]
                    [[3]]}, 
            With[{rhohat = 
                  Rest[e].Drop[e, -1]/Plus@@(Drop[e, -1]^2)}, 
              Join[{(Sqrt[1 - (rhohat^2)])×First[#]}, 
                Rest[#] - rhohat Drop[#, -1]]]]&, data]