Last active
November 3, 2017 01:32
-
-
Save makis23/1aa239c4fda95d2b8c5083de9eeb8f4d to your computer and use it in GitHub Desktop.
Replace if with for loop does not work with datatables
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ###DATASET: https://www.dropbox.com/s/fzys7g697j6mj8x/get_history_results.rda?dl=0 | |
| --- | |
| runtime: shiny | |
| output: | |
| flexdashboard::flex_dashboard: | |
| theme: cosmo | |
| orientation: rows | |
| --- | |
| <style type="text/css"> | |
| h1, h2, h3, h4, h5, h6, .h1, .h2, .h3, .h4, .h5, .h6, chart-title, .chart-title { | |
| font-weight: bold; | |
| } | |
| .dataTables_filter { | |
| display: none; | |
| } | |
| .btn-default { | |
| color: #ffffff; | |
| background-color: #1a6ecc; | |
| border-color: #1a6ecc; | |
| } | |
| </style> | |
| ```{r} | |
| # FIXME: get themeSelector() working | |
| # shinyApp(ui = fluidPage(shinythemes::themeSelector()), server = function(a, b) {}) | |
| # shinythemes::themeSelector() | |
| ``` | |
| ```{r} | |
| library(rhandsontable) | |
| library(magrittr) | |
| library(DT) | |
| library(data.table) | |
| library(kableExtra) | |
| library(shinyBS) | |
| library(shiny) | |
| #library(shinyjs) | |
| ROOT <- file.path('..', '..', '..') | |
| ``` | |
| --- | |
| title: "`r paste("Estimates Portal", isolate(input$company), sep=' ')`" | |
| --- | |
| My Estimates {data-icon="fa-history"} | |
| ===================================== | |
| Estimates {.sidebar data-width=450} | |
| ----------------------------------------------------------------------- | |
| #### Your current Estimate for 3/7/2017 | |
| ```{r} | |
| br() | |
| #measure_list <- sqlQuery(aidb_conn, "SELECT measure_name from measures_alpha ORDER BY measure_id ASC", stringsAsFactors = F) | |
| measure_list <- c('Revenue Growth', 'Change in Gross Margin', 'Change in Operating Margin') | |
| N_MEASURES <- length(measure_list) | |
| # Form the template blank DF dynamically based on the measures available | |
| DF = data.frame( | |
| Variables = measure_list, | |
| Lower.Bound = rep('', N_MEASURES), | |
| Upper.Bound = rep('', N_MEASURES), | |
| row.names = NULL, | |
| stringsAsFactors = FALSE | |
| ) | |
| load_history <- function(expert_nick_arg, company_arg) { | |
| # cat(file=stderr(), "company_arg=", company_arg,"\n") | |
| # cat(file=stderr(), "expert_nick_arg=", expert_nick_arg,"\n") | |
| load("get_history_results.rda") | |
| temp2 <- copy(temp); temp2$est_id <- temp2$est_id + 1 | |
| temp <- rbind(temp, temp2) | |
| return(temp) | |
| # query <- readLines("sql/estimates_query.sql") | |
| # query2 <- paste(query, collapse='\n') | |
| # query2 <- sub("NICK_PLACEHOLDER", expert_nick_arg, query2) | |
| # query2 <- sub("TICKER_PLACEHOLDER", company_arg, query2) | |
| # # cat(file=stderr(), "query2=", query2,"\n") | |
| # | |
| # est <- sqlQuery(aidb_conn, query2) | |
| # | |
| # return(est) | |
| } | |
| # What is est_reactive? est_reactive$est_new_df = data.frame with Estimate values from the rhandsontable in the LHS pane. est_reactive$clicks = 0 => show blank table in the LHS pane, 1 => show real values from est_reactive$est_new_df, est_reactive$already_submitted = to prevent re-submission | |
| est_reactive <- reactiveValues(est_new_df = data.frame(), clicks=0, already_submitted=F) | |
| rHandsontableOutput("hot") | |
| observe({ | |
| # Show blank template initially | |
| if (est_reactive$clicks == 0) { | |
| df <- DF | |
| } else { | |
| df <- est_reactive$est_new_df | |
| } | |
| output$hot <- renderRHandsontable({ | |
| rhandsontable(df, width = 600, height = 150, selectCallback = TRUE, readOnly = T, contextMenu = F, fillHandle = F) | |
| #runjs("HTMLWidgets.getInstance(output$hot).hot.selectCell(0,1);") | |
| }) | |
| }) | |
| showHistory <- function(DF2, DF3, DF4, DF5) { | |
| for(i in 2:5){ | |
| if (!is.null(DF[i]) && nrow(DF[i]) != 0) { | |
| output$hist[i-1] <- DT::renderDataTable({ | |
| DT:: datatable (DF[i], | |
| selection="none", options=list(paging=F, ordering=F, | |
| searching=F, bLengthChange=F, | |
| bFilter=F,bInfo=F) | |
| ) | |
| })}}} | |
| # end of showHistory() | |
| # Get est history from the DB | |
| #est <- reactive({load_history('Bill Nye', 'ai001161.01')}) | |
| est <- reactive({load_history(input$expert, input$company)}) | |
| est_list <- reactive({ | |
| est2 <- est() | |
| #cat("class(est2)=", class(est2), "\n") | |
| #cat("dim(est2)=", dim(est2), "\n") | |
| #print(est2) | |
| split(est2, est2$est_id) | |
| }) | |
| # Dummy hist for testing | |
| #df1 <- make_history() | |
| #df2 <- make_history() | |
| #df_list <- list(df1, df2) | |
| get_measure_columns <- function(df) { | |
| df2 <- df[, c('measure_name', 'value_lower', 'value_upper')] | |
| colnames(df2) <- c('Variable', 'Lower Bound', 'Upper Bound') | |
| df2 | |
| } | |
| for(i in 1:4){ | |
| reactive({ | |
| el <- est_list() | |
| #cat("el=\n") | |
| #print(el) | |
| df1 <- NULL | |
| df2 <- NULL | |
| if (length(el) >= i) { | |
| df[i] <- get_measure_columns(el[[i]]) | |
| } | |
| showHistory( | |
| df1,df2,df3,df4) | |
| })} | |
| ``` | |
| #### Your past Estimates | |
| Estimate from 02/07/2017 | |
| ```{r} | |
| DT::dataTableOutput("hist1") | |
| br() | |
| ``` | |
| Estimate from 01/05/2017 | |
| ```{r} | |
| DT::dataTableOutput("hist2") | |
| br() | |
| ``` | |
| Estimate from 12/03/2016 | |
| ```{r} | |
| DT::dataTableOutput("hist3") | |
| br() | |
| ``` | |
| Estimate from 11/09/2016 | |
| ```{r} | |
| DT::dataTableOutput("hist4") | |
| br() | |
| ``` | |
| Input {data-height=150} | |
| ----------------------------------------------------------------------- | |
| #### Input | |
| ```{r} | |
| renderUI({ | |
| tagList( | |
| tags$br(), | |
| if (est_reactive$already_submitted) | |
| tags$br() | |
| else if(is.null(input$hot_select)) { | |
| tags$b("Please click on the cell you would like to change in the Current Estimates table") | |
| } else { | |
| # #learning #vv : both bold and underling using shiny::tags(), list() inside tags$b(), plus using tagList() in renderUI() to output HTML | |
| tags$b(list("Please provide the", | |
| tags$u(colnames(DF)[input$hot_select$select$c]), | |
| "for your 80% confidence interval for", | |
| tags$u(DF[input$hot_select$select$r,1]), | |
| "over the next 12 months for", input$company, sep="\n")) | |
| } | |
| ) # end of tagList() | |
| }) | |
| ``` | |
| Row {data-height=850} | |
| ----------------------------------------------------------------------- | |
| ```{r} | |
| numeric_input <- reactiveValues(box=0) | |
| observeEvent(input$hot_select, { | |
| if (!is.null(est_reactive$est_new_df[input$hot_select$select$r, input$hot_select$select$c])) { | |
| get_value <- function(row,col) { | |
| val <- as.c(est_reactive$est_new_df[row,col]) | |
| return(strsplit(val, "%")[[1]]) | |
| } | |
| updateTextInput(session, "box", value=get_value(input$hot_select$select$r,input$hot_select$select$c)) | |
| } | |
| }) | |
| observeEvent(input$click, { | |
| if(!is.null(input$box)) { | |
| if(try(!is.na(as.numeric(input$box)))) { | |
| # VV: 20171030: use as.numeric() to convert "45.", which is a valid R number, to 45.0 | |
| numeric_input$box <- as.numeric(input$box) | |
| } else { | |
| showModal(modalDialog(title = "Error", "Please provide only numeric values as estimate")) | |
| numeric_input$box <- NA | |
| } | |
| } | |
| }) | |
| observe({ | |
| if(!is.null(input$hot)) { | |
| est_reactive$est_new_df <- hot_to_r(input$hot) | |
| } | |
| }) | |
| observeEvent(input$click, { | |
| if(!is.null(input$box)) { | |
| if (!is.null(input$hot_select)) { | |
| col <- input$hot_select$select$c | |
| row <- input$hot_select$select$r | |
| if (row == 1) { | |
| est_reactive$est_new_df[row, col] <- paste0(numeric_input$box, "%") | |
| } else { | |
| est_reactive$est_new_df[row, col] <- numeric_input$box | |
| } | |
| est_reactive$clicks <- est_reactive$clicks + 1 | |
| } else { | |
| showModal(modalDialog(title = "Error", "Please select a cell in the Current Estimates table before submitting an Estimate")) | |
| } | |
| } # if !is.null(input$box0) | |
| }) | |
| DONE_TEXT <- "Estimates submitted. Thank you!" | |
| textOutput("already_submitted2") | |
| output$already_submitted2 <- renderText({ | |
| #cat("est_reactive$already_submitted=", est_reactive$already_submitted) | |
| if (est_reactive$already_submitted) { | |
| return(DONE_TEXT) | |
| } else { | |
| return("") | |
| } | |
| }) | |
| conditionalPanel(condition=paste0("output.already_submitted2 != '", DONE_TEXT, "'"), | |
| fluidRow( | |
| column(width=4, style='padding-right:100px;', | |
| textInput("box", label="",value=""), | |
| br(), | |
| br(), | |
| actionButton("click","Enter estimate", width=160), | |
| br(), | |
| br(), | |
| actionButton("submit","Submit a table", icon("paper-plane"), width=160) | |
| ), | |
| column(width=8, | |
| br(), | |
| renderImage ({ | |
| list(src="wheel.png", width=350) | |
| }, deleteFile = FALSE) | |
| ) | |
| ) | |
| ) | |
| ``` | |
| ```{r} | |
| # "Are you sure you want to submit?"-related callbacks | |
| observeEvent(input$submit, { | |
| if(est_reactive$already_submitted == F) { | |
| showModal(modalDialog(title = "Confirm", "Are you sure you want to submit these values?", easyClose=T, | |
| footer=tagList(actionButton("Butyes", "Yes"), actionButton("Butno", "No")) | |
| )) | |
| } else { | |
| showModal(modalDialog(title = "Error", "Sorry, you have already submitted a table during this session! Please reload if you would like to re-submit a new set of Estimates", easyClose=T)) | |
| } | |
| }) | |
| renderRHandsontableWithCustomFormatting <- function() { | |
| # Render current estimates table with pink background | |
| df <- est_reactive$est_new_df | |
| output$hot <- renderRHandsontable({ | |
| rhandsontable(df, width = 600, height = 150, selectCallback = TRUE, readOnly = T, contextMenu = F, fillHandle = F) %>% | |
| hot_cols(renderer = " | |
| function (instance, td, row, col, prop, value, cellProperties) { | |
| td.style.background = 'lightgrey'; | |
| }") | |
| }) | |
| } | |
| # Upon confirmation, save est_new_df to DB | |
| observeEvent(input$Butyes, { | |
| removeModal() | |
| # TODO: save est_new_df to DB | |
| # sqlSave(, update=T) | |
| est_reactive$already_submitted <- T | |
| renderRHandsontableWithCustomFormatting() | |
| showModal(modalDialog(title = "Done", "Thank you", easyClose=F)) | |
| }) | |
| observeEvent(input$Butno, { | |
| removeModal() | |
| }) | |
| ``` | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
i also attach the working example with if statements for better understanding the issue
runtime: shiny
<style type="text/css"> h1, h2, h3, h4, h5, h6, .h1, .h2, .h3, .h4, .h5, .h6, chart-title, .chart-title { font-weight: bold; } .dataTables_filter { display: none; } .btn-default { color: #ffffff; background-color: #1a6ecc; border-color: #1a6ecc; } </style>output:
flexdashboard::flex_dashboard:
theme: cosmo
orientation: rows
title: "
r paste("Estimates Portal", isolate(input$company), sep=' ')"My Estimates {data-icon="fa-history"}
Estimates {.sidebar data-width=450}
Your current Estimate for 3/7/2017
Your past Estimates
Estimate from 02/07/2017
Estimate from 01/05/2017
Estimate from 12/03/2016
Estimate from 11/09/2016
Input {data-height=150}
Input
Row {data-height=850}