---
title: "sigr formatting"
author: "John Mount"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{sigr formatting}
  %\VignetteEngine{knitr::rmarkdown}
  \usepackage[utf8]{inputenc}
---

Examples of `sigr` formatting.  Inspired by APA format
(American Psychological Association), but not fully compliant.  Discussed [here](https://win-vector.com/2016/10/02/proofing-statistics-in-papers/).

Please see the APA stat guidelines for more notes.

Simple formatting.

```{r  results='asis'}
library("sigr")
sigr::getRenderingFormat()
cat(render(wrapSignificance(1/300)))
```

F-test examples (quality of a numeric model of a numeric outcome).

```{r  results='asis'}
cat(render(wrapFTestImpl(numdf=2,dendf=55,FValue=5.56)))
```

```{r}
d <- data.frame(x=0.2*(1:20))
d$y <- cos(d$x)
model <- lm(y~x,data=d)
d$prediction <- predict(model,newdata=d)
print(summary(model))
```

```{r  results='asis'}
cat(render(wrapFTest(model),pSmallCutoff=1.0e-12))
cat(render(wrapFTest(d,'prediction','y'),
                              pSmallCutoff=1.0e-12))
```

Chi-squared test examples (quality of a probability model 
of a two category outcome).

```{r}
d <- data.frame(x=c(1,2,3,4,5,6,7,7),
       y=c(TRUE,FALSE,FALSE,FALSE,TRUE,TRUE,TRUE,FALSE))
model <- glm(y~x,data=d,family=binomial)
model$converged
summary(model)
d$pred <- predict(model,type='response',newdata=d)
```
```{r results='asis'}
cat(render(wrapChiSqTest(model),pLargeCutoff=1))
cat(render(wrapChiSqTest(d,'pred','y'),pLargeCutoff=1))
```

```{r}
d <- data.frame(x=c(1,2,3,4,5,6,7,7),
               y=c(1,1,2,2,3,3,4,4))
ct <- cor.test(d$x,d$y)
```
```{r results='asis'}
cat(render(wrapCorTest(ct)))
```

```{r}
d <- data.frame(x=c('b','a','a','a','b','b','b'),
                y=c('1','1','1','2','2','2','2'))
ft <- fisher.test(table(d))
```
```{r results='asis'}
cat(render(wrapFisherTest(ft),pLargeCutoff=1))
```

```{r}
d <- data.frame(x=c(1,2,3,4,5,6,7,7),
                y=c(1,1,2,2,3,3,4,4))
ft <- t.test(d$x,d$y)
```
```{r results='asis'}
cat(render(wrapTTest(ft),pLargeCutoff=1))
```

```{r results='asis'}
parallelCluster <- NULL
#parallelCluster <- parallel::makeCluster(parallel::detectCores())

set.seed(25325)
d <- data.frame(x1=c(1,2,3,4,5,6,7,7),
                y=c(FALSE,TRUE,FALSE,FALSE,
                    TRUE,TRUE,FALSE,TRUE))
d <- rbind(d,d,d,d)
sigr::resampleTestAUC(d,'x1','y',TRUE,
                nrep=200,
                parallelCluster=parallelCluster)

set.seed(25325)
d <- data.frame(x1=c(1,2,3,4,5,6,7,7),
                x2=1,
                y=c(FALSE,TRUE,FALSE,FALSE,
                    TRUE,TRUE,FALSE,TRUE))
d <- rbind(d,d,d,d)
sigr::testAUCpair(d,'x1','x2','y',TRUE,
                    nrep=200,
                    parallelCluster=parallelCluster)
if(!is.null(parallelCluster)) {
  parallel::stopCluster(parallelCluster)
}
```


permutationScoreModel

```{r}
set.seed(25325)
y <- 1:5
m <- c(1,1,2,2,2)
cor.test(m,y,alternative='greater')
f <- function(modelValues, yValues) { cor(modelValues, yValues) }
sigr::permutationScoreModel(m,y,f)
```

resampleScoreModel

```{r}
set.seed(25325)
y <- 1:5
m1 <- c(1,1,2,2,2)
cor.test(m1,y,alternative='greater')
f <- function(modelValues,yValues) {
  if((sd(modelValues)<=0)||(sd(yValues)<=0)) {
    return(0)
  }
  cor(modelValues,yValues)
}
s <- sigr::resampleScoreModel(m1,y,f)
print(s)
z <- s$observedScore/s$sd  # always check size of z relative to bias!
pValue <- pt(z,df=length(y)-2,lower.tail=FALSE)
pValue
```

resampleScoreModelPair

```{r}
set.seed(25325)
y <- 1:5
m1 <- c(1,1,2,2,2)
m2 <- c(1,1,1,1,2)
cor(m1,y)
cor(m2,y)
f <- function(modelValues,yValues) {
  if((sd(modelValues)<=0)||(sd(yValues)<=0)) {
    return(0)
  }
  cor(modelValues,yValues)
}
sigr::render(sigr::resampleScoreModelPair(m1,m2,y,f),
             pLargeCutoff=1,format='ascii')
```