
** [nothing.Rmd](nothing.Rmd) **

## No information to predict a outcome variable {#nothing}


We have a continuous reaction variable - no explanatory variable(s)

The reaction variable, the one we measure, is interval scaled.
What can we do, if we want to predict the reaction variable for a new observation? 
Which predicted value could be as close as possible to the real value, the observation has?
Theoretically, we could use any value in the range of the observed reaction values, or even values outside that range.
Without knowing anything else, we might use the mean of the observed variable (reaction variable). 
By this we characterize our sample and estimate the value for a new observation, the sample is representative of.

Here, we show the usage of the minimal value of the observed values as the "predicted" value compared with the arithmetic mean. 
This might even be useful, f. e. if we want to assure a minimal level of a whole group, like minimal distance to swim for a surfing course.
Which one "explains" more variance or leaves us with less "unexplained" variance?

```{r nothing}
dd.a <- readRDS(gzcon(url("http://md.psych.bio.uni-goettingen.de/mv/data/div/parms_dat.rds")))
# lets see the reaction variable
library(tidyverse)
set.seed(43)
to_use <- sample(1:nrow(dd.a))
#dd <- dd[sample(dd$subj, size=300), ]
dd <- dd.a[to_use, ]
head(dd[to_use, ])
dd$xx <- 1:nrow(dd)

# all observations in one "Group"
dd %>% ggplot(aes(x='G', y=rv)) + geom_point()
# with jitter
dd %>% ggplot(aes(x='1', y=rv)) + geom_jitter(width=0.05)

dd %>% ggplot(aes(x=xx, y=rv)) + geom_point()
# pseudo var as accumulated distances from minimal value
# to calculate a variation index to be explained, we use the distance to the minimum value of our reaction variable
min(dd$rv)
dd$diff.a <- dd$rv - min(dd$rv)
# mean
# comparison: reduction of unexplained variance
# we calculate the sd of our artificial difference index
sd.a <- sqrt(sum(dd$diff.a ^ 2) / length(dd$diff.a))
# we see a reduction
cat(sd.a, " > ", sd(dd$rv))
# we could conclude, that arithmetic mean is a better estimator than the minimum value of our reaction variable
# to predict our reaction variable for new observations
# ... but this comparison is sort of arbitrary 

# in statisctics we therefore use a constant explanatory variable 
# to compare the introduction of more parameters in the complexer model
# we call this often our NULL-model
# in model formula this is defined by an explanatory variable that is constant, usually 1
m.0 <- lm(dd$rv ~ 1)
# model.matrix(result object) shows us, what we us to predict our reaction variable. Here for the first 6 observations.
head(model.matrix(m.0))
# the estimated parameter is
coefficients(m.0)
# residuals are the distance of our observations from their extimated value, the error we make by estimating their value in the reaction variable
head(m.0$residuals)
# their sd is
sd(m.0$residuals)
# ... standard deviation of the residuals (unexplained variation of reaction variable) is the same as above
cat(sd.a, " > ", sd(m.0$residuals))

# we plot that pseudo reduction to visualize the effect
library(tidyverse)
psych::describe(m.0$residuals)

dd.g <- tibble(
  group = as.factor(c('a', 'm.0a', 'm.0')),
	mm = c(0, 0, mean(dd$rv)),
  se = c(sum(sqrt(dd$diff.a ^ 2)) / length(dd$diff.a), sd(m.0$residuals), sd(m.0$residuals))
)


  
ggplot(dd.g, aes(x=group)) +
  geom_point(data=dd.g, stat='identity', aes(group, y=mm, size=10), show.legend=F, alpha = 0.4) +
	geom_errorbar(data=dd.g, stat='identity', aes(x=group, ymax = mm + se, ymin = mm - se), width = 0.2)

(pp <- ggplot(dd, aes(x=xx, y=rv)) +
  geom_point(alpha = 0.4) +
  geom_point(data=dd.g, stat='identity', aes(x=(as.numeric(group) - 1) * nrow(dd)/3, y=mm, size=10, color = group), show.legend=F) +
  geom_errorbar(data=dd.g, stat='identity', aes(x=(as.numeric(group) - 1) * nrow(dd)/3, y=se, ymax = mm + se, ymin = mm - se, color = group), size = 1, width = 20, show.legend=F)
)

pp + 
  	geom_segment(aes(x = 20, y = 0, xend = 20, yend = max(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +
  	geom_segment(aes(x = 30, y = 0, xend = 30, yend = min(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +
    	geom_segment(aes(x = 40, y = 0, xend = 40, yend = mean(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +

  	geom_segment(aes(x = 170, y = mean(dd$rv), xend = 170, yend = max(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2]) +
  	geom_segment(aes(x = 180, y = mean(dd$rv), xend = 180, yend = min(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2]) +
    	geom_segment(aes(x = 190, y = mean(dd$rv), xend = 190, yend = mean(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2]) +

  geom_hline(aes(yintercept=min(dd$rv)), size=0.3, alpha=0.3, show.legend=F) +
  #geom_text(aes(nrow(dd),min(dd$rv),label = 'min', vjust = -1)) +
  geom_hline(aes(yintercept=max(dd$rv)), size=0.3, alpha=0.3, show.legend=F) 
  #geom_text(aes(nrow(dd) - 10, max(dd$rv) - 0.02,label = 'max', vjust = 1))



# two groups, each with "prediction", we fake data to see the effect
dd.t <- dd %>% dplyr::mutate(rvm = if_else(gender == "m", rv - 0.5, rv))
dd.t %>% dplyr::group_by(gender) %>% dplyr::select(rvm) %>% dplyr::summarize(m.gender = mean(rvm)) -> mm

(pp <- ggplot(dd.t, aes(x=gender, y=rvm, color=gender)) +
  geom_jitter(alpha = 0.3, width=0.1) +
  stat_summary(fun = mean, geom="point", size=3) +
  # stat_summary(fun = mean, geom="hline", size=0.2) +
  stat_summary(fun.data = mean_cl_normal, geom = "errorbar", width=0.1, size=1)
  )

pp + 
  geom_segment(aes(x = 1, y = mm$m.gender[1], xend = 0, yend = mm$m.gender[1]), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +
  geom_segment(aes(x = 2, y = mm$m.gender[2], xend = 0, yend = mm$m.gender[2]), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2])

```

`r if(!params$todo) {"\\begin{comment}"}`

# Data 2020


```{r nothing_data_2020}
dd <- readRDS(gzcon(url("http://md.psych.bio.uni-goettingen.de/mv/data/div/parms_data.rds")))
# lets see the reaction variable
library(tidyverse)
set.seed(43)
dd %>% ggplot(aes(x=sample(id), y=rv)) + geom_point()
# pseudo var as accumulated distances from minimal value
# to calculate a variation index to be explained, we use the distance to the minimum value of our reaction variable
min(dd$rv)
dd$diff.a <- dd$rv - min(dd$rv)
# mean
# comparison: reduction of unexplained variance
# we calculate the sd of our artificial difference index
sd.a <- sqrt(sum(dd$diff.a ^ 2) / length(dd$diff.a))
# we see a reduction
cat(sd.a, " > ", sd(dd$rv))
# we could conclude, that arithmetic mean is a better estimator than the minimum value of our reaction variable
# to predict our reaction variable for new observations
# ... but this comparison is sort of arbitrary 

# in statisctics we therefore use a constant explanatory variable 
# to compare the introduction of more parameters in the complexer model
# we call this often our NULL-model
# in model formula this is defined by an explanatory variable that is constant, usually 1
m.0 <- lm(dd$rv ~ 1)
# model.matrix(result object) shows us, what we us to predict our reaction variable. Here for the first 6 observations.
head(model.matrix(m.0))
# the estimated parameter is
coefficients(m.0)
# residuals are the distance of our observations from their extimated value, the error we make by estimating their value in the reaction variable
head(m.0$residuals)
# their sd is
sd(m.0$residuals)
# ... standard deviation of the residuals (unexplained variation of reaction variable) is the same as above
cat(sd.a, " > ", sd(m.0$residuals))

# we plot that pseudo reduction to visualize the effect
library(tidyverse)
psych::describe(m.0$residuals)

dd.g <- tibble(
  group = as.factor(c('a', 'm.0', 'm.0')),
	mm = c(0, 0, mean(dd$rv)),
  se = c(sum(sqrt(dd$diff.a ^ 2)) / length(dd$diff.a), sd(m.0$residuals), sd(m.0$residuals))
)


  
ggplot(dd.g, aes(x=group)) +
  geom_point(data=dd.g, stat='identity', aes(group, y=mm, size=10), show.legend=F, alpha = 0.4) +
	geom_errorbar(data=dd.g, stat='identity', aes(x=group, ymax = mm + se, ymin = mm - se), width = 0.2)

(pp <- ggplot(dd, aes(x=id, y=rv)) +
  geom_point(alpha = 0.4) +
  geom_point(data=dd.g, stat='identity', aes(x=(as.numeric(group) - 1) * nrow(dd)/2, y=mm, size=10, color = group), show.legend=F) +
  geom_errorbar(data=dd.g, stat='identity', aes(x=(as.numeric(group) - 1) * nrow(dd)/2, y=se, ymax = mm + se, ymin = mm - se, color = group, size = 3), width = 20)
)

pp + 
  	geom_segment(aes(x = 20, y = 0, xend = 20, yend = max(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +
  	geom_segment(aes(x = 30, y = 0, xend = 30, yend = min(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +
    	geom_segment(aes(x = 40, y = 0, xend = 40, yend = mean(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[1]) +

  	geom_segment(aes(x = 170, y = mean(dd$rv), xend = 170, yend = max(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2]) +
  	geom_segment(aes(x = 180, y = mean(dd$rv), xend = 180, yend = min(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2]) +
    	geom_segment(aes(x = 190, y = mean(dd$rv), xend = 190, yend = mean(dd$rv)), arrow = arrow(length = unit(0.5, "cm")), color = scales::hue_pal()(2)[2])
```





`r if(!params$todo) {"\\end{comment}"}`



Conclusion: Without any information to predict a reaction value of a new observation, 
we would best use the mean of the observed values of our sample. 
We can consider this mean a parameter, that helps us for this prediction.
Estimating the mean for new observation would minimize the average deviation (distance) among all observations.



Version: `r format(Sys.time(), '%d %B, %Y %H:%M')`
