From b1b0b7b40ba9199d72c63b2deffd8446e8b8275f Mon Sep 17 00:00:00 2001 From: Louis Sirugue Date: Fri, 28 Jan 2022 10:09:20 +0100 Subject: [PATCH] Fix solution Instead of using the parameters of the DGP to turn the arrows green, use the parameters of the sample fit. --- inst/shinys/reg_simple_arrows/app.R | 222 ++++++++++++++-------------- 1 file changed, 112 insertions(+), 110 deletions(-) diff --git a/inst/shinys/reg_simple_arrows/app.R b/inst/shinys/reg_simple_arrows/app.R index 7f1e470..0655eda 100644 --- a/inst/shinys/reg_simple_arrows/app.R +++ b/inst/shinys/reg_simple_arrows/app.R @@ -1,110 +1,112 @@ -library(dplyr) -library(shiny) - - -set.seed(19) - -# Generate Random Data -x <- rnorm(n = 20, mean = 2, sd = 4) -b_true <- -0.5 -a_true <- 1.5 -y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 2) - -ui <- fluidPage( - br(), - br(), - sidebarPanel(sliderInput("i_simple", "Intercept", min = -4, - max = 4, step = .05, value = .5), - sliderInput("s_simple", "Slope", min = -2, - max = 2, step = .05, value = 0.1), - br(), - br(), - - textOutput("userguess_simple")), - - mainPanel( - plotOutput("regPlot_simple"), - textOutput("MSE"))) - - -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) - # - # b_true <- -0.5 - # a_true <- 1.5 - # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 2) - # # True DGP: y = 1.5 -2 * x + u - - # get data from disk - # load(file = system.file(package = "ScPoEconometrics","datasets","simple_arrows.RData")) - - # 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))-1, max(c(x))+1), - # ylim = c(min(c(y))-1, max(c(y))+1), - main = "Find the Best Line! (Arrows turn Green!)", 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") - arrows(x, expr(x), - x, y, - col = 'green', lwd = 1, lty = 1, length = 0.1, angle = 20) - } else { - curve(expr =expr , from = min(x)-10, to = max(x)+10, add = TRUE, col = "black") - arrows(x, expr(x), - x, y, - col = 'red', lwd = 1, lty = 1, length = 0.1, angle = 20) - } - }) - - output$MSE <- renderText({ - # set.seed(19) - # # Generate Random Data - # x <- rnorm(n = 20, mean = 2, sd = 4) - # b_true <- -0.5 - # a_true <- 1.5 - # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 2) - # # True DGP: y = -2 + 1.5 * x + u - - # get data from disk - # load(file = system.file(package = "ScPoEconometrics","datasets","simple_arrows.RData")) - - - # 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 Errors = ", round(sum(errors),2)," || Total Sum of absolute Errors = ", round(sum(abs(errors)),2)) - - }) -} - - -shinyApp(ui = ui, server = server) +library(dplyr) +library(shiny) + + +set.seed(8) + +# Generate Random Data +x <- rnorm(n = 20, mean = 2, sd = 4) +b_true <- -0.5 +a_true <- 1.5 +y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 2) +a_solution <- round(2 * summary(lm(y ~ x))$coefficients[1, 1], 1) / 2 +b_solution <- round(2 * summary(lm(y ~ x))$coefficients[2, 1], 1) / 2 + +ui <- fluidPage( + br(), + br(), + sidebarPanel(sliderInput("i_simple", "Intercept", min = -4, + max = 4, step = .05, value = .5), + sliderInput("s_simple", "Slope", min = -2, + max = 2, step = .05, value = 0.1), + br(), + br(), + + textOutput("userguess_simple")), + + mainPanel( + plotOutput("regPlot_simple"), + textOutput("MSE"))) + + +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) + # + # b_true <- -0.5 + # a_true <- 1.5 + # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 2) + # # True DGP: y = 1.5 -2 * x + u + + # get data from disk + # load(file = system.file(package = "ScPoEconometrics","datasets","simple_arrows.RData")) + + # 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))-1, max(c(x))+1), + # ylim = c(min(c(y))-1, max(c(y))+1), + main = "Find the Best Line! (Arrows turn Green!)", 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") + arrows(x, expr(x), + x, y, + col = 'green', lwd = 1, lty = 1, length = 0.1, angle = 20) + } else { + curve(expr =expr , from = min(x)-10, to = max(x)+10, add = TRUE, col = "black") + arrows(x, expr(x), + x, y, + col = 'red', lwd = 1, lty = 1, length = 0.1, angle = 20) + } + }) + + output$MSE <- renderText({ + # set.seed(19) + # # Generate Random Data + # x <- rnorm(n = 20, mean = 2, sd = 4) + # b_true <- -0.5 + # a_true <- 1.5 + # y <- a_true + b_true*x + rnorm(n = 20, mean = 0, sd = 2) + # # True DGP: y = -2 + 1.5 * x + u + + # get data from disk + # load(file = system.file(package = "ScPoEconometrics","datasets","simple_arrows.RData")) + + + # 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 Errors = ", round(sum(errors),2)," || Total Sum of absolute Errors = ", round(sum(abs(errors)),2)) + + }) +} + + +shinyApp(ui = ui, server = server) \ No newline at end of file