```{r setup, include=FALSE,warning=FALSE, message=FALSE}
knitr::opts_chunk$set(echo = TRUE) 
render = 'normal_print'
```



This file provides some of the code used to generate several results presented in the paper:

```
Investigating perceptually-based models to predict importance of facial blendshapes

by E. Carrigan, K. Zibrek, R. Dahyot and R. McDonnell published in ACM MIG 2020.

```
with Github repo https://github.com/Roznn/facial-blendshapes 


Results for some models reported in the paper (e.g. AICs, Deviance) have been run in the R Console directly and are not in the Example Rmd code but can easily be inferred from the example code given. Please read the paper for more information on the meaning of the variables and meaning of results shown. 

**Please cite the paper when using data and/or code.**       


# Data Exploration


```{r message=FALSE, warning=FALSE,echo=TRUE}

library(knitr)
require(xlsx)

mydata =read.xlsx("combined_resultsUpdate.xlsx", sheetName = "combined")

str(mydata)

```


Six  virtual characters are used (3 females Asian-Black-White, 3 males Asian-Black-White) in this study (see variables Sex and Race in the data).    




# ANOVA tables  (MIG2020 paper: Tab. 4-7)




## Using Geometric metrics


### RMS


```{r message=FALSE, warning=FALSE,echo=TRUE}

kable(anova(lm(Difference~RMS * AU_Name*Race*Sex,data=mydata)))

```

### STED

```{r message=FALSE, warning=FALSE,echo=TRUE}


kable(anova(lm(Difference~STED * AU_Name*Race*Sex,data=mydata)))

```


## Using Image metrics

### SSIM

```{r message=FALSE, warning=FALSE,echo=TRUE}


kable(anova(lm(Difference~SSIM* AU_Name*Race*Sex,data=mydata)))




```

###  MSE

```{r message=FALSE, warning=FALSE,echo=TRUE}




kable(anova(lm(Difference~MSE* AU_Name*Race*Sex,data=mydata)))


```







# AIC and Deviance (MIG2020 paper: Tab. 3)


## STED 

### STED

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~STED,data=mydata,family=gaussian(link="identity"))
mp <- glm(Difference~STED,data=mydata,family=poisson(link="identity"))

kable(AIC(mg,mp))

deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### STED*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~STED*AU_Name,data=mydata,family=gaussian(link="sqrt"))
mp <- glm(Difference~STED*AU_Name,data=mydata,family=poisson(link="sqrt"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### STED*AU + Race : Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~STED*AU_Name+Race:Sex,data=mydata,family=poisson(link="sqrt"))
mg <- glm(Difference~STED*AU_Name+Race:Sex,data=mydata,family=gaussian(link="sqrt"))



kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```


### STED* AU * Race * Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~STED*AU_Name*Race*Sex,data=mydata,family=poisson(link="sqrt"))
mg <- glm(Difference~STED*AU_Name*Race*Sex,data=mydata,family=gaussian(link="sqrt"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```





## RMS 

### RMS

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~RMS,data=mydata,family=gaussian(link="identity"))
mp <- glm(Difference~RMS,data=mydata,family=poisson(link="identity"))

kable(AIC(mg,mp))

deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### RMS*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~RMS*AU_Name,data=mydata,family=gaussian(link="identity"))
mp <- glm(Difference~RMS*AU_Name,data=mydata,family=poisson(link="identity"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### RMS*AU + Race : Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~RMS*AU_Name+Race:Sex,data=mydata,family=poisson(link="identity"))
mg <- glm(Difference~RMS*AU_Name+Race:Sex,data=mydata,family=gaussian(link="identity"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```


### RMS* AU * Race * Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~RMS*AU_Name*Race*Sex,data=mydata,family=poisson(link="identity"))
mg <- glm(Difference~RMS*AU_Name*Race*Sex,data=mydata,family=gaussian(link="identity"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```





## SSIM
### SSIM

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~SSIM,data=mydata,family=gaussian(link="identity"))
mp <- glm(Difference~SSIM,data=mydata,family=poisson(link="identity"))

kable(AIC(mg,mp))

deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### SSIM*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~SSIM*AU_Name,data=mydata,family=gaussian(link="identity"))
mp <- glm(Difference~SSIM*AU_Name,data=mydata,family=poisson(link="identity"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### SSIM*AU + Race : Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~SSIM*AU_Name+Race:Sex,data=mydata,family=poisson(link="log"))
mg <- glm(Difference~SSIM*AU_Name+Race:Sex,data=mydata,family=gaussian(link="sqrt"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```


### SSIM* AU * Race * Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~SSIM*AU_Name*Race*Sex,data=mydata,family=poisson(link="log"))
mg <- glm(Difference~SSIM*AU_Name*Race*Sex,data=mydata,family=gaussian(link="sqrt"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```






## MSE

### MSE

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~MSE,data=mydata,family=gaussian(link="identity"))
mp <- glm(Difference~MSE,data=mydata,family=poisson(link="identity"))

kable(AIC(mg,mp))

deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### MSE*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}
mg <- glm(Difference~MSE*AU_Name,data=mydata,family=gaussian(link="log"))
mp <- glm(Difference~MSE*AU_Name,data=mydata,family=poisson(link="log"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```

### MSE*AU + Race : Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~MSE*AU_Name+Race:Sex,data=mydata,family=poisson(link="identity"))
mg <- glm(Difference~MSE*AU_Name+Race:Sex,data=mydata,family=gaussian(link="identity"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 

```


### MSE* AU * Race * Sex

```{r message=FALSE, warning=FALSE,echo=TRUE}

mp <- glm(Difference~MSE*AU_Name*Race*Sex,data=mydata,family=poisson(link="identity"))
mg <- glm(Difference~MSE*AU_Name*Race*Sex,data=mydata,family=gaussian(link="identity"))

kable(AIC(mg,mp))
deviance(mp)
qchisq(0.95, length(mydata$Difference)-length(mp$coefficient)) 


```



# Figures  (MIG2020 paper: Fig. 3)


##  RMS*AU+Race:Sex


```{r message=FALSE, warning=FALSE,echo=TRUE}
require(ggplot2)


m<-glm(Difference~RMS*relevel(factor(AU_Name),ref='Neutral')+Race:Sex,data=mydata,family=poisson(link="identity"))

ggplot(mydata,aes(RMS, Difference, group=interaction(AU_Name,Race,Sex), col=interaction(AU_Name),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   ylab("Perceptual Difference") + 
   xlab("RMS") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```


##  RMS*AU


```{r message=FALSE, warning=FALSE,echo=TRUE}

m<-glm(Difference~RMS*relevel(factor(AU_Name),ref='Neutral'),data=mydata,family=poisson(link="identity"))

ggplot(mydata,aes(RMS, Difference, group=interaction(AU_Name), col=interaction(AU_Name),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   ylab("Perceptual Difference") + 
   xlab("RMS") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```



##  STED*AU+Race:Sex  



```{r message=FALSE, warning=FALSE,echo=TRUE}
require(ggplot2)


m<-glm(Difference~STED*relevel(factor(AU_Name),ref='Neutral')+Race:Sex,data=mydata,family=poisson(link="sqrt"))

ggplot(mydata,aes(STED, Difference, group=interaction(AU_Name,Race,Sex), col=interaction(AU_Name),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   #  geom_point(alpha = 0.8,show.legend=TRUE) +
   ylab("Perceptual Difference") + 
   xlab("STED") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```



##  STED*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}


m<- glm(Difference~STED*AU_Name,data=mydata,family=poisson(link="sqrt"))
ggplot(mydata,aes(STED, Difference, group=interaction(AU_Name), col=interaction(Blendshapes),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   #  geom_point(alpha = 0.8,show.legend=TRUE) +
   ylab("Perceptual Difference") + 
   xlab("STED") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")



```



##  MSE* AU* Sex* Race



```{r message=FALSE, warning=FALSE,echo=TRUE}


m<- glm(Difference~MSE*relevel(factor(AU_Name),ref='Neutral')*Sex*Race,data=mydata,family=poisson(link="log"))
ggplot(mydata,aes(MSE, Difference, group=interaction(AU_Name,Race,Sex), col=interaction(Blendshapes),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   ylab("Perceptual Difference") + 
   xlab("MSE") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```


## MSE*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}


m<- glm(Difference~MSE*relevel(factor(AU_Name),ref='Neutral'),data=mydata,family=poisson(link="identity"))
ggplot(mydata,aes(MSE, Difference, group=interaction(AU_Name), col=interaction(Blendshapes),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   ylab("Perceptual Difference") + 
   xlab("MSE") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```






## SSIM* AU * Sex* Race



```{r message=FALSE, warning=FALSE,echo=TRUE}


m<- glm(Difference~SSIM*relevel(factor(AU_Name),ref='Neutral')*Sex*Race,data=mydata,family=poisson(link="log"))
ggplot(mydata,aes(SSIM, Difference, group=interaction(AU_Name,Race,Sex), col=interaction(Blendshapes),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   ylab("Perceptual Difference") + 
   xlab("SSIM") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```


## SSIM*AU

```{r message=FALSE, warning=FALSE,echo=TRUE}


m<- glm(Difference~SSIM*relevel(factor(AU_Name),ref='Neutral'),data=mydata,family=poisson(link="identity"))
ggplot(mydata,aes(SSIM, Difference, group=interaction(AU_Name), col=interaction(Blendshapes),linetype=interaction(AU_Name)))+
   geom_line(aes(y=m$fitted.values, colour=AU_Name, linetype=AU_Name),size=1) +
   ylab("Perceptual Difference") + 
   xlab("SSIM") +
   theme_bw()+ 
   theme(text = element_text(size = 16))+
   labs(col="Blendshapes",linetype="Blendshapes")


```


