Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Shiny app for making polynomial lines from hand drawings, to appear in giorasimchoni.com
library(shiny)
library(glmnet)
res_list <- list()
get_poly_coef <- function(x, y, max_degree = 5) {
if (length(x) < 20) {
warning('x length less than 20')
}
mm <- model.matrix(~ poly(x, degree = max_degree, raw = TRUE))[, -1]
cvfit <- cv.glmnet(mm, y)
c(as.matrix(coef(cvfit, s = "lambda.min")))
}
polynomize <- function(x, y, max_degree = 5) {
coef <- get_poly_coef(x, y, max_degree)
mm <- model.matrix(~ poly(x, degree = max_degree, raw = TRUE))
list(xy = cbind(x, mm %*% coef), formula_ = form_latex(coef, x), coef_ = coef)
}
nice <- function(n) {
if (abs(n) %% 1 < 0.001) {
sprintf("%.4f", abs(n))
} else if (abs(n) %% 1 < 0.01) {
sprintf("%.3f", abs(n))
} else if (abs(n) %% 1 < 0.1) {
sprintf("%.2f", abs(n))
} else {
sprintf("%.1f", abs(n))
}
}
signit <- function(n) ifelse(n > 0, "+", "-")
pass <- function(n, eps = 0.000001) abs(n - 0) >= eps
format_x_range <- function(x) {
paste0("x\\in(", nice(min(x)), ",\\space", nice(max(x)), ")")
}
form_latex <- function(coef, x) {
formula_ <- "$$"
if (length(coef) > 0 && pass(coef[1])) {
formula_ <- paste0(formula_, nice(coef[1]))
}
if (length(coef) > 1 && pass(coef[2])) {
formula_ <- paste0(formula_, signit(coef[2]), nice(coef[2]), "x")
}
if (length(coef) > 2) {
deg <- 2
for (co in coef[3:length(coef)]) {
if (pass(co)) {
formula_ <- paste0(formula_, signit(co), nice(co), "x^{", deg, "}")
deg <- deg + 1
}
}
}
paste0(formula_, ";\\space ", format_x_range(x), "$$")
}
ui <- fluidPage(
withMathJax(),
h4("Click on plot to start drawing, click again to pause"),
fluidRow(
column(2,
numericInput("xmin", "xmin", min = -10, max = 0, step = 1, value = 0)),
column(2,
numericInput("xmax", "xmax", min = 1, max = 100, step = 1, value = 10)),
column(2,
numericInput("ymin", "ymin", min = -10, max = 0, step = 1, value = 0)),
column(2,
numericInput("ymax", "ymax", min = 1, max = 100, step = 1, value = 10)),
column(2,
numericInput("max_degree", "max degree", min = 1, max = 20, step = 1, value = 5))
),
actionButton("reset", "reset"),
actionButton("jf", "just formulas"),
fluidRow(
column(6,
plotOutput("plot", width = "500px", height = "500px",
hover = hoverOpts(id = "hover", delay = 100, delayType = "throttle", clip = TRUE, nullOutside = TRUE),
click = "click")),
column(6, uiOutput("formulas"))
)
)
server <- function(input, output, session) {
vals <- reactiveValues(x = NULL, y = NULL,
xpred = NULL, ypred = NULL)
global_vals <- reactiveValues(x = NULL, y = NULL,
xpred = NULL, ypred = NULL)
formulas_text <- reactiveVal("")
draw <- reactiveVal(FALSE)
just_formulas <- reactiveVal(FALSE)
observeEvent(input$click, handlerExpr = {
temp <- draw(); draw(!temp)
if(!draw()) {
global_vals$x <- c(global_vals$x, NA)
global_vals$y <- c(global_vals$y, NA)
global_vals$xpred <- c(global_vals$xpred, NA)
global_vals$ypred <- c(global_vals$ypred, NA)
output$plot <- renderPlot({
plot(x = global_vals$x, y = global_vals$y, xlim = c(input$xmin, input$xmax),
ylim = c(input$ymin, input$ymax), ylab = "y", xlab = "x", type = "l", lwd = 5)
lines(global_vals$xpred, global_vals$ypred, type = "l", col = 2, lwd = 5)
if (!draw()) {
if (!is.null(vals$x) && !is.null(vals$y)) {
res <- polynomize(vals$x, vals$y, input$max_degree)
res_list <<- c(res_list, list(res))
global_vals$xpred <- c(global_vals$xpred, res$xy[, 1])
global_vals$ypred <- c(global_vals$ypred, res$xy[, 2])
formulas_text(paste(formulas_text(), res$formula_, sep = " "))
output$formulas <- renderUI({withMathJax(HTML(formulas_text()))})
vals$x <- NULL
vals$y <- NULL
}
}
})
}})
observeEvent(input$reset, handlerExpr = {
vals$x <- NULL; vals$y <- NULL
global_vals$x <- NULL; global_vals$y <- NULL
global_vals$x_backup <- NULL; global_vals$y_backup <- NULL
global_vals$xpred <- NULL; global_vals$ypred <- NULL
formulas_text("")
res_list <<- list()
})
observeEvent(input$jf, handlerExpr = {
if (!just_formulas()) {
vals$x <- NULL; vals$y <- NULL
global_vals$x_backup <- global_vals$x; global_vals$y_backup <- global_vals$y
global_vals$x <- NULL; global_vals$y <- NULL
just_formulas(TRUE)
updateActionButton(session, "jf", label = "show all")
} else {
global_vals$x <- global_vals$x_backup; global_vals$y <- global_vals$y_backup
just_formulas(FALSE)
updateActionButton(session, "jf", label = "just formulas")
}
})
observeEvent(input$hover, {
if (draw()) {
vals$x <- c(vals$x, input$hover$x)
vals$y <- c(vals$y, input$hover$y)
global_vals$x <- c(global_vals$x, input$hover$x)
global_vals$y <- c(global_vals$y, input$hover$y)
}})
output$plot <- renderPlot({
plot(x = global_vals$x, y = global_vals$y, xlim = c(input$xmin, input$xmax),
ylim = c(input$ymin, input$ymax), ylab = "y", xlab = "x", type = "l", lwd = 5)
})
}
shinyApp(ui, server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.