I try to code my first interactive .Rmd file:
I just want to show the interaction in a linear regression x~y by
y(x)= a*x + b
I just want to take two sliders:
one for b and one for a
my code is until now:
---
output: html_document
runtime: shiny
---
## some text...
*some more text
<br><br>
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r, echo = FALSE, message=FALSE, warnings=FALSE}
mietspiegel <- read.table("http://www.stat.uni-muenchen.de/service/datenarchiv/miete/miete03.asc", header=TRUE)
mieten_regression <- lm(mietspiegel$nm ~ mietspiegel$wfl)
mieten_regression$coefficients
b <- mieten_regression$coefficients[1] # Coefficient No. 1 Intercept
a <- mieten_regression$coefficients[2] # Coefficient No. 2 mietspiegel$wfl
# Slider ...
inputPanel(sliderInput("b", "Coefficient No. 1 Intercept", min = 0, max = 2000, step = 1, value = b),
sliderInput("a", "Coefficient No. 2 Wohnflaeche", min = 0, max = 200, step = 10, value = a),
actionButton("sample", "Resample"))
# Scatterplott
library(ggplot2)
ggplot(mietspiegel,
aes(y=nm, x=wfl)) +
geom_abline(intercept = b, slope = a, colour = "red") + # Add inear regression line
geom_point(shape=1) + # Use hollow circles
xlab("Fläche") +
ylab("Price")
```
I don't know how to use the slider input correctly. I want for my linear regression line a slider for a and a slider for b so that you can input there your coefficents intercept (b) and mietspiegel$wfl (a) are and see the new regression line after this.
To make geom_abline dependent on your sliders you should wrap the ggplot part into renderPlot function and then set the parameter a to input$a and the parameter b to input$b. (You access the value of the given widget with input$id)
renderPlot({
library(ggplot2)
ggplot(mietspiegel,
aes(y=nm, x=wfl)) +
geom_abline(intercept = input$b, slope = input$a, colour = "red") + # Add inear regression line
geom_point(shape=1) + # Use hollow circles
xlab("Fläche") +
ylab("Price")
})
EDITED: I added answers to further questions as comments in the code below
---
output: html_document
runtime: shiny
---
## some text...
*some more text
<br><br>
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r, echo = FALSE, message=FALSE, warnings=FALSE}
mietspiegel <- read.table("http://www.stat.uni-muenchen.de/service/datenarchiv/miete/miete03.asc", header=TRUE)
mieten_regression <- lm(mietspiegel$nm ~ mietspiegel$wfl)
mieten_regression$coefficients
b <- mieten_regression$coefficients[1] # Coefficient No. 1 Intercept
a <- mieten_regression$coefficients[2] # Coefficient No. 2 mietspiegel$wfl
# Slider ...
inputPanel(
sliderInput("b", "Coefficient No. 1 Intercept", min = 0, max = 200, step = 10, value = b),
sliderInput("a", "Coefficient No. 2 Wohnflaeche", min = 0, max = 20, step = 1, value = a),
actionButton("residuen", "Zeige Residuen an")
)
# Scatterplott
renderPlot({
library(ggplot2)
ggplot(mietspiegel, aes(y=nm, x=wfl)) +
geom_abline(intercept = input$b, slope = input$a, colour = "red") + # Add inear regression line
geom_point(shape=1) + # Use hollow circles
xlab("Flaeche") + # changed Fläche to Flaeche :)
ylab("Price")
})
# Two ways of showing residual plots when the button "Resample" is pressed:
# (i) Easy way - use conditionalPanel
# conditionalPanel(
# condition = "input.residuen !== 0",
# list(
# hr(),
# h3("Residuen"),
# plotOutput("residuals"),
# hr()
# )
# )
#
# output$residuals <- renderPlot({
# par(mfrow = c(2,2))
# plot(mieten_regression)
# par(mfrow = c(1,1))
# })
# -----------------------------------------------------------------------------
# (ii) More difficlult but more powerful way - use render renderUI with a condition.
# Using modulo operator you can show and hide plots by pressing
uiOutput("dynamic_residuals")
output$dynamic_residuals <- renderUI({
if ((input$residuen + 1) %% 2 == 0 ) {
return(list(
hr(),
h3("Residuen"),
plotOutput("residuals"),
hr()
))
} else {
return(NULL)
}
})
output$residuals <- renderPlot({
par(mfrow = c(2,2))
plot(mieten_regression)
par(mfrow = c(1,1))
})
# You can read it in this way:
# - use renderPlot function that sends a plot to the plotOutput
# - create "plotOutput" via "renderUI" and place it (together with hr and h3 tags) in the document but only if the button (input$residuen) is clicked.
```
## Second part of your question
<hr>
```{r, echo = FALSE, message=FALSE, warnings=FALSE}
# define functions for two Errorfields
mean_abs_diff <- function(a,b,x,y) {mean(abs(a * x + b - y))} # middle absolute changing from y
mean_sqr_diff <- function(a,b,x,y) {sqrt(mean((a * x + b - y)^2))} # sqrt of the middle square changing from y
```
```{r, echo = FALSE, message=FALSE, warnings=FALSE}
renderPrint({
# Errors vs changings of a
mad <- mean_abs_diff(input$a, input$b, mietspiegel$wfl, mietspiegel$nm)
msd <- mean_sqr_diff(input$a, input$b,mietspiegel$wfl, mietspiegel$nm)
cat(" Mean absolute difference: ", round(mad, 2), "\n",
"Mean squared difference: ", round(msd, 2))
})
```
```{r, echo = FALSE, message=FALSE, warnings=FALSE}
# To generate new plots depending on changing values of the sliders, again,
# wrap the code into renderPlot and replace "a" and "b" with "input$a" and "input$b"
# You also can use mfrow to combine all these plots into one
x <- seq(-50, 50, 1)
renderPlot({
par(mfrow = c(2,2), mar = c(3,3,3,3))
plot(x, sapply(x, function(y) mean_sqr_diff(input$a, input$a + y,mietspiegel$wfl, mietspiegel$nm)),
xlab = "additive changing of b (delta b)", ylab = "sqrt of the middle sqaure error", type = "l")
plot(x, sapply(x, function(y) mean_abs_diff(input$a, input$a + y,mietspiegel$wfl, mietspiegel$nm)),
xlab = "additive changing of b (delta b)", ylab = "middle absolute error", type = "l")
# Errors vs changings of b
x <- seq(-1, 1, 0.1)
plot(x, sapply(x, function(y) mean_sqr_diff(input$a + y, input$b,mietspiegel$wfl, mietspiegel$nm)),
xlab = "additive changing of a (delta a)", ylab = "sqrt of the middle sqaure error", type = "l")
plot(x, sapply(x, function(y) mean_abs_diff(input$a + y, input$b,mietspiegel$wfl, mietspiegel$nm)),
xlab = "additive changing of a (delta a)", ylab = "middle absolute error", type = "l")
par(mfrow = c(1,1))
})
```