Skip to content

Instantly share code, notes, and snippets.

@calpolystat

calpolystat/#Corr_Reg_Game.txt

Last active January 6, 2023 14:34
Show Gist options
  • Save calpolystat/8e898319968d31b27310 to your computer and use it in GitHub Desktop.
Save calpolystat/8e898319968d31b27310 to your computer and use it in GitHub Desktop.
Download ZIP
Correlation and Regression Game: Shiny app at http://www.statistics.calpoly.edu/shiny
Raw
#Corr_Reg_Game.txt
Correlation and Regression Game Shiny App
Base R code created by Irvin Alcaraz
Shiny app files created by Irvin Alcaraz
Cal Poly Statistics Dept Shiny Series
http://statistics.calpoly.edu/shiny
Raw
DESCRIPTION
Title: Correlation and Regression Game
Author: Irvin Alcaraz
AuthorUrl: https://www.linkedin.com/in/irvinalcaraz
License: MIT
DisplayMode: Normal
Tags: Correlation, regression
Type: Shiny
Raw
LICENSE
The MIT License (MIT)
Copyright (c) 2015 Irvin Alcaraz
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
Raw
server.R
library(shiny)
library(shinyBS)
library(ggplot2)
library(magrittr)
library(ggvis)
###A function to create random data with a certain correlation
create = function(n,rho){
x1 = rnorm(n,sample(c(0,1,3),1),sample(c(1,2),1))
x2 = rnorm(n,sample(c(2,4,6),1),sample(c(1,2,3),1))
xctr = scale(cbind(x1,x2),center=TRUE,scale=FALSE)
Q = qr.Q(qr(xctr[ , 1, drop=FALSE]))
P = tcrossprod(Q)
x2o = (diag(n)-P) %*% xctr[ , 2]
xc2 = cbind(xctr[ , 1], x2o)
Y = xc2 %*% diag(1/sqrt(colSums(xc2^2)))
if (rho==1){
x3 = Y[ , 1]
}else{
x3 = Y[ , 2] + (1 / tan(acos(rho))) * Y[ , 1]
}
return(list(x1,sample(c(1,2,3,4),1)+x3))
}
###Shiny Server Code###
shinyServer(function(input,output,session){
###Code for correlation tab###
correlated = reactive({
input$newdataset
create(isolate(input$nobs),sample(seq(-1,1,by=.1),size=1))
})
checker <- reactiveValues(cheat = "no")
observe({
if(input$newdataset != 0){
closeAlert(session,alertId="a")
checker$cheat <- "no"
}
})
observe({
input$cheat
if(input$cheat!=0){
checker$cheat <- "yes"
}
})
output$showcorr = renderUI({
checker$cheat
isolate({
if (checker$cheat == "no"){
paste("")
}else{
dataCorr = data.frame(exp=unlist(correlated()[[1]]),res=unlist(correlated()[[2]]))
withMathJax()
paste0("The correct answer is ",round(cor(dataCorr$exp,dataCorr$res),1),".")
}
})
})
# output$correlationPlot <- renderPlot({
observe({
# corr.data = data.frame(exp=unlist(correlated()[[1]]),res=unlist(correlated()[[2]]))
# ggplot(data=corr.data)+geom_point(aes(x=exp,y=res))
exp=unlist(correlated()[[1]])
res=unlist(correlated()[[2]])
contrib=((exp-mean(exp))/sd(exp))*((res-mean(res))/sd(res))/length(res)
corr.data = data.frame(exp=exp,res=res,contrib=contrib)
corr.data %>%
ggvis(~exp, ~res,key:=~contrib) %>%
layer_points() %>%
add_tooltip(function(df){
paste0("Correlation contribution:",br(),round(df$contrib,5),br(),"Coordinates (Exp,Res):",br(),
"(",round(df$exp,3),",",round(df$res,3),")")
})%>%
bind_shiny("correlationPlot")
})
observe({
input$answer
isolate({
corr.data = data.frame(exp=unlist(correlated()[[1]]),res=unlist(correlated()[[2]]))
if (input$answer != 0){
if (isolate(input$rho) == round(cor(corr.data$exp,corr.data$res),1)){
createAlert(session,
inputId = "correct",
title = "Correct!",
message = "You have guessed the correct correlation, click 'New Data' to play again",
type = "success",
dismiss = TRUE,
block = FALSE,
append = FALSE,
alertId = "a"
)
}else{
createAlert(session,
inputId = "correct",
title = paste(input$rho," is incorrect..."),
message = "Change your correlation and click 'Submit' to try again.",
type = "danger",
dismiss = TRUE,
block = FALSE,
append = FALSE,
alertId = "a"
)
}
}
})
})
###CODE FOR REGRESSION TAB###
corr.dat = reactive({
input$getdata
create(isolate(input$obs),isolate(input$corr))
})
check <- reactiveValues(hit = "getdata")
observe({
input$getdata
check$hit <- "getdata"
check$showit <- "no"
})
observe({
input$go
check$hit <- "go"
check$showit <- "no"
})
observe({
input$showit
if(input$showit!=0){
check$showit <- "yes"
}
})
toplotornottoplot = reactive({
input$go
reg.data = data.frame(expl=unlist(corr.dat()[[1]]),resp=unlist(corr.dat()[[2]]))
model = lm(resp~expl,data=reg.data)
coefs = data.frame(a=input$b0,b=input$b1)
pred.fits = input$b0 + input$b1*reg.data$expl
seg.data = data.frame(x0=reg.data$expl,y0=reg.data$resp,x1=reg.data$expl,y1=pred.fits)
if(input$getdata==0 & input$go ==0){
p = ggplot()+geom_point(data=reg.data,aes(x=expl,y=resp))+xlim(0,NA)
}else{
if(check$hit == "getdata"){
p = ggplot()+geom_point(data=reg.data,aes(x=expl,y=resp))+xlim(0,NA)
closeAlert(session,alertId="a1")
}else{
p = ggplot()+geom_point(data=reg.data,aes(x=expl,y=resp))
p = p+geom_abline(data=coefs,aes(intercept=a,slope=b))
p = p+geom_segment(data=seg.data,aes(x=x0,y=y0,xend=x1,yend=y1),color='red')+xlim(0,NA)
}
}
list(p)
})
output$regressionPlot <- renderPlot({
reg.data = data.frame(expl=unlist(corr.dat()[[1]]),resp=unlist(corr.dat()[[2]]))
model = lm(resp~expl,data=reg.data)
coefs = data.frame(a=input$b0,b=input$b1)
pred.fits = input$b0 + input$b1*reg.data$expl
seg.data = data.frame(x0=reg.data$expl,y0=reg.data$resp,x1=reg.data$expl,y1=pred.fits)
toplotornottoplot()
})
#SSE stuff
# output$SSE = renderUI({
#
# input$go
# input$getdata
# isolate({
# if(input$go != 0){
# if(check$hit == "getdata"){
# h6(paste(""))
# }else{
# reg.data = data.frame(expl=unlist(corr.dat()[[1]]),resp=unlist(corr.dat()[[2]]))
# model = lm(resp~expl,data=reg.data)
# pred.fits = input$b0 + input$b1*reg.data$expl
# realsse = sum((model$resid)^2)
# predsse = sum((reg.data$resp-pred.fits)^2)
# # predsst = sum((reg.data$resp-mean(reg.data$resp))^2)
# # realRsquare = summary(model)$r.squared
# # predRsquare = 1-(predsse/predsst)
# # if(input$sseOrRsq == "Rsq"){
# # h6(paste("The current R-sq from your inputs is",round(predRsquare,3),". The R-sq for the correct model is ",round(realRsquare,3),". Yours will be bit off since your are using rounded values."),align="center")
# # }else{
# h6(paste("The current SSE from your inputs is",round(predsse,3),". The SSE for the correct model is ",round(realsse,3),". Yours will be bit off since your are using rounded values."),align="center")
# # }
#
# }
# }
# })
# })
output$realline = renderUI({
check$showit
isolate({
if (check$showit == "no"){
paste("")
}else{
reg.data = data.frame(expl=unlist(corr.dat()[[1]]),resp=unlist(corr.dat()[[2]]))
model = lm(resp~expl,data=reg.data)
withMathJax()
paste0("The correct answer is b0=",round(model[[1]][1]),", and b1=",round(model[[1]][2],1),".")
}
})
})
observe({
input$go
isolate({
reg.data = data.frame(expl=unlist(corr.dat()[[1]]),resp=unlist(corr.dat()[[2]]))
model = lm(resp~expl,data=reg.data)
coefs = data.frame(a=coef(model)[1],b=coef(model)[2])
if(input$go != 0){
if(round(model[[1]][1])==input$b0 && round(model[[1]][2],1)==input$b1){
createAlert(session,
inputId = "success",
title = "Success!",
message = paste("Your inputs for the model were approximately correct!",br(),
"The real values were:",br(),
"Intercept = ",round(model[[1]][1],3)," Slope = ",round(model[[1]][2],3),br(),
"Click 'New Data' to play again."),
type = "success",
dismiss = TRUE,
block = FALSE,
append = FALSE,
alertId = "a1")
}else{
createAlert(session,
inputId = "success",
title = "Incorrect.",
message = paste("Your inputs, Intercept=",input$b0," and Slope=",input$b1,
" for the model were incorrect.",
" Change your inputs and hit 'Submit' to try again"),
type = "danger",
dismiss = TRUE,
block = FALSE,
append = FALSE,
alertId = "a1")
}
}
})
})
})
Raw
ui.R
# ------------------------------------------------
# App Title: Games of Correlation and Regression
# Author: Irvin Alcaraz
# ------------------------------------------------
library(shiny)
library(shinyBS)
library(ggplot2)
library(ggvis)
library(magrittr)
shinyUI(navbarPage("Data games",
tabPanel("Correlation Game",
withMathJax(),
p("Correlation is a statistical measurement used to quantify the strength and direction of
a linear relationship.",br(),
"\\(\\bullet\\) This value is unitless, and thus is not affected by location and scale of the variables,
and bound between -1 and 1.",br(),
"\\(\\bullet\\) It is typically denoted by \\(r\\) or by \\(\\rho\\).",br(),
"\\(\\bullet\\) A correlation of -1 would mean that the data have a perfectly negative relationship, which would appear in the scatterplot as
a perfect line with a negative slope.",br(),
"\\(\\bullet\\) Similarly, a correlation of 1 would mean that the data are perfectly positively correlated, which would appear in the scatterplot as a perfect line
with a positive slope.",br(),
"\\(\\bullet\\) If data have no relationship, they would have a correlation of 0, and would appear as a random
scatter of points in the scatterplot.",br(),
"\\(\\bullet\\) The correlation presented in this application is generated using the Pearson
Correlation Coefficient method.",br(),
"\\(\\bullet\\) The formula used to calculate this is value is \\({1\\over n-1}\\sum_{i=1}^n{(x_i-\\bar{x})(y_i-\\bar{y})\\over s_xs_y}\\)"),
sidebarLayout(
sidebarPanel(
helpText("Number of Observations"),
selectInput("nobs","",c(10,100,1000),100),
actionButton("newdataset","New Data"),
HTML("<hr style='height: 2px; color: #F3F3F3; background-color: #F3F3F3; border: none;'>"),
helpText('Guess the Correlation, \\(\\rho\\)'),
sliderInput("rho","",min=-1,max=1,value=0,step=.1),
actionButton("answer","Submit"),
actionButton("cheat","Show Answer"),
div("Shiny app by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Base R code by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Shiny source files:",
a(href="https://gist.github.com/calpolystat/8e898319968d31b27310",
target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
"Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")
),
mainPanel(
bsAlert("correct"),
# plotOutput("correlationPlot")
ggvisOutput("correlationPlot"),
uiOutput("showcorr")
)
)),
tabPanel("Regression Game",
sidebarLayout(
sidebarPanel(
tags$head(tags$link(rel = "icon", type = "image/x-icon",href = "https://webresource.its.calpoly.edu/cpwebtemplate/5.0.1/common/images_html/favicon.ico")),
withMathJax(),
selectInput("obs","Number of Observations",c(10,100,1000),100),
helpText('Correlation, \\(\\rho\\)'),
sliderInput("corr","",min=-1,max=1,value=0,step=.1),
actionButton("getdata","New Data"),
HTML("<hr style='height: 2px; color: #F3F3F3; background-color: #F3F3F3; border: none;'>"),
HTML("<hr style='height: 2px; color: #F3F3F3; background-color: #F3F3F3; border: none;'>"),
helpText('The intercept, \\(\\hat{\\beta_0}\\) (round to the nearest whole number)'),
numericInput("b0","",value=0),
helpText('The slope, \\(\\hat{\\beta_1}\\) (round to the nearest tenth)'),
numericInput("b1","",value=0),
##helpText("Assessment method"),
##radioButtons("sseOrRsq","",choices=c("Maximize \\(R^2\\)"="Rsq","Minimize \\(SSE\\)"="sse"),selected="Rsq"),
HTML("<hr style='height: 2px; color: #F3F3F3; background-color: #F3F3F3; border: none;'>"),
actionButton("go","Submit"),
actionButton("showit","Show Answer"),
div("Shiny app by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Base R code by",
a(href="https://www.linkedin.com/in/irvinalcaraz",target="_blank",
"Irvin Alcaraz"),align="right", style = "font-size: 8pt"),
div("Shiny source files:",
a(href="https://gist.github.com/calpolystat/8e898319968d31b27310",
target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
"Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")
),
mainPanel(
p("Often, we wish to predict the value of some variable, called the response, based on
the value of another linearly related variable, called the explanatory. This idea is called linear regression.
We will deal with simple linear regression, which makes use of a single response and predictor.
In order to estimate the response variable based on the explanatory we will fit a line,
also called a model, to the data. This line is called the least squares regression line, and it attempts to
minimize the deviations of the points from the line, or the residuals.",br(),
"\\(\\bullet\\) The population regression line is: \\(Y=\\beta_o+\\beta_1X\\)",br(),
"\\(\\bullet\\) When given a random sample of data, we estimate this by: \\(\\hat{y}=b_0+b_1x\\)",br(),
"\\(\\bullet\\)To assess, whether or not the estimated line is the best line we can look at two values.",br(),
"\\(\\qquad\\circ\\) We can minimize a value called the sum of squared errors, denoted \\(SSE=\\sum_{i=1}^n(y_i-\\hat{y_i})^2\\).",br(),
"\\(\\qquad\\circ\\) Equivalently, we can maximize a value called the coefficient of determination. We denote this value as
\\(R^2=1-{SSE \\over SST}\\), where \\(SST=\\sum_{i=1}^n(y_i-\\bar{y})^2\\)"),
bsAlert("success"),
uiOutput("SSE"),
plotOutput("regressionPlot"),
uiOutput("realline")
)
))
))
@dhavaldodia
Copy link

errors in both server.R and ui.R :
Warning: Error in tag: argument is missing, with no default
59: tag
58: tags$form
54: sidebarPanel

ERROR: argument is missing, with no default

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment