Shiny apps for interactively demonstrating linear regression for Galton's height data. prof-app.R is for the instructor to show guessed fits, and line of best fit. student-app.R is to share with students interactively. Data is shared between apps via a mongodb database

prof-app.R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(HistData)
library(ggplot2)
library(dplyr)
library(shinyjs)
library(mgcv)
library(mongolite)

options(mongodb = list(
    "host" = "INSERT mongodb SERVER ADDRESS HERE",
    "username" = "INSERT mongodb USERNAME HERE",
    "password" = "INSERT mongodb PASSWORD HERE"
))

#Each shiny app should have its own collection name, and 
#they should match between the student and professor apps. 
#You can use one database for different apps
databaseName <- "name-of-mongodb-database"
collectionName <- "LinearRegressionGuess"

loadData <- function() {
    # Connect to the database
    db <- mongo(collection = collectionName,
                url = sprintf(
                    "mongodb+srv://%s:%s@%s/%s",
                    options()$mongodb$username,
                    options()$mongodb$password,
                    options()$mongodb$host,
                    databaseName
                ),
                options = ssl_options(weak_cert_validation = TRUE))
    # Read all the entries
    data <- db$find()
    data
}



# Define UI for application that draws a histogram
ui <- fluidPage(
    useShinyjs(),
    # Application title
    titlePanel("Linear regression"),
    
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            actionButton("load", "load guesses"),
            actionButton("show_guess", "Show guesses"),
            actionButton("show_fit", "Show regression line"),
            actionButton("show_error", "show 95% CI"),
            actionButton("clear", "Clear display")
        ),
        
        # Show a plot of the generated distribution
        mainPanel(
            plotOutput("regPlot"),
            plotOutput("coefPlot")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    
    base_reg_plot <- ggplot(data = filter(GaltonFamilies,gender=="female"), 
                                    aes(x = mother,y=childHeight))+
        geom_point()+
        scale_x_continuous("Mother's height (in)", limits = c(55,71))+
        scale_y_continuous("Daugher's height (in)",limits = c(55,71))+
        coord_equal()+
        theme_bw(base_size = 20)+
        theme(panel.grid = element_blank())
    
    base_coef_plot <- ggplot(data = data.frame(intercept = 200, slope = 1), aes( x = slope,y= intercept,)) +
        scale_y_continuous("Intercept (in)", limits = c(30,90))+
        scale_x_continuous("slope (in/in)",limits = c(-1,1))+
        theme_bw(base_size = 20)+
        coord_fixed(ratio = 1/30)+
        theme(panel.grid = element_blank())
    
    plots <- reactiveValues(regPlot = base_reg_plot, coefPlot = base_coef_plot,
                            dat = data.frame(intercept = 200, slope = 1))
    
    output$regPlot <- renderPlot(plots$regPlot)
    output$coefPlot <- renderPlot(plots$coefPlot)
        
        
        
    
    observeEvent(input$load, {
        dat <- loadData()
        plots$dat <- dat
    })
    
    observeEvent(input$clear, {
        plots$regPlot <- base_reg_plot
        plots$coefPlot <- base_coef_plot
    })
    
    observeEvent(input$show_fit, {
        model_fit <- gam(childHeight~mother, data=filter(GaltonFamilies,gender=="female"))
        intercept_true <- coef(model_fit)[[1]]
        slope_true <- coef(model_fit)[[2]]
        
        plots$regPlot <- plots$regPlot +
            geom_abline(data = plots$dat, 
                        slope=slope_true, 
                        intercept = intercept_true, size=2, col="red")
        
        plots$coefPlot <- plots$coefPlot +
            geom_point(x = slope_true, y= intercept_true, size=5, col="red")

    })
    
    
    observeEvent(input$show_error, {
        #creating new data to calculate confidence intervals
        se_data <- data.frame(mother= seq(55, 71, length =100),
                              childHeight = 0)
        
        model_fit <- lm(childHeight~mother, data=filter(GaltonFamilies,gender=="female"))
        model_error <- predict(model_fit,newdata = se_data, se.fit = TRUE)
        se_data$lower <- as.numeric(model_error$fit - 1.96*model_error$se.fit)
        se_data$upper <- as.numeric(model_error$fit + 1.96*model_error$se.fit)
        plots$regPlot <- plots$regPlot +
            geom_ribbon(data =se_data, 
                        aes(ymin = lower,ymax= upper),
                        fill="red",alpha=0.1)
        
    })
    
    observeEvent(input$show_guess, {
        plots$regPlot <- plots$regPlot +
            geom_abline(data = plots$dat, aes(slope=slope, intercept = intercept),col='blue')
        
        plots$coefPlot <- plots$coefPlot +
            geom_point(data = plots$dat,size=3,col="blue")
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

student-app.R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(HistData)
library(ggplot2)
library(dplyr)
library(shinyjs)

library(mongolite)


#Each shiny app should have its own collection name, and 
#they should match between the student and professor apps. 
#You can use one database for different apps
options(mongodb = list(
    "host" = "INSERT mongodb SERVER ADDRESS HERE",
    "username" = "INSERT mongodb USERNAME HERE",
    "password" = "INSERT mongodb PASSWORD HERE"
))

#Each shiny app should have its own collection name, and 
#they should match between the student and professor apps. 
#You can use one database for different apps
databaseName <- "name-of-mongodb-database"
collectionName <- "LinearRegressionGuess"

saveData <- function(data) {
    # Connect to the database
    db <- mongo(collection = collectionName,
                url = sprintf(
                    "mongodb+srv://%s:%s@%s/%s",
                    options()$mongodb$username,
                    options()$mongodb$password,
                    options()$mongodb$host,
                    databaseName
                ),
                options = ssl_options(weak_cert_validation = TRUE))
    # Insert the data into the mongo collection as a data.frame
    db$insert(data)
}

dat <- filter(GaltonFamilies,gender=="female")


# Define UI for application that draws a histogram
ui <- fluidPage(
    useShinyjs(),
    # Application title
    titlePanel("Linear regression"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("intercept",
                        "Intercept:",
                        min = 30,
                        max = 90,
                        value = 60,
                        step = 1),
            sliderInput("slope",
                        "Slope:",
                        min = -1,
                        max = 1,
                        value = 0,
                        step = 0.01),
            actionButton("reset", "reset sliders"),
            actionButton("submit", "Submit guess")
        ),

        # Show a plot of the generated distribution
        mainPanel(
           plotOutput("regPlot")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    output$regPlot <- renderPlot({
        
        par(pty="s")
        plot(childHeight~mother, 
             data= dat,
             xlab = "Mother's height (in)",
             xlim = c(55,71),
             ylab = "Daughter's height (in)",
             ylim = c(55,71),
             col = "firebrick",
             pch = 19)
        abline(a = input$intercept, b = input$slope, lwd=2)
    

    })
    
    observeEvent(input$submit, {
        dat <- data.frame(intercept = input$intercept,
                          slope = input$slope)
        saveData(dat)
        toggleState("submit")
    })
    
    observeEvent(input$reset, {
        reset("intercept")
        reset("slope")
    })
}

# Run the application 
shinyApp(ui = ui, server = server)