diff --git a/inst/shinys/reg_standardized/app.R b/inst/shinys/reg_standardized/app.R index c016035..baaac8e 100644 --- a/inst/shinys/reg_standardized/app.R +++ b/inst/shinys/reg_standardized/app.R @@ -1,113 +1,115 @@ -library(shiny) - -set.seed(19) -n = 20 -x = 2*runif(n) -b0 = 2.5 -b1 = 0.8 -y = b0 + b1*x + rnorm(n) - -ui <- fluidPage( - br(), - br(), - sidebarPanel(sliderInput("i_std", "Intercept", min = -2, - max = 4, step = .5, value = 2), - sliderInput("s_std", "Slope", min = -1, - max = 2, step = .1, value = -.2), - - checkboxInput("std", "Standardize X and Y!", value = FALSE), - - br(), - br(), - - verbatimTextOutput("userguess_std")), - - mainPanel( - plotOutput("regPlot_std"))) - -server <- function(input,output){ - output$userguess_std <- renderText({ - - if (input$std == TRUE){ - x <- (x-mean(x))/sd(x) - y <- (y-mean(y))/sd(y) - } - - # a = intercept, b = slope (user input) - a <- input$i_std - b <- input$s_std - - # plot - expr <- function(x) a + b*x - errors <- (a + b*x) - y - - if (input$std == FALSE){ - a <- input$i_std - b <- input$s_std - paste0("Your guess:\n y = ", a, " + ", b, "x\n SSR: ", sum(errors^2) ) - } else { - a <- input$i_std - b <- input$s_std - paste0("Your guess:\n [y / SD(y)] = ", a, " + ", b, "[x / SD(x)]\n SSR: ", sum(errors^2)) - } - - - }) - - output$regPlot_std <- renderPlot({ - - if (input$std == TRUE){ - x <- (x-mean(x))/sd(x) - y <- (y-mean(y))/sd(y) - } - - # a = intercept, b = slope (user input) - a <- input$i_std - b <- input$s_std - - # 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, - ylim = c(min(y)-2, max(y)+2), - # ylim = c(-5, 10), - main = "Fit the data!", frame.plot = FALSE, - cex = 1.2) - legend("topleft", legend = paste0("r (correlation coefficient) = ", round(cor(x, y), 2))) - - b_best <- b1 - a_best <- b0 - - offset = 4 - - - if (input$std == TRUE){ - b0new = 0 - b1new = round(cor(x, y), 1) - } else { - b0new = b0 - b1new = b1 - } - - - # if (near(a, b0, tol = .01) && near(b, b1, tol = .01)){ - if (a==b0new && dplyr::near(b, b1new, tol = .01)){ - - curve(expr = expr, from = min(x)-offset, to = max(x)+offset, 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)-offset, to = max(x)+offset, 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) - } - - }) -} - -shinyApp(ui = ui, server = server) +library(shiny) + +set.seed(19) +n = 20 +x = 2*runif(n) +b0 = 2.5 +b1 = 0.8 +y = b0 + b1*x + rnorm(n) +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_std", "Intercept", min = -2, + max = 4, step = .1, value = 2), + sliderInput("s_std", "Slope", min = -1, + max = 2, step = .1, value = -.2), + + checkboxInput("std", "Standardize X and Y!", value = FALSE), + + br(), + br(), + + verbatimTextOutput("userguess_std")), + + mainPanel( + plotOutput("regPlot_std"))) + +server <- function(input,output){ + output$userguess_std <- renderText({ + + if (input$std == TRUE){ + x <- (x-mean(x))/sd(x) + y <- (y-mean(y))/sd(y) + } + + # a = intercept, b = slope (user input) + a <- input$i_std + b <- input$s_std + + # plot + expr <- function(x) a + b*x + errors <- (a + b*x) - y + + if (input$std == FALSE){ + a <- input$i_std + b <- input$s_std + paste0("Your guess:\n y = ", a, " + ", b, "x\n SSR: ", sum(errors^2) ) + } else { + a <- input$i_std + b <- input$s_std + paste0("Your guess:\n [y / SD(y)] = ", a, " + ", b, "[x / SD(x)]\n SSR: ", sum(errors^2)) + } + + + }) + + output$regPlot_std <- renderPlot({ + + if (input$std == TRUE){ + x <- (x-mean(x))/sd(x) + y <- (y-mean(y))/sd(y) + } + + # a = intercept, b = slope (user input) + a <- input$i_std + b <- input$s_std + + # 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, + ylim = c(min(y)-2, max(y)+2), + # ylim = c(-5, 10), + main = "Fit the data!", frame.plot = FALSE, + cex = 1.2) + legend("topleft", legend = paste0("r (correlation coefficient) = ", round(cor(x, y), 2))) + + b_best <- b1 + a_best <- b0 + + offset = 4 + + + if (input$std == TRUE){ + b0new = 0 + b1new = round(cor(x, y), 1) + } else { + b0new = a_solution + b1new = b_solution + } + + + # if (near(a, b0, tol = .01) && near(b, b1, tol = .01)){ + if (a==b0new && b==b1new){ + + curve(expr = expr, from = min(x)-offset, to = max(x)+offset, 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)-offset, to = max(x)+offset, 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) + } + + }) +} + +shinyApp(ui = ui, server = server) \ No newline at end of file