[R-es] Conservar el nombre de la variable entre varias funciones: ejemplos de resultados: solucion defmacro
Griera
griera en yandex.com
Jue Jul 16 18:17:58 CEST 2015
Hola:
He probado otra solución: con defmacro del paquete gtools:
=================================
DATOS <- data.frame(SE=c("M", "H", "M", "M", "H"),
ED=c(50, 60, 20, 18, 30),
GRP=c("B", "B", "A", "A", "B"))
library(gtools)
MRL <- defmacro(XDADES, XVD, XVI, expr =
{
RL <- glm(XVD ~ XVI, family=binomial, data=XDADES)
print(summary(RL))
})
=================================
Si se ejecuta aparecen los nombres reales de las variables y no el nombre de los argumentos:
=================================
> MRL(XDADES=DATOS, XVD=SE, XVI=ED)
Call:
glm(formula = SE ~ ED, family = binomial, data = DATOS)
Deviance Residuals:
1 2 3 4 5
1,3511 -0,7869 0,6512 0,6159 -1,5435
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2,67170 2,60538 1,025 0,305
ED -0,06142 0,06326 -0,971 0,332
[borrado]
=================================
En cambio en forma de función en los resultados aparece el nombre de los argumentos:
=================================
FRL <- function(XVD, XVI)
{
RL <- glm(XVD ~ XVI, family=binomial)
print(summary(RL))
}
FRL(XVD=SE, XVI=ED)
Call:
glm(formula = XVD ~ XVI, family = binomial)
Deviance Residuals:
1 2 3 4 5
1,3511 -0,7869 0,6512 0,6159 -1,5435
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2,67170 2,60538 1,025 0,305
XVI -0,06142 0,06326 -0,971 0,332
[borrado]
=================================
Saludos!
On Wed, 15 Jul 2015 20:26:46 +0200
Griera <griera en yandex.com> wrote:
> Hola:
>
> On Wed, 15 Jul 2015 00:18:32 +0200
> Carlos Ortega <cof en qualityexcellence.es> wrote:
> [borro]
> > Sobre la duda de los nombres, si le pasas el data.frame tal cual, te
> > debiera de conservar los nombres.
>
> Tienes razón. Ahora le paso el nombre del data.frame, y ya muestra el nombre de la variable analizada.
>
> Muchas gracias por la sugerencia.
>
> Saludos!
>
> > Si no es así, pásale como argumento adicional a las funciones los nombres
> > de las columnas/variables...
> >
> > Saludos,
> > Carlos.
> >
> >
> > El 14 de julio de 2015, 22:49, Griera <griera en yandex.com> escribió:
> >
> > > Hola Carlos:
> > >
> > > Te adjunto un ejemplo de aplicación: las funciones (he borrado los path de
> > > las funciones y las ordenes "source()" que las carga ) y un ejemplo para
> > > ejecutarlas para las opciones que tengo implementadas con la tabla de datos
> > > birthwt del paquete"MASS":
> > > - Descriptiva de todas las variables de una tabla.
> > > - Análisis univariado de todas las variables de una tabla cruzadas con una
> > > variable dependiente cualitativa.
> > >
> > > =Inicio funciones ========================================
> > > ##--------------------------------------------------------------
> > > ## DESUNI
> > > ##--------------------------------------------------------------
> > > DESUNI = function(XDADES,
> > > XDROP=NULL,
> > > XVD=NULL,
> > > XSPV=NULL # Si és una anàlisi de SPV # Pot tenir el
> > > valor TRUE
> > > )
> > > {
> > > options(digits = 3, OutDec=",", scipen=999)
> > > ## No existeix VD: descriptiva
> > > if(is.null(XVD)) # No existeix VD: descriptiva
> > > {
> > > cat("\n*** Descriptiva (no existeix variable dependent)\n")
> > > DES(XDADES=XDADES, XDROP=XDROP,
> > > XCAMIF=XCAMIF)
> > > }
> > > ## Existeis VD: anàlisi univariat
> > > else # Existeis VD: anàlisi univariat
> > > {
> > > UNI(XDADES=XDADES, XDROP=XDROP, XVD=XVD, XSPV=XSPV,
> > > XCAMIF=XCAMIF)
> > > }
> > > }
> > >
> > > ##--------------------------------------------------------------
> > > ## DES: Descriptiva de todas las variables
> > > ##--------------------------------------------------------------
> > > DES = function(XDADES, XDROP=NULL,
> > > XCAMIF)
> > > {
> > > ifelse(is.null(XDROP), DADES_S <- XDADES, DADES_S <- XDADES[,
> > > setdiff(names(XDADES), XDROP) ]) # setdiff Selecciona les variables de
> > > XDADES que són diferents de XDROP
> > > attach(DADES_S, warn.conflicts = F)
> > > XVARLLI=names(DADES_S)
> > > for (XVARNOM in names(DADES_S))
> > > {
> > > if(is.numeric(get(XVARNOM)))
> > > {
> > > DES_QUANTI (XVARNOM)
> > > }
> > > else if(is.factor(get(XVARNOM)))
> > > {
> > > DES_QUALI (XVARNOM)
> > > }
> > > else
> > > {
> > > cat("La variable ", XVARNOM, "no és de cap dels tipus coneguts",
> > > "\n")
> > > }
> > > }
> > > # Fi de la funció
> > > detach(DADES_S)
> > > }
> > > ##--------------------------------------------------------------
> > > ## DES_QUANTI: Descriptiva variables factor
> > > ##--------------------------------------------------------------
> > > DES_QUANTI <-
> > > function(X) {
> > > OP <- par(no.readonly = TRUE); # save old parameters
> > > par(mfrow=c(1,3))
> > > hist(get(X), main=c("Histograma de", X), xlab=X);rug(get(X))
> > > boxplot(get(X), main=c("Diagrama de caixa de", X),
> > > ylab=X);rug(get(X),side=2)
> > > qqnorm(get(X), main=c("Diagrama Q-Q de", X));qqline(get(X))
> > > cat("\n")
> > > par(OP)
> > > ESTA_1<-data.frame(Variable = X,
> > > N_total = length(get(X)),
> > > N_valids = sum(!is.na(get(X))),
> > > N_desconeguts = sum(is.na(get(X)))
> > > )
> > > ESTA_2<-data.frame(Variable = X,
> > > N = sum(!is.na(get(X))),
> > > Mitjana = if (mean(get(X) > 10))
> > > {round(mean(get(X), na.rm = TRUE), 2)} else {round(mean(get(X), na.rm =
> > > TRUE), 3)},
> > > Err_tipic = if (sd (get(X) > 10)) {round(sd
> > > (get(X), na.rm = TRUE), 2)} else {round(sd (get(X), na.rm = TRUE), 3)},
> > > Min = min(get(X), na.rm = TRUE),
> > > Perc_25 = quantile(get(X),.25),
> > > Mediana = median(get(X), na.rm = TRUE),
> > > Perc_75 = quantile(get(X),.75),
> > > Max = max(get(X), na.rm = TRUE),
> > > Interval = max(get(X), na.rm = TRUE) - min(get(X),
> > > na.rm = TRUE)
> > > )
> > > cat("----------------------------", "\n")
> > > cat("Valors valids i desconeguts", "\n")
> > > print(ESTA_1, row.names = FALSE)
> > > cat("----------------------------", "\n")
> > > cat("Estadistics", "\n")
> > > print(ESTA_2, row.names = FALSE)
> > > cat("----------------------------", "\n")
> > > return(summary(get(X)))
> > > }
> > > ##--------------------------------------------------------------
> > > ## DES_QUALI: Descriptiva variables factor
> > > ##--------------------------------------------------------------
> > > DES_QUALI <- function(X)
> > > {
> > > cat("Var factor: ",X,"\n")
> > > XOUT <- as.data.frame(table(get(X)))
> > > names(XOUT)[1] = X
> > > XOUT <- transform(XOUT, cumFreq = cumsum(Freq), Percentatge =
> > > prop.table(Freq))
> > > print(XOUT)
> > > print("-----------------------------------------------------")
> > > }
> > > ##--------------------------------------------------------------
> > > ## UNI: Análisis univarido
> > > ##--------------------------------------------------------------
> > > UNI = function(XDADES, XDROP=NULL,
> > > XVD,
> > > XSPV=NULL, # Si és una anàlisi de SPV
> > > XCAMIF
> > > )
> > > {
> > > ifelse(is.null(XDROP), DADES_S <- XDADES, DADES_S <- XDADES[,
> > > setdiff(names(XDADES), XDROP) ])
> > > attach(DADES_S, warn.conflicts = F)
> > > cat("\n Descriptiva de totes les variables seleccionades\n")
> > > print(summary(DADES_S))
> > > for (XVARNOMT in names(DADES_S))
> > > {
> > > if (is.factor (get(XVD) ) )
> > > {
> > > if ( is.factor(get(XVARNOMT)) )
> > > {
> > > UNI_VDQVIQ (XVD=get(XVD), XVDT=XVD, XVARNOM=get(XVARNOMT),
> > > XVARNOMT=XVARNOMT, XCAMIF=XCAMIF)
> > > }
> > > else if( is.numeric(get(XVARNOMT)))
> > > {
> > > cat("\nVD=Qualitativa i VI=Numèrica: UNI_VDQVIN\n")
> > > cat("\nPer fer \n")
> > > }
> > > }
> > > else if (is.numeric(get(XVD) ) & is.null(XSPV) ) # VD Num però no
> > > temps
> > > {
> > > if ( is.factor(get(XVARNOMT)) )
> > > {
> > > cat("\nVD=Numèrica i VI=Qualitativa: UNI_VDNVIQ\n")
> > > cat("\nPer fer \n")
> > > }
> > > else if( is.numeric(get(XVARNOMT)))
> > > {
> > > cat("\nVD=Numèrica i VI=Numèrica: UNI_VDNVIN\n")
> > > cat("\nPer fer \n")
> > > }
> > > }
> > >
> > > else if (is.numeric(get(XVD) ) & !is.null(XSPV) ) # VD Num de
> > > temps: SPV
> > > {
> > > if ( is.factor(get(XVARNOMT)) )
> > > {
> > > cat("\nVD=Temps i VI=Qualitativa: UNI_VDTVIQ\n")
> > > cat("\nPer fer \n")
> > > }
> > > else if( is.numeric(get(XVARNOMT)))
> > > {
> > > cat("\nVD=Temps i VI=Numèrica: UNI_VDTVIN\n")
> > > cat("\nPer fer \n")
> > > }
> > > }
> > > else
> > > {
> > > MISSATGE = c("Les variable ", XVD, " i ", XVARNOMT, " no són
> > > de cap dels tipus coneguts", sep="")
> > > select.list(MISSATGE,title="Atenció", preselect=MISSATGE)
> > > }
> > > }
> > > # Fi de la funció
> > > detach(DADES_S)
> > > cat("\n\bFi de la funció des.r \n")
> > > }
> > > ##--------------------------------------------------------------
> > > ## UNI_VDQVIQ: Análisis univarido Var Dep: Quali Var indep: quali
> > > ##--------------------------------------------------------------
> > > UNI_VDQVIQ = function(XVD, XVDT, XVARNOM, XVARNOMT, XCAMIF)
> > > {
> > > cat ("*** Entra de uni_vdqviq.r ******************************** \n\n")
> > > source("
> > > http://web.udl.es/Biomath/Bioestadistica/R/Instalacio/FuncionsAuxiliars.r",
> > > local = F, echo=TRUE, encoding = "unknown")
> > > # CrossTabsMod(get(XVD), get(XVARNOM), digits = 2, chisq = T, row = T,
> > > expected = T)
> > > CrossTabs(get(XVDT), XVARNOM, digits = 2, chisq = T, row = T, expected
> > > = T)
> > > # Oportunitats relatives i IC
> > > http://www.ats.ucla.edu/stat/r/dae/logit.htm
> > > REG_LOG <- glm(XVD ~ XVARNOM, family = "binomial")
> > > print(exp(cbind("Oportunitat Relativa" = coef(REG_LOG),
> > > confint(REG_LOG))))
> > > # Valors de p
> > > cat ("\n\nValors de p de les oportunitats relatives (regressió
> > > logística):\n")
> > > print(summary(REG_LOG)$coef[, "Pr(>|z|)"]) ## will extract them
> > > cat ("\n\n*** Surt de un_ivdqviq.r ********************************
> > > \n\n")
> > > }
> > >
> > > ##--------------------------------------------------------------
> > > ## Pruebas : comentado con una función
> > > ##--------------------------------------------------------------
> > > function()
> > > {
> > > library(MASS)
> > > data(birthwt, package="MASS")
> > > birthwt$low <- factor(birthwt$low)
> > > birthwt$race <- factor(birthwt$race)
> > >
> > > # Descriptiva
> > > DESUNI(XDADES=birthwt, XVD=NULL)
> > >
> > > # Análisis univariado con var dependiente qualitativa (factor)
> > > DESUNI(XDADES=birthwt, XVD="low")
> > >
> > > }
> > > =Fin de funciones =======================================
> > >
> > > Muchas gracias por la ayuda y saludos!
> > >
> > >
> > > > Hola Giera,
> > > >
> > > > Sí, puedes hacer lo mismo con "R" usando como te decía funciones que ya
> > > generan de forma automática estos estadísticos. La parte de las relaciones
> > > bivariadas, puede dar un poco más de trabajo pero luego las funciones para
> > > representar los boxplots o las tablas cruzadas y los diferentes test
> > > igualmente se hacen de forma muy compacta.
> > > >
> > > > Así, de primeras, yo como atacaría este problema sería:
> > > >
> > > > * Hacer un "summary()" de tu data.frame. De este resultado (no sé si
> > > conoces "summary()" )tienes una gran parte de los estadísticos básicos de
> > > cada variable. Hay otra función "fivenum()" que genera los cinco
> > > estadísticos básicos para un conjunto, aunque salvo por el contenido de
> > > "NAs" es casi lo mismo que devuelve "summary()".
> > > >
> > > > * Puedes de forma automática, detectar el tipo de variable que contiene
> > > cada columna (si es factor/categórica o si es numérica con la función
> > > "class()" ) y crear las relaciones bivariadas.
> > > >
> > > > * Para las numéricas, puedes hacerlo todas de forma cruzada con la
> > > función "pairs()".
> > > > * Para las categóricas, puedes ciclar (cada una de ellas para cada
> > > numérica) aunque creo que "pairs()" también hace esto de forma automática.
> > > >
> > > > * Quedaría simplemente pensar en los diferentes tests que quieres
> > > lanzar, pero seguro que hay alguna librería (además de la que se incluye
> > > por defecto "stats") que los implementa.
> > > >
> > > > Sobre el cómo....mejor si me pasas un ejemplo de aplicación lo damos un
> > > poco de forma...
> > > >
> > > > Saludos,
> > > >
> > > > Carlos.
> > > >
> > >
> >
> >
> >
> > --
> > Saludos,
> > Carlos Ortega
> > www.qualityexcellence.es
>
> _______________________________________________
> R-help-es mailing list
> R-help-es en r-project.org
> https://stat.ethz.ch/mailman/listinfo/r-help-es
Más información sobre la lista de distribución R-help-es