if statement is not interpretable as logical in Shiny reactive function - if-statement

I am currently working on an R Shiny project and below is a small reprex of the things I am trying to accomplish in my actual project. The basic idea is to process reactive data tables that are generated from user inputs through conditional statements in eventReactive functions. In this example below, I want to either add, multiply or subtract the user input using conditional "if" statements. I get this error: "Error in if: argument is not interpretable as logical". I know I am not sub-setting col1 correctly for logical comparison here and can't seem to find a solution.
library(shiny)
library(DT)
library(tidyverse)
input_data <- data.frame(input1 = character(),
input2 = double(),
stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
selectInput("input1",
"Input 1",
choices = c("Add", "Multiply", "Subtract")),
numericInput("input2",
"Input 2",
value = 100),
actionButton("add_btn",
"Add Input"),
actionButton("process_btn",
"Process Input"),
position = "left"
),
mainPanel(
DT::dataTableOutput("input_table"),
DT::dataTableOutput("output_table")
)
)
)
server <- function(input, output) {
input_table <- reactiveVal(input_data)
observeEvent(input$add_btn, {
t = rbind(input_table(), data.frame(col1 = input$input1, col2 = input$input2))
input_table(t)
})
output$input_table <- DT::renderDataTable({
datatable(input_table())
})
output_table <- eventReactive(input$process_btn, {
input_table() %>%
if(input_table()$col1 == "Add") {
mutate(col3 = col2 + 50)
} else if(input_table()$col1 == "Multiply") {
mutate(col3 = col2 * 50)
} else
mutate(col3 = col2 - 50)
})
output$output_table <- DT::renderDataTable({
datatable(output_table())
})
}

You can not use if to build constitutional pipe %>% (especially depending on the content of the piped object).
You can use ifelse() instead, or better : if_else()`:
input_table() %>%
mutate(col3 =
if_else(col1 == "Add",
col2 + 50,
if_else(col1 == "Multiply",
col2 * 50,
col2 - 50)
)
As you have several conditions you also can use case_when():
input_table() %>%
mutate(col3 =
case_when(
col1 == "Add" ~ col2 + 50,
col1 == "Multiply" ~ col2 * 50,
TRUE ~ col2 - 50)
)

Related

Remove unwanted white space when rendering leaflet or plot in Shiny

I want the user of my Shiny app to be able to choose between two types of plots by clicking on radiobuttons in the Events panel. The code I have written works, but the page leaves a huge white space when going from "Map" to "Plot". Is there any way to get rid of the white space and position the plot at the very top?
# Load R packages
library(shiny)
library(shinythemes)
library(tidyverse)
library(leaflet)
set.seed(123)
year <- 2001:2020
event <- sample(1:100, size = 20, replace = TRUE)
dat <- as.data.frame(cbind(year, event))
# Define UI
ui <- fluidPage(
shinyjs::useShinyjs(),
theme = shinytheme("journal"),
navbarPage(
"Title",
tabPanel("About",
),
tabPanel("Events",
fluidPage(
titlePanel("Title"),
sliderInput("range", label = "Move slider to select time period", min(2001), max(2020),
value = range(2001:2002), step = 1, sep = "", width = "65%"),
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type", choices = c("Map" = "m", "Chart" = "l"))),
mainPanel(
leafletOutput("map"),
plotOutput("plot"))
)
)
)
)
)
# Define server function
server <- function(input, output, session) {
observeEvent(input$plotType, {
if(input$plotType == "l"){
shinyjs::disable("range")
}else{
shinyjs::enable("range")
}
})
output$plot <- renderPlot({
if (input$plotType == "l") {
ggplot(dat, aes(year, event)) +
geom_line() +
labs(x = "Year", y = "Events") +
theme_bw()
}
})
output$map <- renderLeaflet({
if ( input$plotType == "m") {
leaflet(dat) %>% addTiles() %>%
fitBounds(~min(11), ~min(54), ~max(67), ~max(24))
}
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
There is a big space because the map html object still exists, but is empty. To avoid this, I created and observeEvent that hides or show the map output depending on input value. I did the same thing with the plot, in cas you need to add others elements below it.
Please note that there are others solutions (conditionalPanel for example), I am just giving you the one I think is the simpliest here.
# Load R packages
library(shiny)
library(shinythemes)
library(tidyverse)
library(leaflet)
set.seed(123)
year <- 2001:2020
event <- sample(1:100, size = 20, replace = TRUE)
dat <- as.data.frame(cbind(year, event))
# Define UI
ui <- fluidPage(
shinyjs::useShinyjs(),
theme = shinytheme("journal"),
navbarPage(
"Title",
tabPanel("About",
),
tabPanel("Events",
fluidPage(
titlePanel("Title"),
sliderInput("range", label = "Move slider to select time period", min(2001), max(2020),
value = range(2001:2002), step = 1, sep = "", width = "65%"),
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type", choices = c("Map" = "m", "Chart" = "l"))),
mainPanel(
leafletOutput("map"),
plotOutput("plot"))
)
)
)
)
)
# Define server function
server <- function(input, output, session) {
# hide or show map and plot
observeEvent(input$plotType, {
if(input$plotType == "l"){
shinyjs::disable("range")
shinyjs::hide("map")
shinyjs::show("plot")
}
if(input$plotType == "m"){
shinyjs::enable("range")
shinyjs::show("map")
shinyjs::hide("plot")
}
})
output$plot <- renderPlot({
req(input$plotType == "l") # good practice to use req instead of if
ggplot(dat, aes(year, event)) +
geom_line() +
labs(x = "Year", y = "Events") +
theme_bw()
})
output$map <- renderLeaflet({
req(input$plotType == "m")
leaflet(dat) %>% addTiles() %>%
fitBounds(~min(11), ~min(54), ~max(67), ~max(24))
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)

load data and set up custom projection in R Shiny (leaflet)

I would like to load data and set up a custom projection in R Shiny. I am able to load the data but cannot get the projection right (ESPG:26916). I have searched but am not sure what I have missed. Help much appreciated.
Here is the code I have
library(leaflet)
library(tidyverse)
ui <- fluidPage(
column(
width = 4,
leafletOutput("mymap", width = 1400, heigh = 700)),
p(),
fileInput("in_file", "Input file:",
accept=c("txt/csv", "text/comma-separated-values,text/plain", ".csv", "Decimal seperator")),
actionButton("upload_data", "Visualize New points")#,
)
server <- function(input, output, session) {
visualize <- reactive({
if(input$upload_data==0) {
return(NULL)
}
df <- read.csv(input$in_file$datapath,
sep = ',',
header = TRUE,
quote = "#",
row.names = NULL)
epsg26916 <- leafletCRS(
crsClass = "L.Proj.CRS",
code = 'EPSG:26916',
proj4def = "+proj=utm +zone=16 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs",
resolutions = 2^(15:-1)
)
return(leaflet(df,
options = leafletOptions(crs = epsg26916)
) %>%
addProviderTiles(providers$Esri.WorldImagery,
options = providerTileOptions(noWrap = TRUE)) %>%
setView(-85.39310209, 42.41438242, zoom = 16) %>%
addCircleMarkers(~easting, ~northing,
group = "my data",
weight = 1, fillOpacity = 0.7, radius = 3) %>%
addLayersControl(overlayGroups = c("my data"))
)
})
output$mymap <- renderLeaflet({
visualize()
})
}
shinyApp(ui, server)

Is there a good way to merge data based on a drop down menu in R?

I have been trying to merge data with another data set based on input from a drop down. I have just started learning R and have run into some problems and want to know if there is a better way of going about this.
I am getting an error that it cannot coerce class c(ReactiveExpr, reactive) to a data frame.
library(shiny)
library(plyr)
library(dplyr)
library(xlsx)
server <- function(input, output){
annotation1 <- read.xlsx("input1.xlsx", sheetIndex = 1, header = TRUE)
annotation2 <- read.xlsx("input2.xlsx", sheetIndex = 1, header = TRUE)
data_input <- eventReactive(input$userfile, {
df <- read.xlsx(input$userfile$datapath, sheetIndex = 1, header = TRUE)
})
output$data_input <- renderTable(data_input())
output$annotation <- renderTable(annotation)
data_species <- c("Set1", "Set2")
# Drop-down selection box for which data set
output$choose_species <- renderUI ({
selectInput("species", "Species", as.list(data_species))
})
output$mergeddata <- renderTable({
if(input$species == "Set1"){
eventReactive("Set1",({left_join(data_input(), annotation1, by = c("Column1" = "Column1"))}))
}
else if(input$species == "Set2"){
eventReactive("Set2",({left_join(data_input(), annotation2, by = c("Column1" = "Column1"))}))
}
})
}
ui <- fluidPage(
titlePanel(
div("Test")
),
sidebarLayout(
sidebarPanel(
fileInput("userfile", "Input File", multiple =FALSE,
buttonLabel = "Browse Files", placeholder = "Select File"),
uiOutput("choose_species"),
uiOutput("choose_annotations"),
),
mainPanel(
tableOutput("mergeddata"),
br()
),
),
)
# Run the application
shinyApp(ui = ui, server = server)
In general, you approach seems ok. The error you get is from the line
eventReactive("Set1",({left_join(data_input(), annotation1, by = c("Column1" = "Column1"))}))
An eventReactive returns an (unevaluated) reactive expression which you try to render as data.frame with renderTable. To circumvent this, you could use:
eventReactive("Set1",({left_join(data_input(), annotation1, by = c("Column1" = "Column1"))}))()
However, here you don't need eventReactive, because your reactivity comes from input$species (you want to change the table output based on this input). Therefore, you can just use:
output$mergeddata <- renderTable({
if(input$species == "Set1"){
merge_data <- annotation1
} else {
merge_data <- annotation2
}
left_join(data_input(), merge_data, by = c("Column1"))
})

datatable filters update on the fly

In the basic example below I would like to have all filters updated every time user add a filter.
ui :
library(shiny)
library(DT)
fluidPage(
fluidRow(
column(4,
DT::dataTableOutput("dt")
)
)
)
Server :
library(shiny)
shinyServer(function(input, output) {
df <- data.frame(var1 = c(rep("A",3),rep("B",3)), var2 = c("x","y","x","z","x","s"), var3 = c(1:6))
output$dt <- renderDataTable({
DT::datatable(df, filter = 'top')
})
})
When no filter applied :
When I apply filter on var1 to "A", s and z still remain in the suggested label in var2 filter even if there are no value to s or z
This is how I would do if I use selectInput for the filters. May not be the best solution, but it has always worked for me.
Code for ui.r
library(shiny)
library(DT)
fluidPage(
fluidRow(
column(4,selectizeInput("var1", label = "Var 1", choices = NULL, multiple = TRUE)),
column(4,selectizeInput("var2", label = "Var 2", choices = NULL, multiple = TRUE)),
column(4,selectizeInput("var3", label = "Var 3", choices = NULL, multiple = TRUE)),
column(4,DT::dataTableOutput("dt")
)
)
)
Code for server.R
library(shiny)
shinyServer(function(input, output, session) {
df <- data.frame(var1 = c(rep("A",3),rep("B",3)), var2 = c("x","y","x","z","x","s"), var3 = c(1:6))
updateSelectizeInput(session, 'var1', choices = sort(unique(df$var1)), server = TRUE)
updateSelectizeInput(session, 'var2', choices = sort(unique(df$var2)), server = TRUE)
updateSelectizeInput(session, 'var3', choices = sort(unique(df$var3)), server = TRUE)
filterData <- function(dataset){
df <- dataset
if (!is.null(input$var1)){
df <- df[which(df$var1 == input$var1),]
}
if (!is.null(input$var2)){
df <- df[which(df$var2 == input$var2),]
}
if (!is.null(input$var3)){
df <- df[which(df$var3 == input$var3),]
}
df
}
output$dt <- renderDataTable({
DT::datatable(filterData(df))
})
getwhich<-function(){
whichs<-which(df$var3 == df$var3)
if(!is.null(input$var1)){
whichs<-intersect(whichs,which(df$var1 %in% input$var1))
}
if(!is.null(input$var2)){
whichs<-intersect(whichs,which(df$var2 %in% input$var2))
}
if(!is.null(input$var3)){
whichs<-intersect(whichs,which(df$var3 %in% input$var3))
}
return(whichs)
}
observe({
w<-getwhich()
if(is.null(input$var1)){
updateSelectizeInput(session,"var1",choices=sort(unique(df$var1[w])))
}
})
observe({
w<-getwhich()
if(is.null(input$var2)){
updateSelectizeInput(session,"var2",choices=sort(unique(df$var2[w])))
}
})
observe({
w<-getwhich()
if(is.null(input$var3)){
updateSelectizeInput(session,"var3",choices=sort(unique(df$var3[w])))
}
})
})
Hope this helps.

Error on rcdimple when deploying to shinyapps.io

I have an application which works fine locally and I would like to deploy it to shinyapps.io. I created a directory (dataviz) and the application code is in a file called app.R. When running deployApp("dataviz") from RStudio, it starts deploying but reaches a point where it fails with the error:
** preparing package for lazy loading
Error in loadNamespace(i, c(lib.loc, .libPaths()), versionCheck = vI[[i]]) :
there is no package called ‘htmltools’
ERROR: lazy loading failed for package ‘rcdimple’
* removing ‘/usr/local/lib/R/site-library/rcdimple’
################################### End Log ###################################
Error: Unhandled Exception: Child Task 27328802 failed: Error building image: Error building rcdimple (0.1). Build exited with non-zero status: 1
Not sure what could be happening here, any help greatly appreciated.
The app.R is as so
## app.R ##
library(shinydashboard)
library(shiny)
require(htmltools)
require(htmlwidgets)
library(rcdimple) #devtools::install_github("timelyportfolio/rcdimple")
library(curl) #devtools::install_github("jeroenooms/curl")
library(plyr) # for round_any
library(rCharts)
library(ggvis)
library(reshape2)
indicators <- read.csv(curl("https://raw.githubusercontent.com/kilimba/msc-impl-R/master/dataviz/data/testindicators.csv"))
choices <- as.vector(indicators$label)
indicators$label <- as.character(indicators$label)
indicators$file <- paste("",indicators$file,"",sep="")
getHeatMapData <- function(data,indicator){
df <- data
if(indicator$rate == "Y"){
hmap_df <- aggregate(cbind(denominator,numerator) ~ year + agegrp,df,sum)
hmap_df$rate <- round((hmap_df$numerator/hmap_df$denominator)*indicator$multiplier,2)
names(hmap_df)
}else{
hmap_df <- aggregate(denominator ~ agegrp + year,df, sum)
}
hmap_df$year <- factor(hmap_df$year)
# Helps to order the y-axis labels otherwise labels appear in mixed order
hmap_df$agegrp <- factor(hmap_df$agegrp, levels = rev(as.vector(unique(hmap_df$agegrp))))
return(hmap_df)
}
getData <- function(startyr,endyear,outcome_data) {
data <- subset(outcome_data,(year >= startyr & year <= endyear))
return(data)
}
getDataByAgeGroup <-function(data,agegrp){
d <- data
a <- agegrp
selection <- subset(d,agegrp==a)
return(selection)
}
lineChart <- function(data,agegrp,indicator){
if(indicator$rate == "Y"){
selection <- data
selection$rate <- round((selection$numerator/selection$denominator)*indicator$multiplier,2)
selection$sex <- ifelse(selection$sex == 1, "MALE", "FEMALE")
max_y <- round_any(max(selection$rate), 10, f = ceiling)
min_y <- round_any(min(selection$rate), 10, f = floor)
selection <- getDataByAgeGroup(selection,agegrp)
plot <- nPlot(rate ~ year,
data = selection,
type = "lineChart",
group = "sex",
height = 250,
width = 450 )
# Explicitly set year tick values for every year
plot$xAxis(tickValues = do.call(seq, c(as.list(range(selection$year)), 1)),rotateLabels= -40,showMaxMin = "true")
plot$chart(useInteractiveGuideline = "true", transitionDuration = 500)
plot$chart(forceY = c(min_y, max_y))
plot$chart(color = c("steelblue","firebrick"))
# Add axis labels and format the tooltip
plot$yAxis(axisLabel = paste("Rate per",indicator$multiplier), width = 62)
plot$xAxis(axisLabel = "Year")
return(plot)
}else{
selection <- data
selection$sex <- ifelse(selection$sex == 1, "MALE", "FEMALE")
max_y <- round_any(max(selection$denominator), 10, f = ceiling)
min_y <- round_any(min(selection$denominator), 10, f = floor)
selection <- getDataByAgeGroup(selection,agegrp)
plot <- nPlot(denominator ~ year,
data = selection,
type = "lineChart",
group = "sex",
height = 250,
width = 450 )
# Explicitly set year tick values for every year
plot$xAxis(tickValues = do.call(seq, c(as.list(range(selection$year)), 1)),rotateLabels= -40,showMaxMin = "true")
plot$chart(useInteractiveGuideline = "true", transitionDuration = 500)
plot$chart(forceY = c(min_y, max_y))
plot$chart(color = c("steelblue","firebrick"))
# Add axis labels and format the tooltip
plot$yAxis(axisLabel = "Population", width = 62)
plot$xAxis(axisLabel = "Year")
return(plot)
}
}
# Heat Map
heatmap <- function(data,indicator){
dat <- getHeatMapData(data,indicator)
if(indicator$rate == "Y"){
dat <- rename(dat, c("agegrp" = "Age","year" = "Year", "rate" = "Rate"))
dat %>%
ggvis(~Year, ~Age, fill = ~Rate) %>%
layer_rects(width = band(), height = band()) %>%
add_relative_scales() %>%
set_options(height = 200, width = 410, keep_aspect = TRUE) %>%
add_axis("y", title="")%>%
scale_nominal("x", padding = 0, points = FALSE) %>%
scale_nominal("y", padding = 0, points = FALSE) %>%
scale_numeric("fill",range = c("lightsteelblue","red")) %>%
hide_legend("fill") %>%
add_tooltip(function(d) {
if(is.null(d)) return(NULL)
paste0(names(d), ": ", format(d), collapse = "<br />")
}
) %>%
bind_shiny("heatmap")
}else{
dat <- rename(dat, c("agegrp" = "Age","year" = "Year", "denominator" = "Count"))
dat %>%
ggvis(~Year, ~Age, fill = ~Count) %>%
layer_rects(width = band(), height = band()) %>%
add_relative_scales() %>%
set_options(height = 200, width = 410, keep_aspect = TRUE) %>%
add_axis("y", title="")%>%
scale_nominal("x", padding = 0, points = FALSE) %>%
scale_nominal("y", padding = 0, points = FALSE) %>%
scale_numeric("fill",range = c("lightsteelblue","red")) %>%
hide_legend("fill") %>%
add_tooltip(function(d) {
if(is.null(d)) return(NULL)
paste0(names(d), ": ", format(d), collapse = "<br />")
}
) %>%
bind_shiny("heatmap")
}
}
# DimpleJS pyramid
dPyramid <- function(startyear, endyear, data, colors=c("steelblue","firebrick"),indicator) {
dat <- getData(startyear,endyear,data)
if(indicator$rate == "Y"){
dat$denominator <- ifelse(dat$sex == 1, -1 * dat$denominator, 1 * dat$denominator)
dat$Gender <- ifelse(dat$sex == 1,"Male", "Female")
dat$Rate <- (dat$numerator/dat$denominator)*indicator$multiplier
max_x <- round_any(max(dat$Rate), 10, f = ceiling)
min_x <- round_any(min(dat$Rate), 10, f = floor)
dat <- rename(dat, c("agegrp" = "Age"))
d1 <- dimple(
x = "Rate",
y = "Age",
groups = "Gender",
data = dat,
type = 'bar')
d1 <- yAxis(d1, type = "addCategoryAxis", orderRule = "Age")
d1 <- xAxis(d1,type = "addMeasureAxis")
# Ensure fixed x-axis independent of year selected
d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)
if (!is.null(colors)){
d1 <- colorAxis(
d1,
type = "addColorAxis",
colorSeries = "sex",
palette = colors
)
}
# For storyboarding
if (endyear - startyear >= 1) {
d1 <- tack(d1, options = list( storyboard = "year" ) )
}
return(d1)
}
else{
dat$denominator <- ifelse(dat$sex == 1, -1 * dat$denominator, 1 * dat$denominator)
dat$Gender <- ifelse(dat$sex == 1,"Male", "Female")
max_x <- round_any(max(dat$denominator), 10, f = ceiling)
min_x <- round_any(min(-1*dat$denominator), 10, f = floor)
dat <- rename(dat,c("denominator" = "Count","agegrp" = "Age"))
d1 <- dimple(
x = "Count",
y = "Age",
groups = "Gender",
data = dat,
type = 'bar')
d1 <- yAxis(d1, type = "addCategoryAxis", orderRule = "Age")
d1 <- xAxis(d1,type = "addMeasureAxis")
# Ensure fixed x-axis independent of year selected
d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)
if (!is.null(colors)){
d1 <- colorAxis(
d1,
type = "addColorAxis",
colorSeries = "sex",
palette = colors
)
}
# For storyboarding
if (endyear - startyear >= 1) {
d1 <- tack(d1, options = list( storyboard = "year" ) )
}
return(d1)
}
}
suppressMessages(
singleton(
addResourcePath(
get_lib("nvd3")$name
,get_lib("nvd3")$url
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "HealthData Viz"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Presentations", tabName = "widgets", icon = icon("file-powerpoint-o"))
),
tags$br(),
tags$fieldset(checkboxInput("doAnimate", "Animate Pyramid",value = TRUE),
tags$p("(Uncheck to select specific year)")),
conditionalPanel(
condition = "input.doAnimate == false",
uiOutput("choose_year")
),
uiOutput("choose_agegrp")
,
uiOutput("choose_dataset")
),
dashboardBody(
tags$head(get_assets_shiny(get_lib("nvd3"))[-3]),
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(dimpleOutput("distPlot", height = 250)),
box(showOutput("distPlot2","nvd3",add_lib=F))
),
fluidRow(
#box(infoBoxOutput("informationBox")),
infoBox("About", textOutput("caption"), icon = icon("info-circle"),width = 6),
(
#uiOutput("ggvis_ui"),
box(ggvisOutput("heatmap"))
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Links to interactive scientific presentations will go here...")
)
)
)
)
server <- function(input, output) {
output$choose_dataset <- renderUI({
selectInput("outcome", "Select Outcome", choices, selected="Population Structure",width="95%")
})
output$choose_agegrp <- renderUI({
selectInput("agegrp", "Select Age Group",
choices = c("00-04","05-09","10-14","15-19","20-24","25-29",
"30-34","35-39","40-44","45-49","50-54",
"55-59","60-64","65-69","70-74","75-79",
"80-84","85+"), selected="00-04",width="95%")
})
#############################################################
# PYRAMID
#############################################################
observe({
if(!is.null(input$outcome)){
selected_outcome <- input$outcome
selected_indicator <- subset(indicators,indicators$label == selected_outcome)
outcome_data <- reactive({
read.csv(curl(as.character(selected_indicator$file)))
})
d <- reactive({outcome_data()})
minYear <- reactive({min(d()$year)})
maxYear <- reactive({max(d()$year)})
observe({
if(input$doAnimate){
output$distPlot <- renderDimple({
dPyramid(minYear(), maxYear(),data = outcome_data(), indicator = selected_indicator)
})
}else{
years <- as.vector(unique(outcome_data()$year))
output$choose_year <- renderUI({
selectInput("startyr", "Select Pyramid Year", years, width="95%")
})
output$distPlot <- renderDimple({
if(!is.null(input$startyr)){
startyear <- as.numeric(input$startyr)
# Start year and end year are equal we only want cross-sectional pyramid
# for a single selected year
dPyramid(startyear, startyear, data = outcome_data(),indicator = selected_indicator)
}
})
}
})
}
})
###############################################
observe({
if(!is.null(input$outcome)
& !is.null(input$agegrp)){
selected_outcome <- input$outcome
selected_indicator <- subset(indicators,indicators$label == selected_outcome)
outcome_data <- reactive({
read.csv(curl(as.character(selected_indicator$file)))
})
d <- reactive({outcome_data()})
output$caption <- renderText({
return(paste("You are currently viewing",
ifelse(selected_indicator$rate=="N",paste(input$outcome,".\n",selected_indicator$description),
paste(input$outcome,"(per",selected_indicator$multiplier,"population).\n",selected_indicator$description))))
})
################################################
# Line chart
################################################
output$distPlot2 <- renderChart2({
lineChart(outcome_data(),input$agegrp,selected_indicator)
})
#################################################
# HEATMAP
#################################################
heatmap(outcome_data(),selected_indicator)
}
})
}
shinyApp(ui, server)
Tumaini
#timelyportfolio - It seems dependencies to htmltools was not listed in the DESCRIPTION file of the rcdimple package. Forked the package from https://github.com/timelyportfolio/rcdimple and added the dependencies to the DESCRIPTION file (https://github.com/kilimba/rcdimple). Can now deploy a shiny app which uses the rcdimple package to shinayapps.io. Have made a Pull Request to master branch