R/generics.R

In skranz/BLPestimatoR: Performs a BLP Demand Estimation

#' @export
summary.blp <- function( object , ... ){

  if( class( object ) != "blp" )
    stop("Argument is not of class *blp* .")

  ans <- object

  est.linear <- ans$theta.lin
  se.linear <- ans$se.linear
  tval.linear <- est.linear/se.linear

  est.rc <- ans$theta.rc
  se.rc <- ans$se.rc
  tval.rc <- est.rc/se.rc


  ans$LinCoefficients <- as.data.frame( cbind( est.linear ,
                                               se.linear ,
                                               tval.linear ,
                                               2 * pnorm(abs(tval.linear ),
                                                         lower.tail = FALSE)) )
  ans$AmountLinCoef <- length(est.linear)

  ans$RcCoefficients <- as.data.frame( cbind(est.rc,
                                             se.rc,
                                             tval.rc,
                                             2 * pnorm(abs(tval.rc),
                                                       lower.tail = FALSE)) )
  ans$AmountRcCoef <- length(est.rc)

  # Rownames mit Demographic / RC angabe
  RcCoefficients <- c( ans$RcNames )
  if(  ans[["#demogrCoef"]] > 0 ){
    RcCoefficients <- c( RcCoefficients,
                         kronecker( ans$demographicNames, ans$RcNames, paste)) }

  relevantRcDem_index <- ans$indices[,"row"] +
    max( ans$indices[,"row"] ) * ( ans$indices[,"col"] - 1 )

  names( ans$LinCoefficients ) <- c("Estimate", "Std. Error", "t value", "Pr(>|t|)")
  names( ans$RcCoefficients ) <- c("Estimate", "Std. Error", "t value", "Pr(>|t|)")
  rownames( ans$RcCoefficients ) <- RcCoefficients[ relevantRcDem_index ]

  # Waldstat
  ans$wald_pvalue <- pchisq( ans$WaldStatistic ,
                             df = ans$AmountRcCoef,
                             lower.tail = FALSE )


  class(ans) <- "blpSummary"
  return(ans) # printing ans
}




#' @export
print.blpSummary <- function( x, ... ){

  if( class(x) != "blpSummary" )
    stop("Argument is not of class *blpSummary* .")

  ##
  cat("\nData information:\n")
    cat( "\n\t", paste0( x[['#nmkt']] , " market(s) with " , x[['#nobs']] , " products") , "\n" )
    cat( "\t", paste0( x[['AmountLinCoef']] , " linear coefficient(s) (" , x[['#exoCoef']] , " exogenous coefficients)") , "\n" )
    cat( "\t", paste0( x[['AmountRcCoef']] , " random coefficient(s)" ) , "\n" )
    cat( "\t", paste0( x[['#demogrCoef']] , " demographic variable(s)" ) , "\n" )

  ##
  cat("\nEstimation results:\n")

  cat("\n Linear Coefficients\n")
      if( x$AmountLinCoef <= 20){
        print( x$LinCoefficients )
      } else {
        print( x$LinCoefficients[1:20, ] )
        cat( "\n...\n" )
        cat( paste("\n", x$AmountLinCoef - 20,
                   "estimates are omitted. They are available in the x generated by summary.\n" ) )
      }


  cat("\n Random Coefficients\n")
      if( x$AmountRcCoef <= 20){
        print( x$RcCoefficients )
      } else {
        print( x$RcCoefficients[1:20, ] )
        cat( "\n...\n" )
        cat( paste("\n", x$AmountRcCoef - 20,
                   "estimates are omitted. They are available in the x generated by summary.\n" ) )
      }


  cat("\n Wald Test\n")
  cat( paste( round( x$WaldStatistic , 4 ), "on ",
                x$AmountRcCoef , "DF, p-value:" ,
                x$wald_pvalue, "\n"  ))


  ##
  cat("\nComputational Details: \n")
    cat( "\n\t Starting guesses: ")
    cat( round( c(x$startingGuesses),2)  , "\n" )
    cat( "\t", paste0("Solver converged with method ", x$solver) )
    cat(  paste0( " and ", x$outer.it," iterations to a minimum at ",
                      round( x$local.minimum, 4 )) ,".\n" )
    cat( "\t", paste0("Local minima check: ", x$IslocalMin , "\n" ))
    cat( "\t", paste0("stopping criterion outer loop: " , x$outerCrit, "\n" ))
    cat( "\t", paste0("stopping criterion inner loop: " , x$innerCrit , "\n" ))
    cat( "\t", paste0("Market shares are integrated with " , x$intMethod , " and ", x$intNodes ," nodes. \n" ))
    cat( "\t", paste0("Method for standard errors: " , x$standardErrorMethod , "\n" ))

}