In my previous post, An Attempt to Understand Boosting Algorithm(s), I was puzzled by the boosting convergence when I was using some spline functions (more specifically linear by parts and continuous regression functions). I was using

> library(splines)
> fit=lm(y~bs(x,degree=1,df=3),data=df)

The problem with that spline function is that knots seem to be fixed. The iterative boosting algorithm is

• start with some regression model 
• compute the residuals, including some shrinkage parameter,

then the strategy is to model those residuals

• at step , consider regression 
• update the residuals 

and to loop. Then set

I thought that boosting would work well if at step , it was possible to change the knots. But the output

was quite disappointing: boosting does not improve the prediction here. And it looks like knots don’t change. Actually, if we select the ‘best‘ knots, the output is much better. The dataset is still

> n=300
> set.seed(1)
> u=sort(runif(n)*2*pi)
> y=sin(u)+rnorm(n)/4
> df=data.frame(x=u,y=y)

For an optimal choice of knot locations, we can use

> library(freeknotsplines)
> xy.freekt=freelsgen(df$x, df$y, degree = 1, 
+ numknot = 2, 555)

The code of the previous post can simply be updated

> v=.05
> library(splines)
> xy.freekt=freelsgen(df$x, df$y, degree = 1, 
+ numknot = 2, 555)
> fit=lm(y~bs(x,degree=1,knots=
+ xy.freekt@optknot),data=df)
> yp=predict(fit,newdata=df)
> df$yr=df$y - v*yp
> YP=v*yp
>  for(t in 1:200){
+    xy.freekt=freelsgen(df$x, df$yr, degree = 1,
+    numknot = 2, 555)
+ fit=lm(yr~bs(x,degree=1,knots=
+     xy.freekt@optknot),data=df)
+    yp=predict(fit,newdata=df)
+    df$yr=df$yr - v*yp
+    YP=cbind(YP,v*yp)
+  }
>  nd=data.frame(x=seq(0,2*pi,by=.01))
>  viz=function(M){
+    if(M==1)  y=YP[,1]
+    if(M>1)   y=apply(YP[,1:M],1,sum)
+    plot(df$x,df$y,ylab="",xlab="")
+    lines(df$x,y,type="l",col="red",lwd=3)
+    fit=lm(y~bs(x,degree=1,df=3),data=df)
+    yp=predict(fit,newdata=nd)
+    lines(nd$x,yp,type="l",col="blue",lwd=3)
+    lines(nd$x,sin(nd$x),lty=2)}
 
>  viz(100)

I like that graph. I had the intuition that using (simple) splines would be possible, and indeed, we get a very smooth prediction.

Please comment on the article here: Freakonometrics » Statistics

The post An Update on Boosting with Splines appeared first on All About Statistics.

Not sure how I missed this, but the Linux Foundation just announced the R Consortium for supporting the "world’s most popular language for analytics and data science and support the rapid growth of the R user community". From the Linux Foundation:

The R language is used by statisticians, analysts and data scientists to unlock value from data. It is a free and open source programming language for statistical computing and provides an interactive environment for data analysis, modeling and visualization. The R Consortium will complement the work of the R Foundation, a nonprofit organization based in Austria that maintains the language. The R Consortium will focus on user outreach and other projects designed to assist the R user and developer communities.

Founding companies and organizations of the R Consortium include The R Foundation, Platinum members Microsoft and RStudio; Gold member TIBCO Software Inc.; and Silver members Alteryx, Google, HP, Mango Solutions, Ketchum Trading and Oracle.

Please comment on the article here: Simply Statistics

The post Looks like this R thing might be for real appeared first on All About Statistics.

Brian MacGillivray and Nick Pidgeon write:

Daniel Gilbert maintains that people generally make bad decisions on risk issues, and suggests that communication strategies and education programmes would help (Nature 474, 275–277; 2011). This version of the deficit model pervades policy-making and branches of the social sciences.

In this model, conflicts between expert and public perceptions of risk are put down to the difficulties that laypeople have in reasoning in the face of uncertainties rather than to deficits in knowledge per se.

Indeed, this is the “Nudge” story we hear a lot: the idea is that our well-known cognitive biases are messing us up, and policymakers should be accounting for this.

But MacGillivray and Pidgeon take a more Gigerenzian view:

There are three problems with this stance.

First, it relies on a selective reading of the literature. . . .

Second, it rests on some bold extrapolations. For example, it is not clear how the biases Gilbert identifies in the classic ‘trolley’ experiment play out in the real world. Many such reasoning ‘errors’ are mutually contradictory — for example, people have been accused of both excessive reliance on and neglect of generic ‘base-rate’ information to judge the probability of an event. This casts doubt on the idea that they reflect universal or hard-wired failings in cognition.

The third problem is the presentation of rational choice theory as the only way of deciding how to handle risk issues.

They conclude:

Given that many modern risk crises stem from science’s inability to foresee the dark side of technological progress, a little humility from the rationality project wouldn’t go amiss.

The post Humility needed in decision-making appeared first on Statistical Modeling, Causal Inference, and Social Science.

Please comment on the article here: Statistical Modeling, Causal Inference, and Social Science

The post Humility needed in decision-making appeared first on All About Statistics.

Please comment on the article here: Xi'an's Og » R

The post R brut appeared first on All About Statistics.

When is the death penalty okay?

A court with no Protestants

How much does advertising matter in presidential elections?

Bartenders are Democrats, beer wholesalers are Republicans

The ambiguity of racial categories

No, public opinion is not driven by ‘unreasoning bias and emotion’

Political science: Who is it for?

Modern campaigning has big effects on voter turnout

Political writing that sounds good but makes no sense

How much are Harry Potter’s glasses worth?

The post Recently in the sister blog appeared first on Statistical Modeling, Causal Inference, and Social Science.

Please comment on the article here: Statistical Modeling, Causal Inference, and Social Science

The post Recently in the sister blog appeared first on All About Statistics.

A natural technique to select variables in the context of generalized linear models is to use a stepŵise procedure. It is natural, but contreversial, as discussed by Frank Harrell  in a great post, clearly worth reading. Frank mentioned about 10 points against a stepwise procedure.

• It yields R-squared values that are badly biased to be high.
• The F and chi-squared tests quoted next to each variable on the printout do not have the claimed distribution.
• The method yields confidence intervals for effects and predicted values that are falsely narrow (see Altman and Andersen (1989)).
• It yields p-values that do not have the proper meaning, and the proper correction for them is a difficult problem.
• It gives biased regression coefficients that need shrinkage (the coefficients for remaining variables are too large (see Tibshirani (1996)).
• It has severe problems in the presence of collinearity.
• It is based on methods (e.g., F tests for nested models) that were intended to be used to test prespecified hypotheses.
• Increasing the sample size does not help very much (see Derksen and Keselman (1992)).
• It allows us to not think about the problem.
• It uses a lot of paper.

In order to illustrate that issue of variable selection, consider a dataset I’ve been using many times on the blog,

MYOCARDE=read.table(
"http://freakonometrics.free.fr/saporta.csv",
head=TRUE,sep=";")

where we have observations from people entering E.R., because of a (potential) infarctus, and we want to understand who did survive, and to build a predictive model.

What if we use a forward stepwise logistic regression here? I want to use a forward construction since it usually yields to models with less explanatory variables. We can use Akaike Information Criterion

> reg0=glm(PRONO~1,data=MYOCARDE,family=binomial)
> reg1=glm(PRONO~.,data=MYOCARDE,family=binomial)
> step(reg0,scope=formula(reg1),
+ direction="forward",k=2)                  # AIC
Start:  AIC=98.03
PRONO ~ 1
 
        Df Deviance    AIC
+ REPUL  1   46.884 50.884
+ INSYS  1   51.865 55.865
+ INCAR  1   53.313 57.313
+ PRDIA  1   78.503 82.503
+ PAPUL  1   82.862 86.862
+ PVENT  1   87.093 91.093
<none>       96.033 98.033
+ FRCAR  1   94.861 98.861
 
Step:  AIC=50.88
PRONO ~ REPUL
 
        Df Deviance    AIC
+ INCAR  1   44.530 50.530
+ PVENT  1   44.703 50.703
+ INSYS  1   44.857 50.857
<none>       46.884 50.884
+ PAPUL  1   45.274 51.274
+ PRDIA  1   46.322 52.322
+ FRCAR  1   46.540 52.540
 
Step:  AIC=50.53
PRONO ~ REPUL + INCAR
 
        Df Deviance    AIC
<none>       44.530 50.530
+ PVENT  1   43.134 51.134
+ PRDIA  1   43.772 51.772
+ INSYS  1   44.305 52.305
+ PAPUL  1   44.341 52.341
+ FRCAR  1   44.521 52.521
 
Call:  glm(formula = PRONO ~ REPUL + INCAR, family = binomial, data = MYOCARDE)
 
Coefficients:
(Intercept)        REPUL  
   1.633668    -0.003564  
      INCAR  
   1.618479  
 
Degrees of Freedom: 70 Total (i.e. Null);  68 Residual
Null Deviance:	    96.03 
Residual Deviance: 44.53 	AIC: 50.53

or Schwarz Bayesian Information Criterion,

> step(reg0,scope=formula(reg1),
+ direction="forward",k=log(n))           # BIC
Start:  AIC=98.11
PRONO ~ 1
 
        Df Deviance    AIC
+ REPUL  1   46.884 51.043
+ INSYS  1   51.865 56.024
+ INCAR  1   53.313 57.472
+ PRDIA  1   78.503 82.662
+ PAPUL  1   82.862 87.021
+ PVENT  1   87.093 91.252
<none>       96.033 98.113
+ FRCAR  1   94.861 99.020
 
Step:  AIC=51.04
PRONO ~ REPUL
 
        Df Deviance    AIC
+ INCAR  1   44.530 50.768
+ PVENT  1   44.703 50.942
<none>       46.884 51.043
+ INSYS  1   44.857 51.095
+ PAPUL  1   45.274 51.512
+ PRDIA  1   46.322 52.561
+ FRCAR  1   46.540 52.778
 
Step:  AIC=50.77
PRONO ~ REPUL + INCAR
 
        Df Deviance    AIC
<none>       44.530 50.768
+ PVENT  1   43.134 51.452
+ PRDIA  1   43.772 52.089
+ INSYS  1   44.305 52.623
+ PAPUL  1   44.341 52.659
+ FRCAR  1   44.521 52.838
 
Call:  glm(formula = PRONO ~ REPUL + INCAR, family = binomial, data = MYOCARDE)
 
Coefficients:
(Intercept)        REPUL  
   1.633668    -0.003564  
      INCAR  
   1.618479  
 
Degrees of Freedom: 70 Total (i.e. Null);  68 Residual
Null Deviance:	    96.03 
Residual Deviance: 44.53 	AIC: 50.53

With those two approaches, we have the same story: the most important variable (or say with the highest predictive value) is REPUL. And we can improve the model by adding INCAR. And that’s it. We can get a good model with those two covariates.

Now, what about using cross-validation here? We should keep in ming that AIC is asymptotically equivalent to One-Leave-Out Cross Validation (see Stone (1977)),  while BIC is equivalent to -fold Cross Validation (see Shao (1997)), where

• Using Leave-One-Out Cross Validation

In order to select the first variable, consider 7 logistic regression, each on a single different variable. Each time, we estimate the model on  observations and get a prediction on the remaining one,

on. Set . The function to get those values is

> name_var=names(MYOCARDE)
> pred_i=function(i,k){
+ fml = paste(name_var[8],"~",name_var[k],sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }

then for each variable , we get the ROC curve using and,

> library(AUC)
> ROC=function(k){
+  Y=MYOCARDE[,8]=="Survival"
+  S=Vectorize(function(i) pred_i(i,k))
+ (1:length(Y))
+  R=roc(S,as.factor(Y))
+  return(list(roc=cbind(R$fpr,R$tpr),
+              auc=AUC::auc(R)))
+ }

Here, for each variable, we compute the area under the curve (AUC criterion)

> AUC=rep(NA,7)
> for(k in 1:7){
+   AUC[k]=ROC(k)$auc
+   cat("Variable ",k,"(",name_var[k],") :",
+   AUC[k],"\n") }
Variable  1 ( FRCAR ) : 0.4934319 
Variable  2 ( INCAR ) : 0.8965517 
Variable  3 ( INSYS ) : 0.909688 
Variable  4 ( PRDIA ) : 0.7487685 
Variable  5 ( PAPUL ) : 0.7134647 
Variable  6 ( PVENT ) : 0.6584565 
Variable  7 ( REPUL ) : 0.9154351

But we can also visualize those curves,

> plot(0:1,0:1,col="white",xlab="",ylab="")
> for(k in 1:7) 
+ lines(ROC(k)$roc,type="s",col=CL[k])
> legend(.8,.45,name_var,col=CL,lty=1,cex=.8)

(there is no PRONO here, there is a typo  in the Legend)

where here colors were obtained using

> library(RColorBrewer)
> CL=brewer.pal(8, "Set1")[-7]

Here ROC curves were obtained using a Leave-one-Out strategy. And the best variable (if we should keep one, and one only) is

> k0=which.max(AUC)
> name_var[k0]
[1] "REPUL"

Now, consider a stepwise procedure: we keep that ‘best’ variable in our model, and we try to add another one.

> pred_i=function(i,k){
+ vk=c(k0,k)
+ fml = paste(name_var[8],"~",paste(name_var[vk],
+ collapse="+"),sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }
> library(AUC)
> ROC=function(k){
+ Y=MYOCARDE[,8]=="Survival"
+ S=Vectorize(function(i) pred_i(i,k))
+ (1:length(Y))
+ R=roc(S,as.factor(Y))
+ return(list(roc=cbind(R$fpr,R$tpr),
+ auc=AUC::auc(R)))
+ }
> plot(0:1,0:1,col="white",xlab="",ylab="")
> for(k in (1:7)[-k0]) lines(ROC(k)$roc,type="s",col=CL[k])
> segments(0,0,1,1,lty=2,col="grey")
> legend(.8,.45,
+   name_var[-k0],
+   col=CL[-k0],lty=1,cex=.8)

We were already quite good. And we might expect to find another variable that will increase the predictive power of our classifier.

> AUC=rep(NA,7)
> for(k in (1:7)[-k0]){
+  AUC[k]=ROC(k)$auc
+  cat("Variable ",k,"(",name_var[k],") :",
+  AUC[k],"\n")
+ }
Variable  1 ( FRCAR ) : 0.9064039 
Variable  2 ( INCAR ) : 0.9195402 
Variable  3 ( INSYS ) : 0.9187192 
Variable  4 ( PRDIA ) : 0.9137931 
Variable  5 ( PAPUL ) : 0.9187192 
Variable  6 ( PVENT ) : 0.9137931

And, of course, we can move foreward, add another variable, etc,

> k0=c(k0,which.max(AUC))

> pred_i=function(i,k){
+   vk=c(k0,k)
+   fml = paste(name_var[8],"~",paste(
+ name_var[vk],collapse="+"),sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }
> library(AUC)
> ROC=function(k){
+  Y=MYOCARDE[,8]=="Survival"
+  S=Vectorize(function(i) pred_i(i,k))
+  (1:length(Y))
+  R=roc(S,as.factor(Y))
+  return(list(roc=cbind(R$fpr,R$tpr),
+  auc=AUC::auc(R)))
+ }
> 
> plot(0:1,0:1,col="white",xlab="",ylab="")
> for(k in (1:7)[-k0]) lines(ROC(k)$roc,type="s",col=CL[k])
> segments(0,0,1,1,lty=2,col="grey")
> legend(.8,.45,name_var[-k0],
+ col=CL[-k0],lty=1,cex=.8)

But here, the gain is rather small (if any)

> AUC=rep(NA,7)
> for(k in (1:7)[-k0]){
+ AUC[k]=ROC(k)$auc
+ cat("Variable ",k,"(",name_var[k],") :",
+ AUC[k],"\n")
+ }
Variable  1 ( FRCAR ) : 0.9121511 
Variable  3 ( INSYS ) : 0.9170772 
Variable  4 ( PRDIA ) : 0.910509 
Variable  5 ( PAPUL ) : 0.907225 
Variable  6 ( PVENT ) : 0.909688

With that stepwise algorithm, the best strategy is to keep, first, REPUL, and then to add INCAR. Which is consistent with the stepwise procedure using Akaike Information Criterion.

An alternative could be to select the best pair among all possible pairs. It will be time consuming, but it can be used to avoid the stepwise drawback.

> pred_i=function(i,k){
+ fml = paste(name_var[8],"~",paste(name_var[
+ as.integer(k)],collapse="+"),sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }
> library(AUC)
> ROC=function(k){
+   Y=MYOCARDE[,8]=="Survival"
+   L=list()
+   n=length(Y)
+   nk=trunc(n/trunc(n/10))
+   for(i in 1:(nk-1)) L[[i]]=((i-1)*
+     trunc(n/10)+1:(n/10)) 
+   L[[nk]]=((nk-1)*trunc(n/10)+1):n
+   S=unlist(Vectorize(function(i) 
+     pred_i(L[[i]],k))(1:nk))
+   R=roc(S,as.factor(Y))
+   return(AUC::auc(R))
+ }

> v=data.frame(k1=rep(1:7,each=7),k2=rep(1:7,7))
> v=v[v$k1<v$k2,]
> v$auc=NA
> for(i in 1:nrow(v)) v$auc[i]=ROC(v[i,1:2])
> v
   k1 k2       auc
2   1  2 0.9047619
3   1  3 0.9047619
4   1  4 0.6990969
5   1  5 0.6395731
6   1  6 0.6334154
7   1  7 0.8817734
10  2  3 0.9072250
11  2  4 0.9088670
12  2  5 0.8940887
13  2  6 0.8801314
14  2  7 0.8899836
18  3  4 0.8916256
19  3  5 0.8817734
20  3  6 0.9014778
21  3  7 0.8768473
26  4  5 0.6925287
27  4  6 0.7138752
28  4  7 0.8825944
34  5  6 0.6912972
35  5  7 0.8834154
42  6  7 0.8834154

Here the best pair is

> v[which.max(v$auc),]
   k1 k2      auc
11  2  4 0.908867
> name_var[as.integer(v[which.max(v$auc),1:2])]
[1] "INCAR" "PRDIA"

which is different, compared with the one we got above. What is odd here is that we get a smaller AUC than the ones we got at step 2 in the stepwise procedure.

Nevertheless, even with a few observations (our dataset is rather small here), it is time consuming to look at all ROC curves, for all pairs. An alternative might be to use –Fold Cross Validation.

• Using -Fold Cross Validation

Here we consider a partition of indices, , and we define

based on observations. For all, set . Then, we can use the stepwise method described above

> pred_i=function(i,k){
+ fml = paste(name_var[8],"~",name_var[k],sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }
> library(AUC)
> ROC=function(k){
+   Y=MYOCARDE[,8]=="Survival"
+   L=list()
+   n=length(Y)
+   nk=trunc(n/trunc(n/10))
+   for(i in 1:(nk-1)) L[[i]]=((i-1)*
+     trunc(n/10)+1:(n/10)) 
+   L[[nk]]=((nk-1)*trunc(n/10)+1):n
+   S=unlist(Vectorize(function(i) 
+     pred_i(L[[i]],k))(1:nk))
+   R=roc(S,as.factor(Y))
+   return(list(roc=cbind(R$fpr,R$tpr),
+               auc=AUC::auc(R)))
+ }

> plot(0:1,0:1,col="white",xlab="",ylab="")
> for(k in (1:7)) lines(ROC(k)$roc,col=CL[k])
> segments(0,0,1,1,lty=2,col="grey")
> legend(.8,.45,name_var,col=CL,lty=1,cex=.8)

with

> AUC=rep(NA,7)
> for(k in 1:7){
+ AUC[k]=ROC(k)$auc
+ cat("Variable ",k,"(",name_var[k],") :",
+ AUC[k],"\n")
+ }
Variable  1 ( FRCAR ) : 0.3932677 
Variable  2 ( INCAR ) : 0.8940887 
Variable  3 ( INSYS ) : 0.908046 
Variable  4 ( PRDIA ) : 0.7278325 
Variable  5 ( PAPUL ) : 0.6756979 
Variable  6 ( PVENT ) : 0.63711 
Variable  7 ( REPUL ) : 0.8834154

So, this time, INSYS is probably the best covariate to use. Now, if we keep that variable, and move forward,

> k0=which.max(AUC)

> pred_i=function(i,k){
+  vk=c(k0,k)
+ fml = paste(name_var[8],"~",paste(name_var[vk],
+ collapse="+"),sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }
> library(AUC)
> ROC=function(k){
+   Y=MYOCARDE[,8]=="Survival"
+   L=list()
+   n=length(Y)
+   nk=trunc(n/trunc(n/10))
+   for(i in 1:(nk-1)) L[[i]]=((i-1)*
+     trunc(n/10)+1:(n/10)) 
+   L[[nk]]=((nk-1)*trunc(n/10)+1):n
+   S=unlist(Vectorize(function(i) 
+      pred_i(L[[i]],k))(1:nk))
+   R=roc(S,as.factor(Y))
+   return(list(roc=cbind(R$fpr,R$tpr),
+               auc=AUC::auc(R)))
+ }

> plot(0:1,0:1,col="white",xlab="",ylab="")
> for(k in (1:7)[-k0]) 
+ lines(ROC(k)$roc,col=CL[k])
> segments(0,0,1,1,lty=2,col="grey")
> legend(.8,.45,name_var[-k0],
+        col=CL[-k0],lty=1,cex=.8)

and our best choice for the second variable would be INCAR

> AUC=rep(NA,7)
> for(k in (1:7)[-k0]){
+   AUC[k]=ROC(k)$auc
+   cat("Variable ",k,"(",name_var[k],") :",
+ AUC[k],"\n")
+ }
Variable  1 ( FRCAR ) : 0.9047619 
Variable  2 ( INCAR ) : 0.907225 
Variable  4 ( PRDIA ) : 0.8916256 
Variable  5 ( PAPUL ) : 0.8817734 
Variable  6 ( PVENT ) : 0.9014778 
Variable  7 ( REPUL ) : 0.8768473 
> which.max(AUC)
[1] 2

Here again, it is possible to look at all pairs

> pred_i=function(i,k){
+ fml = paste(name_var[8],"~",paste(name_var[
+ as.integer(k)],collapse="+"),sep="")
+ reg=glm(fml,data=MYOCARDE[-i,],family=binomial)
+ predict(reg,newdata=MYOCARDE[i,],
+ type="response")
+ }
> library(AUC)
> ROC=function(k){
+   Y=MYOCARDE[,8]=="Survival"
+   L=list()
+   n=length(Y)
+   nk=trunc(n/trunc(n/10))
+   for(i in 1:(nk-1)) L[[i]]=((i-1)*
+   trunc(n/10)+1:(n/10)) 
+   L[[nk]]=((nk-1)*trunc(n/10)+1):n
+   S=unlist(Vectorize(function(i) 
+     pred_i(L[[i]],k))(1:nk))
+   R=roc(S,as.factor(Y))
+   return(AUC::auc(R))
+ }

> v=data.frame(k1=rep(1:7,each=7),k2=rep(1:7,7))
> v=v[v$k1<v$k2,]
> v$auc=NA
> for(i in 1:nrow(v)) v$auc[i]=ROC(v[i,1:2])
> v[which.max(v$auc),]
   k1 k2      auc
11  2  4 0.908867
> name_var[as.integer(v[which.max(v$auc),1:2])]
[1] "INCAR" "PRDIA"

which is the same as what we got using an One-Leave-Out strategy: we have again the same two covariates. And again, the AUC is lower than the one we got using a stepwise procedure (I still don’t understand how this is possible).   An alternative for the code would be to store all the regression models in a list,

> L=list()
> n=nrow(MYOCARDE)
> nk=trunc(n/trunc(n/10))
> for(i in 1:(nk-1)) L[[i]]=((i-1)*trunc(n/10)+
+  1:(n/10)) 
> L[[nk]]=((nk-1)*trunc(n/10)+1):n
> REG=list()
> for(k in 1:7){
+   REG[[k]]=list()
+   fml = paste(name_var[8],"~",
+ paste(name_var[as.integer(k)],collapse="+"),
+ sep="")
+ for(i in 1:nk) REG[[k]][[i]]=reg=glm(fml,
+  data=MYOCARDE[-L[[i]],],family=binomial)
+ }

and then to call them, properly

> pred_i=function(i,k){
+  I=which(sapply(1:10,function(j) i%in%L[[j]]))
+  predict(REG[[k]][[I]],newdata=MYOCARDE[i,],
+  type="response")
+ }

One has to check about the efficiency, especially with a large dataset.

• Using Trees and Random Forests

Another quick, but popular (from what I’ve seen), technique is to use trees. Important variables should appear in the output,

> library(rpart)
> tree=rpart(PRONO~.,data=MYOCARDE)
> library(rpart.plot)
> rpart.plot(tree)

Here, the first variable that appears in the tree construction is INSYS, and the second on is REPUL. Which is rather different with what we got above. But using one tree is maybe not sufficient. One can use the variable importance function (described in a previous post) obtained using random forests.

> library(randomForest)
> rf=randomForest(PRONO~.,data=MYOCARDE,
+                 importance=TRUE)
> rf$importance[,4]
   FRCAR    INCAR    INSYS 
1.042006 7.363255 8.954898 
   PRDIA    PAPUL    PVENT 
3.149235 2.571267 3.152619 
   REPUL 
7.510110

Here, we have the same story as the one we got with a simple tree: the ‘most important’ variable is INSYS while the second one is REPUL. But here, we consider tree based predictors. And not a logistic regression.

• Using Dedicated R functions

It is possible to use some dedicated R functions for variable selection. For instance, since we consider a logistic regression, use

> library(bestglm)
> Xy=as.data.frame(MYOCARDE)
> Xy[,8]=(Xy[,8]=="Death")*1             
> names(Xy)=names(MYOCARDE)
> B=bestglm(Xy)
> B$Subsets[,2:8]
   FRCAR INCAR INSYS PRDIA PAPUL PVENT REPUL
0  FALSE FALSE FALSE FALSE FALSE FALSE FALSE
1  FALSE FALSE FALSE FALSE FALSE FALSE  TRUE
2* FALSE  TRUE FALSE FALSE FALSE FALSE  TRUE
3  FALSE  TRUE FALSE FALSE FALSE  TRUE  TRUE
4   TRUE  TRUE FALSE FALSE FALSE  TRUE  TRUE
5   TRUE  TRUE  TRUE FALSE FALSE  TRUE  TRUE
6   TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE
7   TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE

With only one variable, we should consider REPUL (row 1 of the matrix), while with two variables, we should consider REPUL and INCAR (and that is the best model, based on some Bayesian Information Criterion). Here, cross validation techniques can be used also,

> B=bestglm(Xy, IC = "CV", CVArgs = 
+ list(Method = "HTF", K = 10, REP = 1))
>  cverrs = B$Subsets[, "CV"]
>  sdCV = B$Subsets[, "sdCV"]
>  CVLo = cverrs - sdCV
>  CVHi = cverrs + sdCV
>  ymax = max(CVHi)
>  ymin = min(CVLo)
>  k = 0:(length(cverrs) - 1)
>  plot(k, cverrs, ylim = c(ymin,
+  ymax), type = "n", yaxt = "n")
>  points(k,cverrs,cex = 2,col="red",pch=16)
>  lines(k, cverrs, col = "red", lwd = 2)
>  axis(2, yaxp = c(0.6, 1.8, 6))
>  segments(k, CVLo, k, CVHi,col="blue", lwd = 2)
>  eps = 0.15
>  segments(k-eps, CVLo, k+eps, CVLo, 
+ col = "blue", lwd = 2)
>  segments(k-eps, CVHi, k+eps, CVHi, 
+ col = "blue", lwd = 2)
>  indMin = which.min(cverrs)
>  fmin = sdCV[indMin]
>  cutOff = fmin + cverrs[indMin]
>  abline(h = cutOff, lty = 2)
>  indMin = which.min(cverrs)
>  fmin = sdCV[indMin]
>  cutOff = fmin + cverrs[indMin]
>  min(which(cverrs < cutOff))
[1] 2

If we summarize, here,

• stepwise, AIC : REPUL + INCAR
• stepwise, BIC : REPUL + INCAR
• One-leave-Out CV stepwise : REPUL + INCAR
• One-leave-Out CV pairs : INCAR + PRDIA
• -fold CV stepwise : INSYS + INCAR
• -fold CV pairs : INCAR + PRDIA
• Tree : INSYS + REPUL
• Variable Importance (RF) : INSYS + INCAR
• Best GLM : REPUL + INCAR

That is the lovely part with statistical tools: there are usually multiple (valid) answers. And this is why machine learning is difficult: if there was a single answer, any machine could built up a model that works well. But obviously, it has to be more complicated…

Please comment on the article here: Freakonometrics » Statistics

The post Variable Selection using Cross-Validation (and Other Techniques) appeared first on All About Statistics.

From Venturebeat:

Back then we knew so little about the business that any insight was groundbreaking; data infrastructure was fast, stable, and real-time (I was querying our production MySQL database); the company was so small that everyone was in the loop about every decision; and the data team (me) was aligned around a singular set of metrics and methodologies.

But five years and 43,000 percent growth later, things have gotten a bit more complicated. I’m happy to say that we’re also more sophisticated in the way we leverage data, and there’s now a lot more of it. The trick has been to manage scale in a way that brings together the magic of those early days with the growing needs of the present — a challenge that I know we aren’t alone in facing.

Please comment on the article here: Simply Statistics

The post How Airbnb built a data science team appeared first on All About Statistics.

When you count the outcomes of an experiment, you do not always observe all of the possible outcomes. For example, if you roll a six-sided die 10 times, it might be that the "1" face does not appear in those 10 rolls. Obviously, this situation occurs more frequently with small data than with large, although even for large data set, you might not observe rare events.

When conducting a statistical analysis, it is sometimes necessary to specify the unobserved categories. I have previously shown how to use the DATA step to add outcomes with zero counts and run PROC FREQ on the resulting data. I have also shown how to use the DATA step to merge observed data with expected values so that you can overlay a parametric density on a histogram.

The following SAS/IML statements analyze 10 rolls of a six-sided die. The TABULATE subroutine counts the number of times each face appeared. The MergeCounts module inserts the observed counts into a vector.

proc iml;
/* Use LOC-ELEMENT technique to merge observed outcomes into all outcomes */
start MergeCounts(allVals, obsVals, counts);
   allCounts =  j(nrow(allVals),ncol(allVals),0);  /* array of 0s   */
   idx = loc(element(allVals, obsVals)); /* LOC-ELEMENT technique   */
   allCounts[idx] = counts;                        /* insert counts */
   return( allCounts );   
finish;
 
rolls = {4 6 4 6 5 2 4 3 3 6};           /* only 5 faces observed */
call tabulate(Vals, Counts, rolls);
 
allVals = 1:6;                           /* all outcomes */
allCounts = MergeCounts(allVals, Vals, Counts);
print Counts[c=(char(Vals))] allCounts[c=(char(allVals))];

Whereas the first table contains only the five observed faces, the second table lists all six faces of the die, with 0 indicating the "1" face was not observed.

In addition to the applications mentioned earlier, this technique is useful when you are computing goodness-of-fit statistics. For example, to compute the chi-square statistic for the null hypothesis that the die is fair (each face appears equally often), you need to form the difference between the observed and expected values for each face. The following statements implement a chi-square goodness-of-fit test:

Expected = sum(allCounts) / 6;
ChiSq = sum((allCounts-Expected)##2 / Expected); /* sum (O-E)^2/E over categories */
pval = 1 - cdf("chisquare", ChiSq, ncol(allVals)-1);  /* p-value for test */
print ChiSq pval;

Most statistical textbooks recommend that you not use the chi-square test if the expected counts are less than 5, as they are for this tiny data set. Nevertheless, this example illustrates the usefulness of adding unobserved outcome categories to data that contain the observed categories.

The post Merge observed outcomes into a list of all outcomes appeared first on The DO Loop.

Please comment on the article here: The DO Loop

The post Merge observed outcomes into a list of all outcomes appeared first on All About Statistics.

Please comment on the article here: Econometrics Beat: Dave Giles' Blog

The post July Reading appeared first on All About Statistics.

.

Stapel’s “fix” for science is to admit it’s all “fixed!”

That recent case of the guy suspected of using faked data for a study on how to promote support for gay marriage in a (retracted) paper, Michael LaCour, is directing a bit of limelight on our star fraudster Diederik Stapel (50+ retractions).

The Chronicle of Higher Education just published an article by Tom Bartlett: “Can a Longtime Fraud Help Fix Science? You can read his full interview of Stapel here. A snippet:

You write that “every psychologist has a toolbox of statistical and methodological procedures for those days when the numbers don’t turn out quite right.” Do you think every psychologist uses that toolbox? In other words, is everyone at least a little bit dirty?

Stapel: In essence, yes. The universe doesn’t give answers. There are no data matrices out there. We have to select from reality, and we have to interpret. There’s always dirt, and there’s always selection, and there’s always interpretation. That doesn’t mean it’s all untruthful. We’re dirty because we can only live with models of reality rather than reality itself. It doesn’t mean it’s all a bag of tricks and lies. But that’s where the inconvenience starts.

I think the solution is in accepting this and saying these are the tips and tricks, and this is the story I want to tell, and this is how I did it, instead of trying to pose as if it’s real. We should be more open about saying, I’m using this trick, this statistical method, and people can figure out for themselves. It’s the illusion that these models are one-to-one descriptions of reality. That’s what we hope for, but that’s of course not true. 

This is our “dirty hands” argument, so often used these days, coupled with claims of so-called “perverse incentives,” to excuse QRPs (questionable research practices), bias, and flat out cheating. The leap from “our models are invariably idealizations” to “we all have dirty hands” to “statistical tricks cannot be helped,” may inadvertantly be encouraged by some articles on how to “fix” science.

Earlier in the interview:

You mention lots of possible reasons for your fraud: laziness, ambition, a short attention span. One of the more intriguing reasons to me — and you mention it twice in the book — is nihilism. Do you mean that? Did you think of yourself as a nihilist? Then or now?

Stapel: I’m not sure I’m a nihilist. ….

Did you think of the work you were doing as meaningful?

Stapel: I was raised in the 1980s, at the height of postmodernism, and that was something I related to. I studied many of the French postmodernists. That made me question meaningfulness. I had a hard time explaining the meaningfulness of my work to students.

I’ll bet.

 I agree with Bartlett that you don’t have to have any sympathy with a fraudster to possibly learn from him about preventing doctored statistics, or sharpening fraudbusting skills, except that it turns out Stapel really and truly believes science is a fraud![ii]  In his pristine accomplishment of using no data at all, rather than merely subjecting them to extraordinary rendition (leaving others to wrangle over the fine points of statistics), you could say that Stapel is the ultimate, radical, postmodern scientific anarchist. Stapel is a personable guy, and I’ve had some interesting exchanges with him; but on that basis, from his “Fictionfactory,” and autobiography, “Derailment”, I say he’s the wrong person to ask. He still doesn’t get it!

[i]There are several posts on this blog that discuss Stapel:

Some Statistical Dirty Laundry

Derailment: Faking Science: A true story of academic fraud, by Diederik Stapel (translated into English)
Should a “fictionfactory” peepshow be barred from a festival on “Truth and Reality”? Diederik Stapel says no

How to hire a fraudster chauffeur (includes video of Stapel’s TED talk)

50 shades of grey between error and fraud

Thinking of Eating Meat Causes Antisocial behavior

[ii] At least social science, social psychology. He may be right that the effects are small or uninteresting in social psych.

Please comment on the article here: Error Statistics Philosophy » Statistics

The post Stapel’s Fix for Science? Admit the story you want to tell and how you “fixed” the statistics to support it! appeared first on All About Statistics.