Some examples of estimations using the market models of the package

This short tutorial covers the very basic use cases to get you started with diseq. More usage details can be found in the documentation of the package.

Setup the environment

Load the required libraries.

library(diseq)
library(magrittr)

Prepare the data. Normally this step is long and it depends on the nature of the data and the considered market. For this example, we will use simulated data. Although we could simulate data independently from the package, we will use the top-level simulation functionality of diseq to simplify the process. See the documentation of simulate_data for more information on the simulation functionality. Here, we simulate data using a data generating process for a market in disequilibrium with stochastic price dynamics.

nobs <- 2000
tobs <- 5

alpha_d <- -0.1
beta_d0 <- 9.8
beta_d <- c(0.3, -0.2)
eta_d <- c(0.6, -0.1)

alpha_s <- 0.1
beta_s0 <- 5.1
beta_s <- c(0.9)
eta_s <- c(-0.5, 0.2)

gamma <- 1.2
beta_p0 <- 3.1
beta_p <- c(0.8)

sigma_d <- 1
sigma_s <- 1
sigma_p <- 1
rho_ds <- 0.0
rho_dp <- 0.0
rho_sp <- 0.0

seed <- 443

stochastic_adjustment_data <- simulate_data(
  "diseq_stochastic_adjustment", nobs, tobs,
  alpha_d, beta_d0, beta_d, eta_d,
  alpha_s, beta_s0, beta_s, eta_s,
  gamma, beta_p0, beta_p,
  sigma_d = sigma_d, sigma_s = sigma_s, sigma_p = sigma_p,
  rho_ds = rho_ds, rho_dp = rho_dp, rho_sp = rho_sp,
  seed = seed
)

Initialize the model

The constructor sets the basic parameters for model initialization and constructs a model object. The needed arguments for a construction call are configured as follows:

Set the fields that uniquely identify data rows. For panel data this should be a vector of the entity identifier and the time columns.

key_columns <- c("id", "date")

Set time field. This is needed for the calculation of price’s first differences. The diseq_directional, diseq_deterministic_adjustment, and diseq_stochastic_adjustment models require calculating the first differences.

time_column <- c("date")

Set the quantity variable. The quantity variable is the observable. For the equilibrium models, it is equal with both the demanded and supplied quantities. For the disequilibrium models, the observed quantity represents either a demanded or a supplied quantity. Each disequilibrium model resolves that state of the observation in a different way.

quantity_column <- "Q"

Set the price variable.

price_column <- "P"

Set the remaining demand and supply variables. Simply include the factor variables here as in a usual lm formula. Indicator variables and interaction terms will be created automatically by the constructor. For the diseq_directional model, the price cannot go in both equations. For the rest of the models, the price can go in both equations if treated as exogenous. The diseq_stochastic_adjustment requires also the specification of price dynamics.

demand_specification <- paste0(price_column, " + Xd1 + Xd2 + X1 + X2")
supply_specification <- "Xs1 + X1 + X2"
price_specification <- "Xp1"

Set the verbosity level. This controls the level of messaging. The object displays
- error: always,
- warning: . \(\ge\) 1,
- info: . \(\ge\) 2,
- verbose: . \(\ge\) 3 and
- debug :. \(\ge\) 4.

verbose <- 2

Should the estimation allow for correlated demand and supply shocks?

correlated_shocks <- TRUE

Using the above parameterization, construct the model objects. Here, we construct an equilibrium model and four disequilibrium models, using in all cases the same data simulated by the process based on the stochastic price adjustment model. Of course, this is only done to simplify the exposition of the functionality. The constructors of the models that use price dynamics information in the estimation, i.e. diseq_directional, diseq_deterministic_adjustment, and diseq_stochastic_adjustment, will automatically generate lagged prices and drop one observation per entity.

eqmdl <- new(
  "equilibrium_model",
  key_columns,
  quantity_column, price_column,
  demand_specification, paste0(price_column, " + ", supply_specification),
  stochastic_adjustment_data,
  correlated_shocks = correlated_shocks, verbose = verbose
)
#> Info: This is 'Equilibrium with correlated shocks' model
bsmdl <- new(
  "diseq_basic",
  key_columns,
  quantity_column, price_column,
  demand_specification, paste0(price_column, " + ", supply_specification),
  stochastic_adjustment_data,
  correlated_shocks = correlated_shocks, verbose = verbose
)
#> Info: This is 'Basic with correlated shocks' model
drmdl <- new(
  "diseq_directional",
  key_columns, time_column,
  quantity_column, price_column,
  demand_specification, supply_specification,
  stochastic_adjustment_data,
  correlated_shocks = correlated_shocks, verbose = verbose
)
#> Info: This is 'Directional with correlated shocks' model
#> Info: Dropping 2000 rows by generating 'LAGGED_P'.
#> Info: Sample separated with 9 rows in excess supply and 7991 in excess demand regime.
damdl <- new(
  "diseq_deterministic_adjustment",
  key_columns, time_column,
  quantity_column, price_column,
  demand_specification, paste0(price_column, " + ", supply_specification),
  stochastic_adjustment_data,
  correlated_shocks = correlated_shocks, verbose = verbose
)
#> Info: This is 'Deterministic Adjustment with correlated shocks' model
#> Info: Dropping 2000 rows by generating 'LAGGED_P'.
#> Info: Sample separated with 9 rows in excess supply and 7991 in excess demand regime.
samdl <- new(
  "diseq_stochastic_adjustment",
  key_columns, time_column,
  quantity_column, price_column,
  demand_specification, paste0(price_column, " + ", supply_specification),
  price_specification,
  stochastic_adjustment_data,
  correlated_shocks = correlated_shocks, verbose = verbose
)
#> Info: This is 'Stochastic Adjustment with correlated shocks' model
#> Info: Dropping 2000 rows by generating 'LAGGED_P'.

Estimation

First, we need to set the estimation parameters and choose and estimation method. The only model that can be estimated by least squares is the equilibrium_model. To estimate the model with this methodology call diseq::estimate with method = 2SLS set. The equilibrium_model can also be estimated using full information maximum likelihood, as it is the case for all the disequilibrium models. One may choose an optimization method and the corresponding optimization controls. The available methods are:

Nelder-Mead: Does not require the gradient of the likelihood to be known.
BFGS: Uses the analytically calculated gradients. By default the diseq package uses this method.
L-BFGS-B: Constrained optimization.

optimization_method <- "BFGS"
optimization_controls <- list(REPORT = 10, maxit = 10000, reltol = 1e-6)

Then, estimate the models. See the documentation for more options.

eqmdl_reg <- estimate(eqmdl, method = "2SLS")
eqmdl_est <- estimate(eqmdl,
  control = optimization_controls, method = optimization_method,
  standard_errors = c("id")
)
bsmdl_est <- estimate(bsmdl,
  control = optimization_controls, method = optimization_method,
  standard_errors = "heteroscedastic"
)
drmdl_est <- estimate(drmdl,
  control = optimization_controls, method = optimization_method,
  standard_errors = "heteroscedastic"
)
damdl_est <- estimate(damdl,
  control = optimization_controls, method = optimization_method,
  standard_errors = c("id")
)
samdl_est <- estimate(samdl,
  control = optimization_controls, method = optimization_method,
  standard_errors = c("id")
)

Post estimation analysis

Marginal effects

Calculate marginal effects on the shortage probabilities. Diseq offers two marginal effect calls out of the box. The mean marginal effects and the marginal effects ate the mean. Marginal effects on the shortage probabilities are state-dependent. If the variable is only in the demand equation, the output name of the marginal effect is the variable name prefixed by D_. If the variable is only in the supply equation, the name of the marginal effect is the variable name prefixed by S_. If the variable is in both equations, then it is prefixed by B_.

variables <- c(price_column, "Xd1", "Xd2", "X1", "X2", "Xs1")

bsmdl_mme <- sapply(variables,
  function(v) shortage_probability_marginal(bsmdl, bsmdl_est@coef, v),
  USE.NAMES = FALSE
)
drmdl_mme <- sapply(variables,
  function(v) shortage_probability_marginal(drmdl, drmdl_est@coef, v),
  USE.NAMES = FALSE
)
damdl_mme <- sapply(variables,
  function(v) shortage_probability_marginal(damdl, damdl_est@coef, v),
  USE.NAMES = FALSE
)
samdl_mme <- sapply(variables,
  function(v) shortage_probability_marginal(samdl, samdl_est@coef, v),
  USE.NAMES = FALSE
)
bsmdl_mem <- sapply(variables,
  function(v) {
    shortage_probability_marginal(bsmdl, bsmdl_est@coef, v,
      aggregate = "at_the_mean"
    )
  },
  USE.NAMES = FALSE
)
drmdl_mem <- sapply(variables,
  function(v) {
    shortage_probability_marginal(drmdl, drmdl_est@coef, v,
      aggregate = "at_the_mean"
    )
  },
  USE.NAMES = FALSE
)
damdl_mem <- sapply(variables,
  function(v) {
    shortage_probability_marginal(damdl, damdl_est@coef, v,
      aggregate = "at_the_mean"
    )
  },
  USE.NAMES = FALSE
)
samdl_mem <- sapply(variables,
  function(v) {
    shortage_probability_marginal(samdl, samdl_est@coef, v,
      aggregate = "at_the_mean"
    )
  },
  USE.NAMES = FALSE
)

cbind(
  bsmdl_mme, drmdl_mme, damdl_mme, samdl_mme, bsmdl_mem, drmdl_mem, damdl_mem,
  samdl_mem
)
#>         bsmdl_mme     drmdl_mme     damdl_mme   samdl_mme   bsmdl_mem
#> B_P   -0.03116252 -0.0001311817 -0.0009663191 -0.04037366 -0.04445983
#> D_Xd1  0.06380186  0.0003380489  0.0014376743  0.06073446  0.09102664
#> D_Xd2 -0.03847220  0.0001247948 -0.0009408077 -0.03545453 -0.05488861
#> B_X1   0.22980161  0.0009789019  0.0053218947  0.22223228  0.32785985
#> B_X2  -0.07253722  0.0020569042 -0.0012012494 -0.05206977 -0.10348945
#> S_Xs1 -0.19442844 -0.0006311324 -0.0044621154 -0.19309798 -0.27739266
#>           drmdl_mem     damdl_mem   samdl_mem
#> B_P   -6.251634e-05 -0.0002319415 -0.05602628
#> D_Xd1  1.611016e-04  0.0003450789  0.08428082
#> D_Xd2  5.947257e-05 -0.0002258181 -0.04920002
#> B_X1   4.665084e-04  0.0012773920  0.30839032
#> B_X2   9.802444e-04 -0.0002883308 -0.07225689
#> S_Xs1 -3.007744e-04 -0.0010710228 -0.26796084

Shortages

Copy the disequilibrium model tibble and augment it with post-estimation data. The disequilibrium models can be used to estimate:

Shortage probabilities. These are the probabilities that the disequilibrium models assign to observing a particular extent of excess demand.
Normalized shortages. The point estimates of the shortages are normalized by the variance of the difference of the shocks of demand and supply.
Relative shortages: The point estimates of the shortages are normalized by the estimated supplied quantity.

mdt <- tibble::add_column(
  bsmdl@model_tibble,
  normalized_shortages = c(normalized_shortages(bsmdl, bsmdl_est@coef)),
  shortage_probabilities = c(shortage_probabilities(bsmdl, bsmdl_est@coef)),
  relative_shortages = c(relative_shortages(bsmdl, bsmdl_est@coef))
)

How is the sample separated post-estimation? The indices of the observations for which the estimated demand is greater than the estimated supply are easily obtained.

abs_estsep <- c(
  nobs = length(shortage_indicators(bsmdl, bsmdl_est@coef)),
  nshortages = sum(shortage_indicators(bsmdl, bsmdl_est@coef)),
  nsurpluses = sum(!shortage_indicators(bsmdl, bsmdl_est@coef))
)
print(abs_estsep)
#>       nobs nshortages nsurpluses 
#>      10000       6005       3995

rel_estsep <- abs_estsep / abs_estsep["nobs"]
names(rel_estsep) <- c("total", "shortages_share", "surpluses_share")
print(rel_estsep)
#>           total shortages_share surpluses_share 
#>          1.0000          0.6005          0.3995

if (requireNamespace("ggplot2", quietly = TRUE)) {
  ggplot2::ggplot(mdt, ggplot2::aes(normalized_shortages)) +
    ggplot2::geom_density() +
    ggplot2::ggtitle(paste0(
      "Normalized shortages density (",
      model_name(bsmdl), ")"
    ))
}

Summaries

All the model estimates support the summary function. The eq_2sls provides also the first stage estimation. The summary output comes from systemfit. The remaining models are estimated using maximum likelihood and the summary functionality is based on bbmle.

summary(eqmdl_reg$first_stage_model)
#> 
#> Call:
#> lm(formula = first_stage_formula, data = object@model_tibble)
#> 
#> Residuals:
#>      Min       1Q   Median       3Q      Max 
#> -16.6628  -5.8648   0.6677   6.2961  18.0452 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)    
#> (Intercept) 20.63325    0.84994  24.276  < 2e-16 ***
#> Xd1          0.35530    0.15154   2.345   0.0191 *  
#> Xd2         -0.06874    0.15005  -0.458   0.6469    
#> X1           0.58717    0.15052   3.901 9.65e-05 ***
#> X2          -0.18630    0.15021  -1.240   0.2149    
#> Xs1         -0.60577    0.15126  -4.005 6.25e-05 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 7.503 on 9994 degrees of freedom
#> Multiple R-squared:  0.003851,   Adjusted R-squared:  0.003353 
#> F-statistic: 7.728 on 5 and 9994 DF,  p-value: 2.898e-07
summary(eqmdl_reg$system_model)
#> 
#> systemfit results 
#> method: 2SLS 
#> 
#>            N    DF    SSR detRCov   OLS-R2 McElroy-R2
#> system 20000 19989 597716 87.6228 -29.7213  -0.763774
#> 
#>            N   DF    SSR     MSE    RMSE       R2   Adj R2
#> demand 10000 9994 488427 48.8721 6.99086 -49.2083 -49.2334
#> supply 10000 9995 109289 10.9344 3.30671 -10.2344 -10.2389
#> 
#> The covariance matrix of the residuals
#>          demand   supply
#> demand  48.8721 -21.1367
#> supply -21.1367  10.9344
#> 
#> The correlations of the residuals
#>           demand    supply
#> demand  1.000000 -0.914347
#> supply -0.914347  1.000000
#> 
#> 
#> 2SLS estimates for 'demand' (equation 1)
#> Model Formula: Q ~ P + Xd1 + Xd2 + X1 + X2
#> <environment: 0x55aa3a598a80>
#> Instruments: ~Xd1 + Xd2 + X1 + X2 + Xs1
#> <environment: 0x55aa3a598a80>
#> 
#>              Estimate Std. Error  t value   Pr(>|t|)    
#> (Intercept) 25.151899   4.501475  5.58748 2.3643e-08 ***
#> P           -0.898931   0.232656 -3.86378 0.00011235 ***
#> Xd1          0.467931   0.163652  2.85930 0.00425451 ** 
#> Xd2         -0.144971   0.140942 -1.02859 0.30369778    
#> X1           0.468274   0.196060  2.38842 0.01693926 *  
#> X2          -0.115913   0.145800 -0.79501 0.42662495    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 6.990856 on 9994 degrees of freedom
#> Number of observations: 10000 Degrees of Freedom: 9994 
#> SSR: 488427.398407 MSE: 48.872063 Root MSE: 6.990856 
#> Multiple R-Squared: -49.208252 Adjusted R-Squared: -49.233372 
#> 
#> 
#> 2SLS estimates for 'supply' (equation 2)
#> Model Formula: Q ~ P + Xs1 + X1 + X2
#> <environment: 0x55aa3a598a80>
#> Instruments: ~Xd1 + Xd2 + X1 + X2 + Xs1
#> <environment: 0x55aa3a598a80>
#> 
#>               Estimate Std. Error  t value   Pr(>|t|)    
#> (Intercept) -2.7883417  3.9483795 -0.70620   0.480081    
#> P            0.4476886  0.1843561  2.42839   0.015184 *  
#> Xs1          0.8150032  0.1302455  6.25744 4.0739e-10 ***
#> X1          -0.3225859  0.1269523 -2.54100   0.011069 *  
#> X2           0.1349937  0.0747959  1.80483   0.071132 .  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 3.306714 on 9995 degrees of freedom
#> Number of observations: 10000 Degrees of Freedom: 9995 
#> SSR: 109288.898698 MSE: 10.934357 Root MSE: 3.306714 
#> Multiple R-Squared: -10.234432 Adjusted R-Squared: -10.238928
bbmle::summary(eqmdl_est)
#> Maximum likelihood estimation
#> 
#> Call:
#> `bbmle::mle2`(list(method = "BFGS", control = list(REPORT = 10, 
#>     maxit = 10000, reltol = 1e-06), start = c(D_P = 0.0231239615913565, 
#> D_CONST = 7.53375095184334, D_Xd1 = 0.140015230368245, D_Xd2 = -0.0737970096786045, 
#> D_X1 = -0.074691417704378, D_X2 = 0.0462502352837326, S_P = 0.0248455188388157, 
#> S_CONST = 6.24286219183355, S_Xs1 = 0.558355600251176, S_X1 = -0.0743221338857006, 
#> S_X2 = 0.055148632519299, D_VARIANCE = 1, S_VARIANCE = 1, RHO = 0
#> ), minuslogl = function (...) 
#> minus_log_likelihood(object, ...), gr = function (...) 
#> gradient(object, ...)))
#> 
#> Coefficients:
#>              Estimate Std. Error   z value     Pr(z)    
#> D_P         0.3159244  0.0045821   68.9476 < 2.2e-16 ***
#> D_CONST     1.7194701  0.0604237   28.4569 < 2.2e-16 ***
#> D_Xd1       0.0461205  0.0063185    7.2993 2.893e-13 ***
#> D_Xd2      -0.0269259  0.0060076   -4.4820 7.396e-06 ***
#> D_X1       -0.2250915  0.0469480   -4.7945 1.631e-06 ***
#> D_X2        0.1233711  0.0437571    2.8195 0.0048106 ** 
#> S_P         0.4639733  0.0025746  180.2132 < 2.2e-16 ***
#> S_CONST    -0.6522037  0.1730953   -3.7679 0.0001646 ***
#> S_Xs1      -0.2248822  0.0109304  -20.5739 < 2.2e-16 ***
#> S_X1       -0.3016945  0.0656151   -4.5979 4.267e-06 ***
#> S_X2        0.1572998  0.0637950    2.4657 0.0136743 *  
#> D_VARIANCE  5.6234397  0.1445005   38.9164 < 2.2e-16 ***
#> S_VARIANCE 11.7119726  0.0518544  225.8626 < 2.2e-16 ***
#> RHO         0.9919664  0.0006193 1601.7420 < 2.2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> -2 log L: 95759.8
bbmle::summary(bsmdl_est)
#> Maximum likelihood estimation
#> 
#> Call:
#> `bbmle::mle2`(list(control = list(REPORT = 10, maxit = 10000, 
#>     reltol = 1e-06), method = "BFGS", skip.hessian = TRUE, start = c(D_P = 0.0231239615913565, 
#> D_CONST = 7.53375095184334, D_Xd1 = 0.140015230368245, D_Xd2 = -0.0737970096786045, 
#> D_X1 = -0.074691417704378, D_X2 = 0.0462502352837326, S_P = 0.0248455188388157, 
#> S_CONST = 6.24286219183355, S_Xs1 = 0.558355600251176, S_X1 = -0.0743221338857006, 
#> S_X2 = 0.055148632519299, D_VARIANCE = 1, S_VARIANCE = 1, RHO = 0
#> ), minuslogl = function (...) 
#> minus_log_likelihood(object, ...), gr = function (...) 
#> gradient(object, ...)))
#> 
#> Coefficients:
#>              Estimate Std. Error  z value     Pr(z)    
#> D_P        -0.0676616  0.0058162 -11.6332 < 2.2e-16 ***
#> D_CONST     9.0991112  0.2187177  41.6021 < 2.2e-16 ***
#> D_Xd1       0.3051367  0.0353591   8.6297 < 2.2e-16 ***
#> D_Xd2      -0.1839959  0.0347709  -5.2917 1.212e-07 ***
#> D_X1        0.5776872  0.0538274  10.7322 < 2.2e-16 ***
#> D_X2       -0.1443290  0.0394667  -3.6570 0.0002552 ***
#> S_P         0.0813753  0.0039160  20.7800 < 2.2e-16 ***
#> S_CONST     5.4182460  0.1554546  34.8542 < 2.2e-16 ***
#> S_Xs1       0.9298672  0.0399583  23.2709 < 2.2e-16 ***
#> S_X1       -0.5213546  0.0386502 -13.4890 < 2.2e-16 ***
#> S_X2        0.2025852  0.0326928   6.1966 5.769e-10 ***
#> D_VARIANCE  0.9286178  0.0446037  20.8193 < 2.2e-16 ***
#> S_VARIANCE  0.9959577  0.0317030  31.4152 < 2.2e-16 ***
#> RHO         0.1731087  0.0814380   2.1257 0.0335323 *  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> -2 log L: 26189.5
bbmle::summary(damdl_est)
#> Maximum likelihood estimation
#> 
#> Call:
#> `bbmle::mle2`(list(control = list(REPORT = 10, maxit = 10000, 
#>     reltol = 1e-06), method = "BFGS", start = c(D_P = -0.00260947112358515, 
#> D_CONST = 7.98130444023755, D_Xd1 = 0.15954441702268, D_Xd2 = -0.0956278531130884, 
#> D_X1 = 0.0454572982786684, D_X2 = 0.0215741337521343, S_P = 0.000425847047005336, 
#> S_CONST = 6.8876653018125, S_Xs1 = 0.467154949725634, S_X1 = 0.0442638269176111, 
#> S_X2 = 0.0274612448510507, P_DIFF = 1, D_VARIANCE = 1, S_VARIANCE = 1, 
#> RHO = 0), minuslogl = function (...) 
#> minus_log_likelihood(object, ...), gr = function (...) 
#> gradient(object, ...)))
#> 
#> Coefficients:
#>              Estimate Std. Error  z value     Pr(z)    
#> D_P        -0.1003664  0.0065747 -15.2656 < 2.2e-16 ***
#> D_CONST    12.3271066  0.2937472  41.9650 < 2.2e-16 ***
#> D_Xd1       0.1511296  0.0241664   6.2537 4.008e-10 ***
#> D_Xd2      -0.0988986  0.0223971  -4.4157 1.007e-05 ***
#> D_X1        0.6028142  0.0458154  13.1575 < 2.2e-16 ***
#> D_X2       -0.0992912  0.0306302  -3.2416  0.001189 ** 
#> S_P         0.0012140  0.0018705   0.6490  0.516336    
#> S_CONST     6.8681300  0.0987037  69.5833 < 2.2e-16 ***
#> S_Xs1       0.4690616  0.0204404  22.9478 < 2.2e-16 ***
#> S_X1        0.0433718  0.0207843   2.0868  0.036910 *  
#> S_X2        0.0269852  0.0200742   1.3443  0.178859    
#> P_DIFF      0.6093889  0.0378878  16.0840 < 2.2e-16 ***
#> D_VARIANCE  1.6865709  0.1134915  14.8608 < 2.2e-16 ***
#> S_VARIANCE  0.7979176  0.0128478  62.1052 < 2.2e-16 ***
#> RHO         0.6725925  0.0250009  26.9027 < 2.2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> -2 log L: 48414.93
bbmle::summary(samdl_est)
#> Maximum likelihood estimation
#> 
#> Call:
#> `bbmle::mle2`(list(control = list(REPORT = 10, maxit = 10000, 
#>     reltol = 1e-06), method = "BFGS", start = c(D_P = -0.00260947112358515, 
#> D_CONST = 7.98130444023755, D_Xd1 = 0.15954441702268, D_Xd2 = -0.0956278531130884, 
#> D_X1 = 0.0454572982786684, D_X2 = 0.0215741337521343, S_P = 0.000425847047005336, 
#> S_CONST = 6.8876653018125, S_Xs1 = 0.467154949725634, S_X1 = 0.0442638269176111, 
#> S_X2 = 0.0274612448510507, P_DIFF = 1, P_CONST = 8.28009900264685, 
#> P_Xp1 = -0.013207398816623, D_VARIANCE = 1, S_VARIANCE = 1, P_VARIANCE = 1, 
#> RHO_DS = 0, RHO_DP = 0, RHO_SP = 0), minuslogl = function (...) 
#> minus_log_likelihood(object, ...), gr = function (...) 
#> gradient(object, ...)))
#> 
#> Coefficients:
#>              Estimate Std. Error  z value     Pr(z)    
#> D_P        -0.0971316  0.0042708 -22.7430 < 2.2e-16 ***
#> D_CONST     9.7139866  0.1628629  59.6452 < 2.2e-16 ***
#> D_Xd1       0.2950376  0.0263814  11.1835 < 2.2e-16 ***
#> D_Xd2      -0.1722320  0.0262455  -6.5624 5.296e-11 ***
#> D_X1        0.5641836  0.0322828  17.4763 < 2.2e-16 ***
#> D_X2       -0.0869383  0.0266337  -3.2642  0.001098 ** 
#> S_P         0.0989968  0.0051352  19.2780 < 2.2e-16 ***
#> S_CONST     5.1636578  0.1508154  34.2383 < 2.2e-16 ***
#> S_Xs1       0.9380370  0.0347684  26.9796 < 2.2e-16 ***
#> S_X1       -0.5153828  0.0355065 -14.5152 < 2.2e-16 ***
#> S_X2        0.1660077  0.0275448   6.0268 1.672e-09 ***
#> P_DIFF      1.1852181  0.0332182  35.6798 < 2.2e-16 ***
#> P_CONST     3.2090705  0.0971997  33.0152 < 2.2e-16 ***
#> P_Xp1       0.7695691  0.0311411  24.7123 < 2.2e-16 ***
#> D_VARIANCE  0.9769727  0.0367130  26.6111 < 2.2e-16 ***
#> S_VARIANCE  1.0493231  0.0442629  23.7066 < 2.2e-16 ***
#> P_VARIANCE  0.9399843  0.0679687  13.8297 < 2.2e-16 ***
#> RHO_DS      0.0389034  0.0600740   0.6476  0.517250    
#> RHO_DP      0.0029079  0.0468756   0.0620  0.950535    
#> RHO_SP      0.0013893  0.0451614   0.0308  0.975458    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> -2 log L: 46400.96

The estimated demanded and supplied quantities can be calculated per observation.

market <- cbind(
  demand = demanded_quantities(bsmdl, bsmdl_est@coef)[, 1],
  supply = supplied_quantities(bsmdl, bsmdl_est@coef)[, 1]
)
summary(market)
#>      demand           supply      
#>  Min.   : 7.133   Min.   : 6.099  
#>  1st Qu.: 8.625   1st Qu.: 8.078  
#>  Median : 9.050   Median : 8.664  
#>  Mean   : 9.075   Mean   : 8.644  
#>  3rd Qu.: 9.520   3rd Qu.: 9.220  
#>  Max.   :11.087   Max.   :11.221

The package offers also basic aggregation functionality.

aggregates <- c(
  demand = aggregate_demand(bsmdl, bsmdl_est@coef),
  supply = aggregate_supply(bsmdl, bsmdl_est@coef)
)
aggregates
#>   demand   supply 
#> 90746.69 86439.00