Related
Please see attached image. Do you have suggestions how to avoid that the plot is outside the white area, or to make the grey area below the plot white?
ui <- dashboardPage(
# Application title
dashboardHeader(title=h4(HTML("Virus Coverage plot"))),
dashboardSidebar(
useShinyjs(),
selectInput("Taxa", "Taxa", choices = unique(files.Vir.DNA.df.test$V1))
),
dashboardBody(
tabsetPanel(
tabPanel("Taxa", plotOutput("myplot1"))
)
)
)
server <- function(input, output, session) {
data_selected <- reactive({
filter(files.Vir.DNA.df.test, V1 %in% input$Taxa)
})
output$myplot1 <- renderPlot({
#data_selected() %>%
# filter(Cancer=="Anus" | Cancer=="Cervix") %>%
p <- ggplot(data_selected(),aes(position,rowSums, fill = V1)) +
#theme_bw(base_size = 6) +
geom_bar(stat="identity") +
facet_grid(Cancer~. , scales = "free_x", space = "free_x", switch = "x") +
theme(strip.text.y = element_text(angle = 0),
strip.text.x = element_text(angle = 90),
strip.background = element_rect(colour = "transparent", fill = "transparent"),
plot.background = element_rect(colour = "white", fill = "white"),
panel.background = element_rect(colour = "white", fill = "white"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
labs(y="Sum coverage within cancer type", x="", title="") +
scale_fill_manual(values=mycolors) +
theme(legend.position = "none")
#scale_y_log10()
print(p)
},res = 100,width = 600, height = 1200)
}
shinyApp(ui, server)
Your example isn't reproducible - so I made a new one.
You just need to wrap the plotOutput in a fluidRow:
library(shiny)
library(ggplot2)
library(datasets)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
# dashboardBody(plotOutput("myplot")) # exceeds body
dashboardBody(fluidRow(plotOutput("myplot"))) # works
)
server <- function(input, output, session) {
output$myplot <- renderPlot({
scatter <- ggplot(data=iris, aes(x = Sepal.Length, y = Sepal.Width))
scatter + geom_point(aes(color=Species, shape=Species)) +
xlab("Sepal Length") + ylab("Sepal Width") +
ggtitle("Sepal Length-Width")
}, height = 1200)
}
shinyApp(ui, server)
Whoever come across with JMP agrees that its model profiler is the best thing you can find on that software.
Simply is a series of interactive plots of the model (I don't think there is a better way to communicate an additive model - looks like the one below)
Now, I would like to have something similar in my html rmarkdown reports.
It seems that might be possible to add rshiny on rmarkdows so I've managed to get something like the below on RShiny.
library(tidyverse)
library(shiny)
inputData <- mtcars
lm1 <- lm(mpg ~ hp + I(hp^2) + wt * cyl, data = mtcars)
ui <- fluidPage(
titlePanel("Profiler"),
sidebarLayout(
sidebarPanel(
helpText("Choose the level of each factor"),
sliderInput("var_1", label= paste(names(inputData)[2]),
min = min(inputData[,2]),
max = max(inputData[,2]),
value = mean(inputData[,2]),
step = diff(range(inputData[,2]))/50),
sliderInput("var_2", paste(names(inputData)[6]),
min = min(inputData[,6]),
max = max(inputData[,6]),
value = mean(inputData[,6]),
step = diff(range(inputData[,6]))/50),
sliderInput("var_3", paste(names(inputData)[4]),
min = min(inputData[,4]),
max = max(inputData[,4]),
value = mean(inputData[,4]),
step = diff(range(inputData[,4]))/50)
),
mainPanel(
tableOutput('table_pred'),
plotOutput("plot2"),
plotOutput("plot3"),
plotOutput("plot1")
)
)
)
server <- function(input, output) {
# Data declaration
data <- reactive({
req(input$var_1, input$var_2,input$var_3)
data.frame(cyl = input$var_1, wt = input$var_2, hp = input$var_3)
})
# The new predicted value for the specific input
pred <- reactive({
predict(lm1, data(), se = T, interval="confidence", level=0.95)$fit %>% as_tibble() %>%
rename(Prediction = fit, `Lower limit` = lwr, `Upper limit` = upr)
})
# Present as table the outcome of specific inputs
output$table_pred <- renderTable({
pred()
})
# Prepare the plots
# Create the continuum space for the predictors
hp_space <- reactive({
seq(min(mtcars$hp), max(mtcars$hp), length.out = 1e3)
})
cyl_space <- reactive({
seq(min(mtcars$cyl), max(mtcars$cyl), length.out = 1e3)
})
wt_space <- reactive({
seq(min(mtcars$wt), max(mtcars$wt), length.out = 1e3)
})
# Perform predictions for each point
new_pred_hp <- reactive({
temp <- tibble(hp = hp_space(), cyl = input$var_1, wt = input$var_2 )
temp %>%
bind_cols(predict(lm1, newdata = temp,
se = T, interval="confidence", level=0.95)$fit %>% as_tibble)%>%
mutate(Predictor = 'hp')
})
new_pred_cyl <- reactive({
temp <- tibble(hp = input$var_3, cyl = cyl_space(), wt = input$var_2 )
temp %>%
bind_cols(predict(lm1, newdata = temp,
se = T, interval="confidence", level=0.95)$fit %>% as_tibble)%>%
mutate(Predictor = 'cyl')
})
new_pred_wt <- reactive({
temp <- tibble(hp = input$var_3, cyl = input$var_1, wt = wt_space())
temp %>%
bind_cols(predict(lm1, newdata = temp,
se = T, interval="confidence", level=0.95)$fit %>% as_tibble) %>%
mutate(Predictor = 'wt')
})
# Make one plot per predictor
output$plot1 <- renderPlot({
ggplot(new_pred_hp(), aes( x = hp, y = fit)) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.1, fill = 'red') +
geom_line(size = 1, color = 'black')+
geom_vline(xintercept = input$var_3, colour = 'red', linetype = 'dashed')
})
output$plot2 <- renderPlot({
ggplot(new_pred_cyl(), aes( x = cyl, y = fit)) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.1, fill = 'red') +
geom_line(size = 1, color = 'black')+
geom_vline(xintercept = input$var_1, colour = 'red', linetype = 'dashed')
})
output$plot3 <- renderPlot({
ggplot(new_pred_wt(), aes( x = wt, y = fit)) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.1, fill = 'red') +
geom_line(size = 1, color = 'black')+
geom_vline(xintercept = input$var_2, colour = 'red', linetype = 'dashed')
})
}
shinyApp(ui, server)
Which looks like that,
Questions:
Is there a more elegant way to get these results on html rmarkdown? (maybe with HTML widgets so as to avoid rshiny?)
How to add all this complicated rshiny code (for my intro level) into rmarkdown report?
Thanks.
I tried to publish an R Shiny app but I got this error 1
I don't know what to do
ps: I have updated all the libraries that I use inside the code but still nothing I get the same error
would you please help me!
I am using the following code:
library(shiny)
library(dplyr)
library(rgdal)
library(leaflet)
library(shinyWidgets)
library(shinydashboard)
basin <- readOGR("data/basin.kml", "basin")
map_allocator1 <- read.csv('data/map_allocator1.csv')
map_allocator2 <- read.csv('data/map_allocator2.csv')
map_allocator3 <- read.csv('data/map_allocator3.csv')
tour_polyline <- readOGR("data/tour1.kml", "tour1")
info_360<- read.csv('data/360_photos.csv')
ui <-
fluidPage(theme = "mystyle.css",
sidebarLayout(
sidebarPanel(
tags$head(
tags$style(HTML(".main-sidebar {background-color: #D6E3F0!important;}")))
,
sliderTextInput(
inputId = "mySliderText",
label = "Story line",
grid = TRUE,
force_edges = TRUE,
choices = c('1','2','3','4','5','6')
)
,br(),br()
,
(leafletOutput("story_map")),
htmlOutput("frame2")
),
mainPanel(
tags$head(tags$style("#current_info{
margin-left:20px;
margin-right:10px;
}"
)
)
,
valueBoxOutput("story_line_valubox"),
htmlOutput("frame")
,
div(id='box1', "Infromation about the current location")
,
htmlOutput("frame1")
#uiOutput("current_info")
)
)
)
server <- function(input, output) {
printmap <- reactive({
if (input$mySliderText %in% info_360$press )
{
info_360 %>%
filter(press == input$mySliderText)
}
})
printingvaluebox <- reactive({
if (input$mySliderText %in% info_360$press )
{
info_360 %>%
filter(press == input$mySliderText) %>%
pull(valuebox)
}
})
output$story_map<- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.Watercolor",options = providerTileOptions(minZoom=6, maxZoom=6)) %>%
addPolygons(data = basin,color = "black",weight = 2,opacity = 1,fillOpacity = 0.05 )%>%
addCircleMarkers(data = map_allocator1,
lat = ~lat, lng = ~lon,
label = ~no,
radius = 8, fillOpacity = 3/4, stroke = FALSE, color = 'steelblue',
labelOptions = labelOptions(noHide = TRUE, offset=c(0,0), textOnly = TRUE)
)%>%
addCircleMarkers(data = map_allocator2,
lat = ~lat, lng = ~lon,
label = ~no,
radius = 8, fillOpacity = 3/4, stroke = FALSE, color = 'red',
labelOptions = labelOptions(noHide = TRUE, offset=c(0,0), textOnly = TRUE)
)%>%
addCircleMarkers(data = map_allocator3,
lat = ~lat, lng = ~lon,
label = ~no,
radius = 8, fillOpacity = 3/4, stroke = FALSE, color = 'yellow',
labelOptions = labelOptions(noHide = TRUE, offset=c(0,0), textOnly = TRUE)
)%>%
addPolylines(data=tour_polyline, color = "red",weight = 1,opacity = 1)%>%
addMarkers(data=printmap())
})
output$story_line_valubox <- renderValueBox({
valueBox(
printingvaluebox(),
width = 7,
"Current Excursion Station",
color = "blue"
)
})
output$story_line_map<- renderLeaflet({
leaflet() %>%
addProviderTiles("Esri.WorldImagery",options = tileOptions(minZoom = 3 , maxZoom = 16)) %>%
setView(lng=printmap()$lon, lat=printmap()$lat, zoom=printmap()$zoom_level)
})
selectHtml <- reactive({
if (input$mySliderText ==1)
{
return(("trial1.html"))
}
else
{
return(("triaL2.html"))
}
})
frame_link<- reactive({
if (input$mySliderText %in% info_360$press )
{
info_360 %>%
filter(press == input$mySliderText) %>%
pull(mapox)
}
})
output$frame <- renderUI({
tags$iframe(src=frame_link(), height=700, width=1000)
})
output$frame1 <- renderUI({
tags$iframe(src=selectHtml(), height=700, width=1000)
})
output$frame2 <- renderUI({
tags$iframe(src='carousel.html', height=390, width=575, style="position:relative; top: 20px; left: 0px;")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have published 3 apps in R Shiny and all of them were successfully completed, this time I don't know what is the exact problem!
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)
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