[Gmm-commits] r196 - in pkg/causalOTLSE: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 8 20:26:54 CEST 2022
Author: chaussep
Date: 2022-07-08 20:26:54 +0200 (Fri, 08 Jul 2022)
New Revision: 196
Added:
pkg/causalOTLSE/man/extract-otlse-method.Rd
Modified:
pkg/causalOTLSE/DESCRIPTION
pkg/causalOTLSE/NAMESPACE
pkg/causalOTLSE/R/otlse.R
pkg/causalOTLSE/man/otlse.Rd
pkg/causalOTLSE/man/polSelect.Rd
Log:
add flexibility for the number of knots and added texreg functionality
Modified: pkg/causalOTLSE/DESCRIPTION
===================================================================
--- pkg/causalOTLSE/DESCRIPTION 2022-07-07 18:47:03 UTC (rev 195)
+++ pkg/causalOTLSE/DESCRIPTION 2022-07-08 18:26:54 UTC (rev 196)
@@ -1,6 +1,6 @@
Package: causalOTLSE
Version: 0.1-0
-Date: 2022-06-29
+Date: 2022-07-08
Title: Optimal Thresholding Least Squares Inference for Causal Effects
Authors at R: c(person("Pierre Chausse", "Developer", role = c("aut", "cre"),
email = "pchausse at uwaterloo.ca"),
@@ -8,6 +8,6 @@
email = "giurcanu at uchicago.edu"))
Description: This package includes tools to measure causal effects using least squares regressions. The number of piecewise polynomials is selected by some information criteria.
Depends: R (>= 4.0.0)
-Imports: stats, splines, sandwich, cvTools, graphics
+Imports: stats, splines, sandwich, cvTools, graphics, methods, texreg
License: GPL (>= 2)
NeedsCompilation: no
Modified: pkg/causalOTLSE/NAMESPACE
===================================================================
--- pkg/causalOTLSE/NAMESPACE 2022-07-07 18:47:03 UTC (rev 195)
+++ pkg/causalOTLSE/NAMESPACE 2022-07-08 18:26:54 UTC (rev 196)
@@ -4,9 +4,11 @@
importFrom(sandwich, vcovHC)
importFrom(cvTools, cvFolds)
importFrom(splines, bs)
+importFrom(methods, setMethod)
+importFrom(texreg, extract, createTexreg)
export(otlse, print.otlse, summary.otlse, print.summary.otlse,
- ppSplines, selASY, selIC)
+ ppSplines, selASY, selIC, extract)
S3method(summary, otlse)
S3method(print, otlse)
Modified: pkg/causalOTLSE/R/otlse.R
===================================================================
--- pkg/causalOTLSE/R/otlse.R 2022-07-07 18:47:03 UTC (rev 195)
+++ pkg/causalOTLSE/R/otlse.R 2022-07-08 18:26:54 UTC (rev 196)
@@ -104,7 +104,7 @@
}
.getPval <- function (form, data, ppow, splineMet, HCtype="HC",
- mZeroProp=0.1, knots.)
+ mZeroProp=0.1, knots0., knots1.)
{
tmp <- as.character(form)
if (!grepl("\\|", tmp[3]))
@@ -125,9 +125,9 @@
n <- length(Z)
id0 <- Z == 0
- data$Xf0 <- ppSplines(form=formX, data=data, pFact=ppow, knots=knots.,
+ data$Xf0 <- ppSplines(form=formX, data=data, pFact=ppow, knots=knots0.,
method=splineMet, subGroup=id0, minZeroProp=mZeroProp)
- data$Xf1 <- ppSplines(form=formX, data=data, pFact=ppow, knots=knots.,
+ data$Xf1 <- ppSplines(form=formX, data=data, pFact=ppow, knots=knots1.,
method=splineMet, subGroup=!id0, minZeroProp=mZeroProp)
fit <- lm(formY, data)
naCoef <- is.na(coef(fit))
@@ -181,11 +181,12 @@
selASY <- function (form, data, pFact = 0.3, splineMet = c("manual", "bs"),
- HCtype="HC", mZeroProp=0.1, minPV=function(p) 1/(p*log(p)),
- knots=NA)
+ HCtype="HC", mZeroProp=0.1, knots0=NA, knots1=NA,
+ minPV=function(p) 1/(p*log(p)))
{
splineMet <- match.arg(splineMet)
- res <- .getPval(form, data, pFact, splineMet, HCtype, mZeroProp, knots)
+ res <- .getPval(form, data, pFact, splineMet, HCtype, mZeroProp, knots0,
+ knots1)
pval <- c(do.call("c", res$pval0), do.call("c", res$pval1))
n <- nrow(data)
q <- length(pval)
@@ -244,11 +245,12 @@
selIC <- function(form, data, pFact = 0.3, type=c("AIC", "BIC", "CV"),
splineMet = c("manual", "bs"), HCtype="HC",
- mZeroProp=0.1, knots=NA)
+ mZeroProp=0.1, knots0=NA, knots1=NA)
{
type <- match.arg(type)
splineMet <- match.arg(splineMet)
- res <- .getPval(form, data, pFact, splineMet, HCtype, mZeroProp, knots)
+ res <- .getPval(form, data, pFact, splineMet, HCtype, mZeroProp, knots0,
+ knots1)
pval <- c(do.call("c", res$pval0), do.call("c", res$pval1))
n <- nrow(data)
q <- length(pval)
@@ -310,24 +312,59 @@
treatment=res$treatment)
}
+.selNONE <- function(form, data, pFact = 0.3, type=c("AIC", "BIC", "CV"),
+ splineMet = c("manual", "bs"), HCtype="HC",
+ mZeroProp=0.1, knots0=NA, knots1=NA)
+{
+ type <- match.arg(type)
+ splineMet <- match.arg(splineMet)
+ tmp <- as.character(form)
+ if (!grepl("\\|", tmp[3]))
+ stop("form must be of the type y~z|~x")
+ tmp2 <- strsplit(tmp[3], "\\|")[[1]]
+ formX <- as.formula(tmp2[2], env=.GlobalEnv)
+ formY <- as.formula(paste(tmp[2], "~",tmp2[1],sep=""))
+ Z <- model.matrix(formY, data)
+ if (attr(terms(formY), "intercept") == 1)
+ Z <- Z[,-1,drop=FALSE]
+ id0 <- Z == 0
+ formY <- as.formula(paste(tmp[2], "~factor(",tmp2[1],")+Xf0+Xf1-1"),
+ env=.GlobalEnv)
+ Xf0 <- ppSplines(form = formX, data = data, knots = knots0,
+ pFact = pFact, deg = 1, method = splineMet,
+ subGroup=id0, minZeroProp=mZeroProp)
+ Xf1 <- ppSplines(form = formX, data = data, knots = knots1,
+ pFact = pFact, deg = 1, method = splineMet,
+ subGroup=!id0, minZeroProp=mZeroProp)
+ knots0 <- attr(Xf0, "knots")
+ knots1 <- attr(Xf1, "knots")
+ list(Xf1 = Xf1, Xf0 = Xf0, knots0 = knots0, knots1 = knots1,
+ pval = NULL, id0=id0, formY=formY, formX=formX,
+ treatment=colnames(Z))
+}
-otlse <- function(form, data, crit = c("ASY", "AIC", "BIC", "CV"),
+
+otlse <- function(form, data, crit = c("ASY", "AIC", "BIC", "CV", "NONE"),
pFact=0.3, splineMet=c("manual","bs"), HCtype="HC",
- mZeroProp=0.1, knots=NA, ...)
+ mZeroProp=0.1, knots0=NA, knots1=NA, ...)
{
crit <- match.arg(crit)
splineMet <- match.arg(splineMet)
optBasis <- switch(crit,
- ASY = selASY(form=form, data, pFact, splineMet, HCtype, mZeroProp,
- knots, ...),
- AIC = selIC(form, data, pFact, "AIC", splineMet, HCtype, mZeroProp, knots),
- BIC = selIC(form, data, pFact, "BIC", splineMet, HCtype, mZeroProp, knots),
- CV = selIC(form, data, pFact, "CV", splineMet, HCtype, mZeroProp, knots))
+ ASY = selASY(form, data, pFact, splineMet, HCtype, mZeroProp,
+ knots0, knots1, ...),
+ AIC = selIC(form, data, pFact, "AIC", splineMet, HCtype, mZeroProp,
+ knots0, knots1),
+ BIC = selIC(form, data, pFact, "BIC", splineMet, HCtype, mZeroProp,
+ knots0, knots1),
+ CV = selIC(form, data, pFact, "CV", splineMet, HCtype, mZeroProp,
+ knots0, knots1),
+ NONE = .selNONE(form, data, pFact, "CV", splineMet, HCtype, mZeroProp,
+ knots0, knots1))
data2 <- data
data2$Xf0 <- optBasis$Xf0
data2$Xf1 <- optBasis$Xf1
lm.out <- lm(optBasis$formY, data2, na.action="na.exclude")
-
n <- nrow(data2)
id0 <- optBasis$id0
n0 <- sum(id0)
@@ -519,3 +556,50 @@
bty='n')
invisible()
}
+
+
+extract.otlse <- function (model, include.nobs = TRUE, include.nknots = TRUE,
+ include.numcov = TRUE,
+ which=c("ALL","ACE","ACT","ACN","ACE-ACT","ACE-ACN","ACT-ACN"),
+ ...)
+{
+ which <- match.arg(which)
+ type <- c("ACE","ACT","ACN")
+ w <- if (which == "ALL") type else type[sapply(type, function(ti) grepl(ti, which))]
+ wl <- tolower(w)
+ co <- unlist(model[wl])
+ names(co) <- toupper(names(co))
+ se <- unlist(model[paste("se.",wl,sep="")])
+ names(se) <- toupper(names(se))
+ pval <- 2*pnorm(-abs(co/se))
+ names(pval) <- toupper(names(pval))
+ gof <- numeric()
+ gof.names <- character()
+ gof.decimal <- logical()
+ if (isTRUE(include.nknots)) {
+ rs1 <- length(unlist(model$knots0))
+ rs2 <- length(unlist(model$knots1))
+ gof <- c(gof, rs1, rs2)
+ gof.names <- c(gof.names, "Num. knots (Control)", "Num. knots (Treated)")
+ gof.decimal <- c(gof.decimal, FALSE, FALSE)
+ }
+ if (isTRUE(include.numcov)) {
+ rs3 <- length(model$knots0)
+ gof <- c(gof, rs3)
+ gof.names <- c(gof.names, "Num. covariates")
+ gof.decimal <- c(gof.decimal, FALSE)
+ }
+ if (isTRUE(include.nobs)) {
+ n <- nrow(model$data)
+ gof <- c(gof, n)
+ gof.names <- c(gof.names, "Num. obs.")
+ gof.decimal <- c(gof.decimal, FALSE)
+ }
+ tr <- createTexreg(coef.names = names(co), coef = co, se = se,
+ pvalues = pval, gof.names = gof.names, gof = gof, gof.decimal = gof.decimal)
+ return(tr)
+}
+
+setMethod("extract", signature = className("otlse", "causalOTLSE"),
+ definition = extract.otlse)
+
Added: pkg/causalOTLSE/man/extract-otlse-method.Rd
===================================================================
--- pkg/causalOTLSE/man/extract-otlse-method.Rd (rev 0)
+++ pkg/causalOTLSE/man/extract-otlse-method.Rd 2022-07-08 18:26:54 UTC (rev 196)
@@ -0,0 +1,32 @@
+\name{extract,otlse-method}
+\alias{extract,otlse-method}
+\alias{extract.otlse}
+\title{\code{\link{extract}} method for \code{otlse} objects}
+\usage{
+\S4method{extract}{otlse}(
+ model,
+ include.nobs = TRUE,
+ include.nknots = TRUE,
+ include.numcov = TRUE,
+ which = c("ALL","ACE","ACT","ACN","ACE-ACT","ACE-ACN","ACT-ACN"),
+ ...)
+}
+\arguments{
+\item{model}{A statistical model object.}
+
+\item{include.nobs}{Report the number of obervations?}
+
+\item{include.nknots}{Report the total number of knots for each group?}
+
+\item{include.numcov}{Report the total number of covariates (including
+ interactions is any) per group?}
+
+\item{which}{Which causal effect measures should be printed?}
+
+\item{...}{Custom parameters, which are handed over to subroutines. Currently
+not in use.}
+}
+\description{
+\code{\link{extract}} method for \code{otlse} objects created by the
+\code{\link[causalOTLSE]{otlse}} function.
+}
Modified: pkg/causalOTLSE/man/otlse.Rd
===================================================================
--- pkg/causalOTLSE/man/otlse.Rd 2022-07-07 18:47:03 UTC (rev 195)
+++ pkg/causalOTLSE/man/otlse.Rd 2022-07-08 18:26:54 UTC (rev 196)
@@ -8,9 +8,9 @@
optimal thresholding least squares method.
}
\usage{
-otlse(form, data, crit = c("ASY", "AIC", "BIC", "CV"),
+otlse(form, data, crit = c("ASY", "AIC", "BIC", "CV", "NONE"),
pFact=0.3, splineMet=c("manual","bs"), HCtype="HC",
- mZeroProp=0.1, knots=NA, ...)
+ mZeroProp=0.1, knots0=NA, knots1=NA, ...)
}
\arguments{
\item{form}{A formula to identify the outcome, the treatment
@@ -18,7 +18,9 @@
spline matrices. See the example below}
\item{data}{A \code{data.frame} that contains all variables from the
formula \code{form}}
- \item{crit}{The method to select the piecewise polynomial knots.}
+ \item{crit}{The method to select the piecewise polynomial knots. If
+ set to "NONE", the all bases are kept. It is included for
+ experimentation purpose.}
\item{pFact}{The maximum number of knots when the argument \code{knots} is set to
\code{NA} if \code{n^pFact}, where n is the length of \code{X}.}
\item{splineMet}{Should the method be homemade (manual) of based on the
@@ -29,9 +31,14 @@
value, the knots and spline matrices are based on the non-zero
observations. This is particularly useful when binary variables are
interacted with continuous variables.}
- \item{knots}{The piecewise polynomial knots. If set to \code{NA}, the
- knots are set to the \code{p} equally spaced quantiles of \code{X}. If
- \code{NULL}, the function returns \code{X}.}
+ \item{knots0}{The piecewise polynomial knots for the control group.
+ If set to \code{NA}, the knots are set to the \code{p} equally
+ spaced quantiles of \code{X}. If \code{NULL}, the function returns
+ \code{X}.}
+ \item{knots1}{The piecewise polynomial knots for the treated group.
+ If set to \code{NA}, the knots are set to the \code{p} equally
+ spaced quantiles of \code{X}. If \code{NULL}, the function returns
+ \code{X}.}
\item{...}{Other arguments to pass to the basis selection function.}
}
Modified: pkg/causalOTLSE/man/polSelect.Rd
===================================================================
--- pkg/causalOTLSE/man/polSelect.Rd 2022-07-07 18:47:03 UTC (rev 195)
+++ pkg/causalOTLSE/man/polSelect.Rd 2022-07-08 18:26:54 UTC (rev 196)
@@ -9,11 +9,11 @@
}
\usage{
selASY(form, data, pFact = 0.3, splineMet = c("manual", "bs"),
- HCtype="HC", mZeroProp=0.1, minPV=function(p) 1/(p*log(p)),
- knots=NA)
+ HCtype="HC", mZeroProp=0.1, knots0=NA, knots1=NA,
+ minPV=function(p) 1/(p*log(p)))
selIC(form, data, pFact = 0.3, type=c("AIC", "BIC", "CV"),
splineMet = c("manual", "bs"), HCtype="HC",
- mZeroProp=0.1, knots=NA)
+ mZeroProp=0.1, knots0=NA, knots1=NA)
}
\arguments{
\item{form}{A formula to identify the outcome, the treatment
@@ -35,9 +35,14 @@
\item{minPV}{A function to determine the cuttoff point for the
significance. the argument of the function is the total number of
basis.}
- \item{knots}{The piecewise polynomial knots. If set to \code{NA}, the
- knots are set to the \code{p} equally spaced quantiles of \code{X}. If
- \code{NULL}, the function returns \code{X}.}
+ \item{knots0}{The piecewise polynomial knots for the control group.
+ If set to \code{NA}, the knots are set to the \code{p} equally
+ spaced quantiles of \code{X}. If \code{NULL}, the function returns
+ \code{X}.}
+ \item{knots1}{The piecewise polynomial knots for the treated group.
+ If set to \code{NA}, the knots are set to the \code{p} equally
+ spaced quantiles of \code{X}. If \code{NULL}, the function returns
+ \code{X}.}
}
\keyword{selection, polynomial}
More information about the Gmm-commits
mailing list