This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff
The Frog Game
There are 2 paper frogs. You can name them and choose the probability
of them landing on their feet (between 0 and 1). The game will randomly
choose one of the frogs for you. Make the frog jump any number of times
and guess which frog you got after observing the data. You can make the
frog jump again, if you are not sure yet.
This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff
This plot illustrates how the posterior updates when there are 10 successful jumps (frog lands on its feet 10 times).
You can see how each jump affects the next.
This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff Source: http://courses.ncssm.edu/math/Talks/PDFS/BullardNCTM2001.pdf
|
## Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff
library(shiny)
library(ggplot2)
prior_H <- 0.5
prior_MJ <- 0.5
solution <- "startvalue" #### initial value for guessing stuff
shinyServer(
function(input, output, session){
##### observe-thingy to observe the user input of the name and to change the lable in numeric input:
observe({
updateNumericInput(session, inputId = "H",
label = paste("Probability that", input$name1, "lands on its feet:"))
updateNumericInput(session, inputId = "MJ",
label = paste("Probability that", input$name2, "lands on its feet:"))
updateRadioButtons(session, inputId = "choose", label = "Guess which frog you have", choices = list(input$name1, input$name2), selected = character(0))
})
#####
# choose frog randomly
frog <- sample(x=c("H", "MJ"), size=1, replace=FALSE, prob=c(.5, .5))
##### Compare to user-guessed frog...
#solution <- "startvalue"
# observe choices probabilities
observeEvent(c(input$H, input$MJ),{
### PRIOR
H_prob_feet <<- input$H
MJ_prob_feet <<- input$MJ #this is the info the user provides on prob of success.
# calculate number of successes
# take probability of the randomly chosen frog as input
if(frog=="H"){
prb <<- H_prob_feet
}else{
prb <<- MJ_prob_feet}
})
observeEvent(input$onejump,{
output$plotpost <- renderPlot({
x <- 0.5
a <- 0.5
n1 <- 1
N <- 10
## calculate number of successes
# sample trials for chosen frog
#frog_trials <- rbinom(n=input$samplesize, size=1, prob=prb)
# calculate number of successes
#successes <- sum(frog_trials==1)
successes <- 1
Hdat <- data.frame(frog = factor(rep(input$name1, N*2)),
levels=c(input$name1,N*2),
Probability = factor(rep(c("Prior", "Post"), N)),
Y = c(prior_H, H_prob_feet))
MJdat <- data.frame(frog = factor(rep(input$name2, N*2)),
levels=c(input$name2,N*2),
Probability = factor(rep(c("Prior", "Post"), N)),
Y = c(prior_MJ, MJ_prob_feet))
dat2 <- as.data.frame(rbind(Hdat, MJdat))
dist <- matrix(NA,20,3)
dfH <- as.data.frame(dist[1:10,])
dfMJ <- as.data.frame(dist[11:20,])
dist[,3] <- rep(c(1:10), times = 2)
dfH[,2] <- NA
dfMJ[,2] <- NA
dfH[,1] <- input$name1
dfMJ[,1] <- input$name2
t <- 10
#colnames(dist) <- c("H","MJ", "V3")
i <- 1
dfH$V2 <- as.numeric(dfH$V2)
dfMJ$V2 <- as.numeric(dfMJ$V2)
dfH$V3 <- seq(1:10)
dfMJ$V3 <- seq(1:10)
for (i in 1:t){
prior_H <- x
prior_MJ <- a
likelihood_H <- (H_prob_feet)^successes * (1-H_prob_feet)^(n1-successes)
likelihood_MJ <- (MJ_prob_feet)^successes * (1-MJ_prob_feet)^(n1-successes)
### POSTERIOR
prob_succ <- (likelihood_H * prior_H) + (likelihood_MJ * prior_MJ)
x <- round((likelihood_H * prior_H)/prob_succ, 2)
a <- round((likelihood_MJ * prior_MJ)/prob_succ, 2)
cat(x,a,"\n")
dfH[i,2] <- x
dfMJ[i,2] <- a
df <- rbind(dfH,dfMJ)
df$V3 <- factor(df$V3, levels = rep(1:10, each = 2))
colnames(df) <- c("Frog","Probabilities", "Trial")
plotpost <- ggplot(data=df, aes(x=Frog, y=Probabilities, color = Trial, fill = Trial)) +
geom_bar(stat ="identity", position= position_dodge()) +
scale_y_continuous(limits = c(0, 1)) +
theme_bw() +
geom_text(aes(label=Probabilities), vjust=-0.5, color='black',position=position_dodge(.9), size=3) +
guides(color = "none")
print(plotpost)
i <- i+1
}
})
})
# observe number of jumps
observeEvent(input$jump,{
### DATA
n <<- input$samplesize
## calculate number of successes
# sample trials for chosen frog
frog_trials <<- rbinom(n=input$samplesize, size=1, prob=prb)
# calculate number of successes
successes <<- sum(frog_trials==1)
### LIKELIHOOD
likelihood_H <<- (H_prob_feet)^successes * (1-H_prob_feet)^(n-successes)
likelihood_MJ <<- (MJ_prob_feet)^successes * (1-MJ_prob_feet)^(n-successes)
##################
### POSTERIOR
prob_succ <<- (likelihood_H * prior_H) + (likelihood_MJ * prior_MJ)
posterior_H <<- (likelihood_H * prior_H)/prob_succ
posterior_MJ <<- (likelihood_MJ * prior_MJ)/prob_succ
##### make frog picture turn upside-down if less than 50 % successes
# need to add upside-down picture to folder!
if(successes >= (n/2)){
v_src = "www/frog.jpg"
}
else {
v_src = "www/frog_ud.jpg"
}
output$frog <- renderImage({
{return(list(
src = v_src,
contentType = "image/jpeg",
height=300,
length=300
))}
}, deleteFile=FALSE)
#####
##### look if they chose the right frog + give feedback - add action button
observeEvent(input$sol_check, {
if (((input$name1 == input$choose) & frog == "H") | ((input$name2 == input$choose) & frog == "MJ")) {
solution <- "Good job! You made the right choice!"
}
else {
solution <- "Well... at least you tried!"
}
output$check <- renderText({
paste(solution)
})
})
####
output$successes <- renderText({
c("The frog landed on its feet",
successes,
"out of",
length(frog_trials), # should only be updated if button is clicked (not the case now)
"times!")
})
# output prior and posterior distribution
output$plotpriorpost <- renderPlot({
Hdat2 <- data.frame(frog = (factor(rep(input$name1, 2))),
Distribution = factor(c("Prior", "Posterior")),
Y = c(posterior_H, prior_H))
MJdat2 <- data.frame(frog = (factor(rep(input$name2, 2))),
Distribution = factor(c("Prior", "Posterior")),
Y = c(posterior_MJ, prior_MJ))
dat3 <- as.data.frame(rbind(Hdat2,MJdat2))
plotpriorpost <- ggplot(data=dat3, aes(x=frog, y=Y, color = Distribution, fill = Distribution)) +
geom_bar(stat ="identity", position= position_dodge()) +
scale_y_continuous(limits = c(0, 1)) +
scale_fill_manual(values = c("#3399FF", "#66CC33"), labels= c("Prior", "Posterior")) +
scale_color_manual(values = c("#3399FF", "#66CC33"), labels= c("Prior", "Posterior")) +
theme_bw() +
geom_text(aes(label=round(Y, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3) +
guides(color = "none")
plotpriorpost
})
output$prior <- renderPlot({
##plot the priors
prior_dat <- data.frame(frog = factor(c(input$name1,input$name2),
levels=c(input$name1,input$name2)),
priors = c(prior_H,prior_MJ),
probability = c(0:1))
plotprior <- ggplot(data=prior_dat, aes(x=frog, y=priors, fill=priors)) +
geom_bar(stat="identity",fill=c("#3399FF", "#66CC33"), colour=c("#3399FF", "#66CC33"))+ labs(title="PRIOR") + theme(plot.title=element_text(size=25)) +
scale_y_continuous(limits=c(0,1))+
geom_text(aes(label=round(priors, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3)+ theme(legend.position="none")
plotprior
})
output$likelihood <- renderPlot({
##plot the likelihoods
likelihood_dat <- data.frame(frog = factor(c(input$name1,input$name2),
levels=c(input$name1,input$name2)),
likelihoods = c(likelihood_H,likelihood_MJ),
probability = c(0:1))
plotlikelihood <- ggplot(data=likelihood_dat, aes(x=frog, y=likelihoods, fill=likelihoods)) +
geom_bar(stat="identity",fill=c("#3399FF", "#66CC33"), colour=c("#3399FF", "#66CC33"))+ labs(title="LIKELIHOOD") + theme(plot.title=element_text(size=25))+
scale_y_continuous(limits=c(0,1))+
geom_text(aes(label=round(likelihoods, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3)+ theme(legend.position="none")
plotlikelihood
})
output$posterior <- renderPlot({
## plot the posterior
post_dat <- data.frame(frog = factor(c(input$name1,input$name2),
levels=c(input$name1,input$name2)),
posts = c(posterior_H,posterior_MJ),
probability = c(0:1))
plotpost <- ggplot(data=post_dat, aes(x=frog, y=posts, fill=posts)) +
geom_bar(stat="identity",fill=c("#3399FF", "#66CC33"), colour=c("#3399FF", "#66CC33"))+ labs(title="POSTERIOR") + theme(plot.title=element_text(size=25)) +
scale_y_continuous(limits=c(0,1))+
geom_text(aes(label=round(posts, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3)+ theme(legend.position="none")
plotpost
})
})
observeEvent(input$update,{
## the posterior becomes the prior for the next flip
prior_H <<- posterior_H
prior_MJ <<- posterior_MJ
output$plotpriorpost <- renderPlot({
Hdat2 <- data.frame(frog = (factor(rep(input$name1, 2))),
Distribution = factor(c("Prior", "Posterior")),
Y = c(NA, prior_H))
MJdat2 <- data.frame(frog = (factor(rep(input$name2, 2))),
Distribution = factor(c("Prior", "Posterior")),
Y = c(NA, prior_MJ))
dat3 <- as.data.frame(rbind(Hdat2,MJdat2))
plotpriorpost <- ggplot(data=dat3, aes(x=frog, y=Y, color = Distribution, fill = Distribution)) +
geom_bar(stat ="identity", position= position_dodge()) +
scale_y_continuous(limits = c(0, 1)) +
scale_fill_manual(values = c("#3399FF", "#66CC33"), labels= c("Prior", "Posterior")) +
scale_color_manual(values = c("#3399FF", "#66CC33"), labels= c("Prior", "Posterior")) +
theme_bw() +
geom_text(aes(label=round(Y, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3) +
guides(color = "none")
plotpriorpost
})
# output new prior
output$prior <- renderPlot({
##plot the new priors
prior_dat <- data.frame(frog = factor(c(input$name1,input$name2),
levels=c(input$name1,input$name2)),
priors = c(prior_H,prior_MJ),
probability = c(0:1))
plotprior <- ggplot(data=prior_dat, aes(x=frog, y=priors, fill=priors)) +
geom_bar(stat="identity",fill=c("#3399FF", "#66CC33"), colour=c("#3399FF", "#66CC33"))+ labs(title="PRIOR") + theme(plot.title=element_text(size=25))+
scale_y_continuous(limits=c(0,1))+
geom_text(aes(label=round(priors, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3)+ theme(legend.position="none")
plotprior
})
output$likelihood <- renderPlot({
##plot the likelihoods
likelihood_dat <- data.frame(frog = factor(c(input$name1,input$name2),
levels=c(input$name1,input$name2)),
likelihoods = c(0,0),
probability = c(0:1))
plotlikelihood <- ggplot(data=likelihood_dat, aes(x=frog, y=likelihoods, fill=likelihoods)) +
geom_bar(stat="identity",fill=c("#3399FF", "#66CC33"), colour=c("#3399FF", "#66CC33"))+ labs(title="LIKELIHOOD") + theme(plot.title=element_text(size=25))+
scale_y_continuous(limits=c(0,1))+
geom_text(aes(label=round(likelihoods, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3)+ theme(legend.position="none")
plotlikelihood
})
## delete posterior
output$posterior <- renderPlot({
post_dat <- data.frame(frog = factor(c(input$name1,input$name2),
levels=c(input$name1,input$name2)),
posts = c(0,0),
probability = c(0:1))
plotpost <- ggplot(data=post_dat, aes(x=frog, y=posts, fill=posts)) +
geom_bar(stat="identity",fill=c("#3399FF", "#66CC33"), colour=c("#3399FF", "#66CC33"))+ labs(title="POSTERIOR") + theme(plot.title=element_text(size=25)) +
scale_y_continuous(limits=c(0,1))+
geom_text(aes(label=round(posts, digits=4)), vjust=-0.5, color='black',position=position_dodge(.9), size=3)+ theme(legend.position="none")
plotpost
})
})
output$formular <- renderUI({
withMathJax(helpText('$$P(frog1|k,n) = \\frac{P(k|frog1,n) * P(frog1)}{P(k|frog1,n) * P(frog1)+P(k|frog2,n) * P(frog2)}$$'))
})
#### Image Output for Theory Tab
image_width <- 900
output$theory <- renderImage({
{return(list(
src = "www/theory_script.png",
contentType = "image/png"
,
# height=300,
width=image_width
))}
# print("theory1")
}, deleteFile = FALSE)
})
## Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff
library(shiny)
shinyUI(fluidPage(
includeScript("../../../Matomo-tquant.js"),
withMathJax(),
tags$head(tags$style("#formular{color:red;
font-size: 20px;
font-style: italic;
}")),
fluidRow(
column(12,align='center',
titlePanel("The Frog Game")
)
),
fluidRow(
navbarPage(" ",
#tabsetPanel(
## first panel
tabPanel("Prepare Frogs",
wellPanel(
fluidRow(
column(12,
list(tags$head(tags$style("body {background-color: #60cf44; }"))), ##### changes background color
helpText("There are 2 paper frogs. You can name them and choose the probability
of them landing on their feet (between 0 and 1). The game will randomly
choose one of the frogs for you. Make the frog jump any number of times
and guess which frog you got after observing the data. You can make the
frog jump again, if you are not sure yet.")
),
column(3,
textInput(inputId = "name1", label = "Name frog 1:", value = "Eric-Jan")
),
column(3,
textInput(inputId = "name2", label = "Name frog 2:", value = "Martin")
),
########
column(3,
numericInput(inputId = "H", label = "Probability that Eric-Jan lands on its feet:", value = NA, min = 0, max = 1, step = 0.01)
),
column(3,
numericInput(inputId = "MJ", label = "Probability that Martin lands on its feet:", value = NA, min = 0, max = 1, step = 0.01)
)
)
),
column(12, align="center",
br(),
br(),
c("This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff")
)
),
# second panel
tabPanel("Frog Start",
fluidRow(
column(12,
wellPanel(
helpText("This plot illustrates how the posterior updates when there are 10 successful jumps (frog lands on its feet 10 times).
You can see how each jump affects the next.")
))
),
sidebarLayout(
sidebarPanel(
actionButton("onejump", label = "Let the frog jump!"),
br(),
br(),
br()
),
mainPanel(
column(12,align="center",
plotOutput("plotpost")),
column(12, align="center",
br(),
br(),
c("This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff")
)
)
)
),
# third tab
tabPanel("Jump A Frog",
sidebarLayout(
sidebarPanel(align="center",
#sliderInput("probred", label = "Probability that the red frog lands on his feet:",
# min = 0, max = 1, value = 0.01),
#sliderInput("probgreen", label = "Probability that the green frog lands on his feet:",
# min = 0, max = 1, value = 0.50),
#actionButton("probchoice", label = "Set the probabilities of the frogs!"),
sliderInput("samplesize", label = "How many times would you like to jump the frog?",
min = 1, max = 100, value = 1),
actionButton("jump", label = "Let the frog jump!"),
actionButton("update", label = "Update your knowledge!"),
br(),
br(),
br(),
textOutput("successes"),
br(),
imageOutput("frog"),
##### Guessing of frog + answercheck
radioButtons("choose", label = "Guess which frog you have", choices = list("a", "cfg"), selected = character(0)),
actionButton("sol_check", label = "Submit your answer!"),
br(),
br(),
textOutput("check")
),
mainPanel(
column(12,align="center",
plotOutput("plotpriorpost")),
column(4,align="center",
plotOutput("prior")
),
column(4,align="center",
plotOutput("likelihood")
),
column(4,align="center",
plotOutput("posterior")
),
fluidRow(
column(12,align="center",
uiOutput('formular'))
),
column(12, align="center",
br(),
br(),
c("This app was brought to you by TquanT 2016 - Executive Producers: Felix Wolff, Eline Van Geert, Javier de la Fuente Carillo, Jenna Kelly, Gabriela Hofer & Jonas Potthoff")
)
)
)),
### third tab
tabPanel("Theory Behind",
fluidRow(column(12,align="center","Source: http://courses.ncssm.edu/math/Talks/PDFS/BullardNCTM2001.pdf")),
fluidRow(column(12,align="center",imageOutput("theory")))
)
)
)
)
)