R/summary.R

In f1kidd/fmlogit: Fractional Multinomial Logit using QMLE

#' Generate summary tables for fmlogit objects
#' 
#' Generate tables of coefficient estimates, partial effects, and willingness to pay from
#' fmlogit-type objects. 
#' 
#' @name summary.fmlogit
#' @aliases summary.fmlogit.margins
#' @aliases summary.fmlogit.wtp
#' 
#' @param object an object with class "fmlogit", "fmlogit.margins", or "fmlogit.wtp". 
#' @param varlist select a subset of variable names to be processed. Default to NULL, of which all variables will
#' be processed.
#' @param sepline whether the output table uses separate lines for coefficients and standard errors. 
#' @param digits number of digits to be signifed. Default to show 3 digits. 
#' @param add.info whether to add additional descriptive information to the output. 
#' @param list whether to output a list object, or a single data frame. 
#' @param sigcode the significance code to be used. Has to be a three-component vector. 
#' @return Either a list (for display purposes) or a data.frame (for csv output purposes). If list return (which is
#' the default) is selected, then the list will contain 4 components: $estimates the estimate; $N number of 
#' observations, $llf value of the log-likelihood function; and $baseline the name of the baseline choice. 
#' 
#' @details This module provides summary methods for three fmlogit objects: \code{fmlogit}, \code{fmlogit.margins}
#' , and \code{fmlogit.wtp}. 
#' 
#' The summary method offers several options to the users. The user can choose for a list output \code{list=T}, which is
#'  good for display and quoting purposes, or a data frame output \code{list=F}, which is good for table outputs. The user
#' can also specify whether to provide additional information other than the parameter estimates, whether to use 
#' seperate lines for the estimates and the standard errors (which mimics the output style in Stata),
#'  as well as the significance code. 
#' 
#' @examples 
#' # generate fmlogit summary
#' #results1 = fmlogit(y,X)
#' 
#' # generate marginal effects summary
#' #effects1 = effects(results1,effect="marginal")
#' summary(effects1)
#' 
#' # generate latex style output
#' # require(xtable)
#' xtable(summary(effects1,list=F,sepline=T))
#' @rdname summary.fmlogit
#' @export summary.fmlogit

############
# generate fmlogit style table
###########

summary.fmlogit = function(object,varlist=NULL,sepline=F,digits=3,add.info=T,list=T,sigcode=c(0.05,0.01,0.001),
                           print=F){
  # define significance code first. 
  asterisk = function(x,k=sigcode){
    if(x>k[1]) return("")
    if(x>k[2]) return("*")
    if(x>k[3]){return("**")}else
    {return("***")}
  }
  # main text  
  # pre matters
  if(!class(object)=="fmlogit") stop("Expect an fmlogit object. Wrong object type given.")
  ynames = names(object[[1]]); Xnames = rownames(object[[1]][[1]])
  if(length(varlist)==0){varlist=Xnames}
  var_colNo = which(Xnames %in% varlist)
  j = object$count[3]; K = length(var_colNo)
  if(K < length(varlist)) warning("Some variables requested are not in the variable list. Those variables are omitted.")
  varlist = Xnames[var_colNo]
  # generating tables
  if(!sepline){
    store_mat = matrix(ncol=j-1,nrow=K)
    colnames(store_mat)=ynames
    rownames(store_mat)=Xnames[var_colNo]
    for(i in 1:(j-1)){
      temp_data = signif(object$estimates[[i]][var_colNo,],digits=digits)
      if(is.null(dim(temp_data))){
        store_mat[,i] = paste(temp_data[1],"(",temp_data[2],")",asterisk(temp_data[4]),sep="")
        next
      }
      store_mat[,i]=apply(temp_data, 1, function(x) paste(x[1],"(",x[2],")",asterisk(x[4]),sep=""))    
    }}else{
      store_beta = store_se = matrix(ncol=j-1,nrow=K)   
      colnames(store_beta)=ynames
      rownames(store_beta)=varlist
      for(i in 1:(j-1)){
        temp_data = signif(object$estimates[[i]][var_colNo,],digits=digits)
        if(is.null(dim(temp_data))) temp_data = as.matrix(temp_data)
        store_beta[,i]=apply(temp_data,1, function(x) paste(x[1],asterisk(x[4]),sep=""))
        store_se[,i]=apply(temp_data, 1, function(x) paste("(",x[2],")",sep=""))
      }
      for(i in 1:K){
        if(i==1) store_mat=matrix(ncol=j-1)
        store_mat = rbind(store_mat,store_beta[i,],store_se[i,])
      }
      store_mat=store_mat[-1,]
      rownames(store_mat) = rep(" ",length=nrow(store_mat))
      rownames(store_mat)[seq(1,K*2,2)] = varlist
    }
  # output matters
  sig.print = paste("Significance code: 0", "'***'", sigcode[3], "'**'", sigcode[2], "'*'", sigcode[1], "' ", 1)
  if(add.info){
    nc = paste("N=",object$count[1],sep="")
    llf = paste("log pseudo-likelihood=",round(object$likelihood,digits=2),sep="")
    bl = paste("Baseline choice:", object$baseline)
  }
  if(list){
    outlist = list(estimates=store_mat)
    if(add.info){
      outlist$N = nc
      outlist$llf = llf
      outlist$baseline = bl
      outlist$sigcode = sig.print
    }
    if(print){print(outlist)}
    return(outlist)
  }else{
    if(add.info){
      info = matrix(ncol=j-1,nrow=4)
      info[,1] = c(nc,llf,bl,sig.print)
      store_mat = rbind(store_mat,info)
    }
    if(print){print(store_mat)}
    return(as.data.frame(store_mat))
  }
}

##########
# summary for fmlogit.margins
##########

#' @rdname summary.fmlogit
#' @export summary.fmlogit.margins

summary.fmlogit.margins = function(object,varlist=NULL,sepline=F,digits=3,add.info=T,list=T,sigcode=c(0.05,0.01,0.001),
                                   print=F){
  # define significance code first. 
  asterisk = function(x,k=sigcode){
    if(x>k[1]) return("")
    if(x>k[2]) return("*")
    if(x>k[3]){return("**")}else
    {return("***")}
  }
  # main text  
  if(!class(object)=="fmlogit.margins") stop("Expect an fmlogit.margins object. Wrong object type given.")
  ynames = rownames(object[[1]]); Xnames = colnames(object[[1]])
  if(length(varlist)==0) varlist=Xnames
  var_colNo = which(Xnames %in% varlist)
  j = length(ynames); K = length(var_colNo)
  if(K < length(varlist)) warning("Some variables requested are not in the variable list. Those variables are omitted.")
  varlist = Xnames[var_colNo]
  
  # table process
  if(object$R==0) sepline=FALSE
  if(!sepline){
    store_mat = matrix(ncol=j,nrow=K)
    colnames(store_mat)=ynames
    rownames(store_mat)=Xnames
    if(object$R>0){
      for(i in var_colNo){
        temp_data = signif(object$ztable[[i]],digits=digits)
        store_mat[i,]=apply(temp_data, 1, function(x) paste(x[1],"(",x[2],")",asterisk(x[4]),sep=""))    
      }}else{
        store_mat = signif(t(object$effects),digits=digits)
      }
  }else{
    store_beta = store_se = matrix(ncol=j,nrow=K)   
    colnames(store_beta)=ynames
    rownames(store_beta)=Xnames
    for(i in var_colNo){
      temp_data = signif(object$ztable[[i]],digits=digits)
      store_beta[i,]=apply(temp_data,1, function(x) paste(x[1],asterisk(x[4]),sep=""))
      store_se[i,]=apply(temp_data, 1, function(x) paste("(",x[2],")",sep=""))
    }
    for(i in 1:K){
      if(i==1) store_mat=matrix(ncol=j)
      store_mat = rbind(store_mat,store_beta[i,],store_se[i,])
    }
    store_mat=store_mat[-1,]
    rownames(store_mat) = rep("",length=nrow(store_mat))
    rownames(store_mat)[seq(1,K*2,2)] = varlist
  }
  # output matters
  sig.print = paste("Significance code: 0", "'***'", sigcode[3], "'**'", sigcode[2], "'*'", sigcode[1], "' ", 1)
  if(add.info){
    expl = object$expl
  }
  if(list){
    outlist = list(estimates=store_mat)
    if(add.info){
      outlist$expl = expl
      outlist$sigcode = sig.print
    }
    if(print){print(outlist)}
    return(outlist)
  }else{
    if(add.info){
      info = matrix(ncol=j,nrow=2)
      info[,1] = c(expl,sig.print)
      store_mat = rbind(store_mat,info)
    }
    if(print){print(store_mat)}
    return(as.data.frame(store_mat))
  }
}

############
# generate willingness to pay tables
############

#' @rdname summary.fmlogit
#' @export summary.fmlogit.wtp

summary.fmlogit.wtp = function(object,varlist=NULL,sepline=F,digits=3,sigcode=c(0.05,0.01,0.001),
                               print=F){
  # define significance code first. 
  asterisk = function(x,k=sigcode){
    if(x>k[1]) return("")
    if(x>k[2]) return("*")
    if(x>k[3]){return("**")}else
    {return("***")}
  }
  # main text  
  if(!class(object)=="fmlogit.wtp") stop("Expect an fmlogit.wtp object. Wrong object type given.")
  if(colnames(object$wtp)[1]!="estimate") return(object$wtp) # no need to summary. 
  Xnames = rownames(object$wtp)
  if(length(varlist)==0) varlist=Xnames
  var_colNo = which(Xnames %in% varlist)
  K = length(var_colNo)
  if(K < length(varlist)) warning("Some variables requested are not in the variable list. Those variables are omitted.")
  varlist = Xnames[var_colNo]
  sig.print = paste("Significance code: 0", "'***'", sigcode[3], "'**'", sigcode[2], "'*'", sigcode[1], "' ", 1)
  if(!sepline){
  # table process
  store_mat = apply(signif(object$wtp[var_colNo,],digits=digits), 1, function(x) paste(x[1],"(",x[2],")",asterisk(x[4]),sep=""))
  store_mat = as.data.frame(store_mat)
  colnames(store_mat)=NULL
  # output matters
  }else{          
    store_beta=apply(signif(object$wtp[var_colNo,],digits=digits),1, function(x) paste(x[1],asterisk(x[4]),sep=""))
    store_se=apply(signif(object$wtp[var_colNo,],digits=digits), 1, function(x) paste("(",x[2],")",sep=""))
    for(i in 1:K){
      if(i==1) store_mat=vector()
      store_mat = c(store_mat,store_beta[i],store_se[i])
    }
    names(store_mat) = rep("",length=length(store_mat))
    names(store_mat)[seq(1,K*2,2)] = varlist
  }
  if(print){print(store_mat);print(sig.print)}    
  return(store_mat)
}