inst/app/server/country/rhandsontable.R

In jackolney/CascadeDashboard: A Shiny App for Investigating The Current Trajectory of HIV Care

# rhandsontable elements

values <- reactiveValues()

### CASCADE
setHotCascade <- function(x) values[["hot_cascade"]] = x

# Observe and update data.frame on button press and also when values[["hot_cascade"]] changes

# Indicators
vCascade = NULL
vCascadeCountry = NULL

observe({
    # dependency
    input$PREV_editCascade
    if (!is.null(values[["hot_cascade"]]) & length(MasterData) > 0) {
        MasterData$calib <<- na.omit(values[["hot_cascade"]])
    }
})

output$hot_cascade <- renderRHandsontable({
    input$CASCADE_FLAG

    # Update (01/08/16), working as it should (discussion: https://github.com/jrowen/rhandsontable/issues/27)
    if (input$NEW_country == TRUE & input$new_country_name != "") {
        vCascade <<- NULL
        if (is.null(input$hot_cascade) || is.null(vCascadeCountry)) {
            # This will be a blank MasterData
            vCascade <<- AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
            vCascadeCountry <<- 1L
            DF = MasterData$calib
        } else if (!is.null(input$hot_cascade)) {
            DF = hot_to_r(input$hot_cascade)
        }
    } else {
        vCascadeCountry <<- NULL

        # BUG
        # If you select a country, then select some data, then select another country,
        # look at cascade data, don't edit and come out of it, and then click to edit
        # it again, it reverts to the previous country.
        # Maybe we need a flag that ignores input$hot_cascade if the country is incorrect
        # A 'vCascadeName' flag does not work, as when entering data MasterData overwrites it.

        # print("testing:")
        # if (!is.null(input$hot_cascade)) {
        #     message("hot_to_r(input$hot_cascade)$country[1]")
        #     print(hot_to_r(input$hot_cascade)$country[1])
        #     message("countryReportName")
        #     print(countryReportName)
        # }

        # message("values[['hot_cascade']]")
        # print(na.omit(values[["hot_cascade"]]))

        # Attempted fix.
        # Will the same hold for other values.
        # if (is.null(vCascade)) {
        #     # This will pad out the MasterData with NA's and update its name
        #     vCascade <<- AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        #     DF = AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        # } else if (is.null(input$hot_cascade)) {
        #     # This will pad out the MasterData with NA's and update its name
        #     vCascade <<- AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        #     DF = AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        # } else if (hot_to_r(input$hot_cascade)$country[1] != countryReportName) {
        #     # This will pad out the MasterData with NA's and update its name
        #     vCascade <<- AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        #     DF = AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        # } else {
        #     DF = hot_to_r(input$hot_cascade)
        # }

        # ORIGINAL - CURRENTLY IN USE
        # 06/09/16 - Reverting to the original as rhandsontable updates are too slow with the bugfix (will leave commented out in case we need to return to it)
        if (is.null(input$hot_cascade) || is.null(vCascade)) {
            # This will pad out the MasterData with NA's and update its name
            vCascade <<- AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
            DF = AddNAToMasterData(theBlank = GetBlankMasterDataSet("blank")$calib, theData = MasterData$calib)
        } else if (!is.null(input$hot_cascade)) {
            DF = hot_to_r(input$hot_cascade)
        }
    }

    setHotCascade(DF)
    rhandsontable(DF, useTypes = TRUE, stretchH = "all") %>%
            hot_col(col = "value", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "country", readOnly = TRUE) %>%
            hot_col(col = "indicator", readOnly = TRUE) %>%
            hot_col(col = "year", type = "date", dateFormat = "%Y", readOnly = TRUE) %>%
            # the 'weight' column still shows NA instead of blank, due to the presence of the renderer function.
            hot_col(col = "weight", type = "dropdown", source = c("green", "amber", "red"), strict = TRUE, allowInvalid = FALSE, halign = "htLeft") %>%
                # renderer = "function (instance, td, row, col, prop, value, cellProperties) {
                #     Handsontable.renderers.TextRenderer.apply(this, arguments);
                #     if (value == 'green') {
                #         td.style.background = 'green';
                #     } else if (value == 'amber') {
                #         td.style.background = 'orange';
                #     } else if (value == 'red') {
                #         td.style.background = 'red';
                #     }
                # }") %>%
            hot_col(col = "source", type = "autocomplete", strict = FALSE, allowInvalid = TRUE, halign = "htLeft") %>%
            hot_cols(colWidths = c(10,10,5,10,5,20)) %>%
            hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})

### CD4
setHotCD4 <- function(x) values[["hot_cd4"]] = x

# Observe and update data.frame on button press and also when values[["hot_cd4"]] changes

# Indicators
vCD4 = NULL
vCD4Country = NULL

observe({
    # dependency
    input$PREV_editCD4
    if (!is.null(values[["hot_cd4"]]) & length(MasterData) > 0) {
        MasterData$cd4[2:15] <<- values[["hot_cd4"]]$Proportion
        if (input$new_country_name != "") {
            MasterData$cd4[[1]] <<- input$new_country_name
        }
    }
})

output$hot_cd4 <- renderRHandsontable({
    input$CD4_FLAG

    if (input$NEW_country == TRUE & input$new_country_name != "") {
        vCD4 <<- NULL
        if (is.null(input$hot_cd4) || is.null(vCD4Country)) {
            Proportion <- as.numeric(NA)
            ART <- c(rep("Off ART", 7), rep("On ART", 7))
            Category <- rep(c("<500", "350-500", "250-350", "200-250", "100-200", "50-100", "<50"), 2)
            DF = data.frame(ART, Category, Proportion)
            vCD4 <<- DF
            vCD4Country <<- 1L
        } else if (!is.null(input$hot_cd4)) {
            DF = hot_to_r(input$hot_cd4)
        }
    } else {
        vCD4Country <<- NULL
        if (is.null(input$hot_cd4) || is.null(vCD4)) {
            if (isReallyEmpty(MasterData$cd4)) {
                Proportion <- as.numeric(NA)
            } else {
                Proportion <- as.numeric(MasterData$cd4[2:15])
            }
            ART <- c(rep("Off ART", 7), rep("On ART", 7))
            Category <- rep(c("<500", "350-500", "250-350", "200-250", "100-200", "50-100", "<50"), 2)
            DF = data.frame(ART, Category, Proportion)
            vCD4 <<- DF
        } else if (!is.null(input$hot_cd4)) {
            DF = hot_to_r(input$hot_cd4)
        }
    }

    setHotCD4(DF)
    rhandsontable(DF, useTypes = TRUE, stretchH = "all") %>%
            hot_col(col = "ART", readOnly = TRUE) %>%
            hot_col(col = "Category", readOnly = TRUE) %>%
            hot_col(col = "Proportion", type = "numeric", halign = "htLeft") %>%
            hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})

### CD4 2015
setHotCD42015 <- function(x) values[["hot_cd4_2015"]] = x

# Observe and update data.frame on button press and also when values[["hot_cd4"]] changes

# Indicators
vCD42015 = NULL
vCD42015Country = NULL

observe({
    # dependency
    input$PREV_editCD4
    if (!is.null(values[["hot_cd4_2015"]]) & length(MasterData) > 0) {
        MasterData$cd4_2015[2:15] <<- values[["hot_cd4_2015"]]$Proportion
        if (input$new_country_name != "") {
            MasterData$cd4_2015[[1]] <<- input$new_country_name
        }
    }
})

output$hot_cd4_2015 <- renderRHandsontable({
    input$CD4_FLAG
    input$copy2010CD4

    if (input$NEW_country == TRUE & input$new_country_name != "") {
        vCD42015 <<- NULL
        if (is.null(input$hot_cd4_2015) || is.null(vCD42015Country)) {
            if (input$copy2010CD4 == TRUE) {
                Proportion <- as.numeric(MasterData$cd4[2:15])
            } else {
                Proportion <- as.numeric(NA)
            }
            ART <- c(rep("Off ART", 7), rep("On ART", 7))
            Category <- rep(c("<500", "350-500", "250-350", "200-250", "100-200", "50-100", "<50"), 2)
            DF = data.frame(ART, Category, Proportion)
            vCD42015 <<- DF
            vCD42015Country <<- 1L
        } else if (!is.null(input$hot_cd4_2015)) {
            DF = hot_to_r(input$hot_cd4_2015)
        }
    } else {
        vCD42015Country <<- NULL
        if (is.null(input$hot_cd4_2015) || is.null(vCD42015)) {
            if (isReallyEmpty(MasterData$cd4_2015)) {
                Proportion <- as.numeric(NA)
            } else {
                Proportion <- as.numeric(MasterData$cd4_2015[2:15])
            }
            ART <- c(rep("Off ART", 7), rep("On ART", 7))
            Category <- rep(c("<500", "350-500", "250-350", "200-250", "100-200", "50-100", "<50"), 2)
            DF = data.frame(ART, Category, Proportion)
            vCD42015 <<- DF
        } else if (!is.null(input$hot_cd4_2015)) {
            DF = hot_to_r(input$hot_cd4_2015)
        }
    }

    setHotCD42015(DF)
    rhandsontable(DF, useTypes = TRUE, stretchH = "all") %>%
            hot_col(col = "ART", readOnly = TRUE) %>%
            hot_col(col = "Category", readOnly = TRUE) %>%
            hot_col(col = "Proportion", type = "numeric", halign = "htLeft") %>%
            hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})

### INCIDENCE
setHotIncidence <- function(x) values[["hot_incidence"]] = x

# Observe and update data.frame on button press and also when values[["hot_incidence"]] changes

# Indicators
vIncidence = NULL
vIncidenceCountry = NULL

observe({
    # dependency
    input$PREV_editIncidence
    if (!is.null(values[["hot_incidence"]]) & length(MasterData) > 0) {
        MasterData$incidence <<- values[["hot_incidence"]]
    }
})

output$hot_incidence <- renderRHandsontable({
    input$INCIDENCE_FLAG

    if (input$NEW_country == TRUE & input$new_country_name != "") {
        vIncidence <<- NULL
        if (is.null(input$hot_incidence) || is.null(vIncidenceCountry)) {
            theData <- MasterData$incidence
            DF = theData[order(theData$type, decreasing = TRUE),]
            vIncidence <<- DF
            vIncidenceCountry <<- 1L
        } else if (!is.null(input$hot_incidence)) {
            DF = hot_to_r(input$hot_incidence)
        }
    } else {
        vIncidenceCountry <<- NULL
        if (is.null(input$hot_incidence) || is.null(vIncidence)) {
            theData <- MasterData$incidence
            DF = theData[order(theData$type, decreasing = TRUE),]
            vIncidence <<- DF
        } else if (!is.null(input$hot_incidence)) {
            DF = hot_to_r(input$hot_incidence)
        }
    }

    setHotIncidence(DF)
    rhandsontable(DF, useTypes = TRUE, stretchH = "all") %>%
            hot_col(col = "country", readOnly = TRUE) %>%
            hot_col(col = "type", readOnly = TRUE) %>%
            hot_col(col = "2010", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "2011", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "2012", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "2013", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "2014", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "2015", format = '0,0', halign = "htLeft") %>%
            hot_col(col = "2016", format = '0,0', halign = "htLeft") %>%
            hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})

### GUIDELINES
setHotGuidelines <- function(x) values[["hot_guidelines"]] = x

# Observe and update data.frame on button press and also when values[["hot_guidelines"]] changes

# Indicators
vGuidelines = NULL
vGuidelinesCountry = NULL

observe({
    # dependency
    input$PREV_editGuidelines
    if (!is.null(values[["hot_guidelines"]]) & length(MasterData) > 0) {
        MasterData$treatment_guidelines[,c("less200", "less250", "less350", "less500", "more500")] <<- values[["hot_guidelines"]]$Year
    }
})

output$hot_guidelines <- renderRHandsontable({
    input$GUIDELINES_FLAG

    if (input$NEW_country == TRUE & input$new_country_name != "") {
        vGuidelines <<- NULL
        if (is.null(input$hot_guidelines) || is.null(vGuidelinesCountry)) {
            Year <- as.numeric(NA)
            Threshold <- c("CD4 <200", "CD4 <250", "CD4 <350", "CD4 <500", "CD4 >500")
            DF = data.frame(Threshold, Year)
            vGuidelines <<- DF
            vGuidelinesCountry <<- 1L
        } else if (!is.null(input$hot_guidelines)) {
            DF = hot_to_r(input$hot_guidelines)
        }
    } else {
        vGuidelinesCountry <<- NULL
        if (is.null(input$hot_guidelines) || is.null(vGuidelines)) {
            Year <- as.numeric(MasterData$treatment_guidelines[,c("less200", "less250", "less350", "less500", "more500")])
            Threshold <- c("CD4 <200", "CD4 <250", "CD4 <350", "CD4 <500", "CD4 >500")
            DF = data.frame(Threshold, Year)
            vGuidelines <<- DF
        } else if (!is.null(input$hot_guidelines)) {
            DF = hot_to_r(input$hot_guidelines)
        }
    }

    setHotGuidelines(DF)
    rhandsontable(DF, useTypes = TRUE, stretchH = "all") %>%
            hot_col(col = "Threshold", readOnly = TRUE) %>%
            hot_col(col = "Year", type = "date", dateFormat = "YYYY") %>%
            hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})