From 29f885a979f402853839e30aa3bb32dea2cbb543 Mon Sep 17 00:00:00 2001 From: Louis Sirugue Date: Fri, 28 Jan 2022 10:06:25 +0100 Subject: [PATCH] Fix solution Instead of using the parameters of the DGP to turn the squared errors green, use the parameters of the sample fit. --- inst/shinys/reg_simple/app.R | 228 ++++++++++++++++++----------------- 1 file changed, 115 insertions(+), 113 deletions(-) diff --git a/inst/shinys/reg_simple/app.R b/inst/shinys/reg_simple/app.R index 34b8d31..12ca152 100644 --- a/inst/shinys/reg_simple/app.R +++ b/inst/shinys/reg_simple/app.R @@ -1,113 +1,115 @@ -library(dplyr) -library(shiny) - - -set.seed(19) - -# Generate Random Data -x <- rnorm(n = 20, mean = 2, sd = 4) - -a_true <- -2 -b_true <- 1.5 -y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 1) - -ui <- fluidPage( - br(), - br(), - sidebarPanel(sliderInput("i_simple", "Intercept", min = -4, - max = 4, step = .1, value = .5), - sliderInput("s_simple", "Slope", min = -2, - max = 2, step = .1, value = -1), - br(), - br(), - - textOutput("userguess_simple")), - - mainPanel( - plotOutput("regPlot_simple")), - textOutput("MSE2")) - - -server <- function(input,output){ - output$userguess_simple <- renderText({ - - a <- input$i_simple - b <- input$s_simple - paste0("Your guess:\n y = ", a, " + ", b, "x") - - }) - - output$regPlot_simple <- renderPlot({ - - # set.seed(19) - # - # # Generate Random Data - # x <- rnorm(n = 20, mean = 2, sd = 4) - # - # a_true <- -2 - # b_true <- 1.5 - # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 1) - # True DGP: y = -2 + 1.5 * x + u - - - - # a = intercept, b = slope (user input) - a <- input$i_simple - b <- input$s_simple - - - # plot - expr <- function(x) a + b*x - errors <- (a + b*x) - y - - plot(x, y, type = "p", pch = 21, col = "blue", bg = "royalblue", asp=1, - xlim = c(min(c(x, y))-1, max(c(x, y))+1), - ylim = c(min(c(x, y))-1, max(c(x, y))+1), - main = "Fit the data!", frame.plot = FALSE, - cex = 1.2) - - if ((a == a_true) && (b == b_true)){ - curve(expr = expr, from = min(x)-10, to = max(x)+10, add = TRUE, col = "black") - segments(x0 = x, y0 = y, x1 = x, y1 = (y + errors), col = "green") - rect(xleft = x, ybottom = y, - xright = x + abs(errors), ytop = y + errors, density = -1, - col = rgb(red = 0, green = 1, blue = 0, alpha = 0.05), border = NA) - } else { - curve(expr =expr , from = min(x)-10, to = max(x)+10, add = TRUE, col = "black") - segments(x0 = x, y0 = y, x1 = x, y1 = (y + errors), col = "red") - rect(xleft = x, ybottom = y, - xright = x + abs(errors), ytop = y + errors, density = -1, - col = rgb(red = 1, green = 0, blue = 0, alpha = 0.05), border = NA) - } - - }) - - output$MSE2 <- renderText({ - # set.seed(19) - # - # # Generate Random Data - # x <- rnorm(n = 20, mean = 2, sd = 4) - # - # a_true <- -2 - # b_true <- 1.5 - # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 1) - # True DGP: y = -2 + 1.5 * x + u - - - - # a = intercept, b = slope (user input) - a <- input$i_simple - b <- input$s_simple - - - # plot - expr <- function(x) a + b*x - errors <- (a + b*x) - y - - paste0("Total Sum of Squared Errors = ", round(sum(errors^2),2)) - - }) - -} - -shinyApp(ui = ui, server = server) +library(dplyr) +library(shiny) + + +set.seed(8) + +# Generate Random Data +x <- rnorm(n = 20, mean = 2, sd = 4) + +a_true <- -2 +b_true <- 1.5 +y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 1) +a_solution <- round(summary(lm(y ~ x))$coefficients[1, 1], 1) +b_solution <- round(summary(lm(y ~ x))$coefficients[2, 1], 1) + +ui <- fluidPage( + br(), + br(), + sidebarPanel(sliderInput("i_simple", "Intercept", min = -4, + max = 4, step = .1, value = .5), + sliderInput("s_simple", "Slope", min = -2, + max = 2, step = .1, value = -1), + br(), + br(), + + textOutput("userguess_simple")), + + mainPanel( + plotOutput("regPlot_simple")), + textOutput("MSE2")) + + +server <- function(input,output){ + output$userguess_simple <- renderText({ + + a <- input$i_simple + b <- input$s_simple + paste0("Your guess:\n y = ", a, " + ", b, "x") + + }) + + output$regPlot_simple <- renderPlot({ + + # set.seed(19) + # + # # Generate Random Data + # x <- rnorm(n = 20, mean = 2, sd = 4) + # + # a_true <- -2 + # b_true <- 1.5 + # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 1) + # True DGP: y = -2 + 1.5 * x + u + + + + # a = intercept, b = slope (user input) + a <- input$i_simple + b <- input$s_simple + + + # plot + expr <- function(x) a + b*x + errors <- (a + b*x) - y + + plot(x, y, type = "p", pch = 21, col = "blue", bg = "royalblue", asp=1, + xlim = c(min(c(x, y))-1, max(c(x, y))+1), + ylim = c(min(c(x, y))-1, max(c(x, y))+1), + main = "Fit the data!", frame.plot = FALSE, + cex = 1.2) + + if ((a == a_solution) && (b == b_solution)){ + curve(expr = expr, from = min(x)-10, to = max(x)+10, add = TRUE, col = "black") + segments(x0 = x, y0 = y, x1 = x, y1 = (y + errors), col = "green") + rect(xleft = x, ybottom = y, + xright = x + abs(errors), ytop = y + errors, density = -1, + col = rgb(red = 0, green = 1, blue = 0, alpha = 0.05), border = NA) + } else { + curve(expr =expr , from = min(x)-10, to = max(x)+10, add = TRUE, col = "black") + segments(x0 = x, y0 = y, x1 = x, y1 = (y + errors), col = "red") + rect(xleft = x, ybottom = y, + xright = x + abs(errors), ytop = y + errors, density = -1, + col = rgb(red = 1, green = 0, blue = 0, alpha = 0.05), border = NA) + } + + }) + + output$MSE2 <- renderText({ + # set.seed(19) + # + # # Generate Random Data + # x <- rnorm(n = 20, mean = 2, sd = 4) + # + # a_true <- -2 + # b_true <- 1.5 + # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 1) + # True DGP: y = -2 + 1.5 * x + u + + + + # a = intercept, b = slope (user input) + a <- input$i_simple + b <- input$s_simple + + + # plot + expr <- function(x) a + b*x + errors <- (a + b*x) - y + + paste0("Total Sum of Squared Errors = ", round(sum(errors^2),2)) + + }) + +} + +shinyApp(ui = ui, server = server) \ No newline at end of file