How to use `fp_text_default ` function in flextable package - r-markdown

I see there's a function in flextable package, namely fp_text_default. In help files to this function the only example you can find is
fp_text_default(bold = TRUE)
I was wondering if I can use this function to avoid setting font.size=11 everytime I use custom formatting in my flextables, e.g.
flextable(df) %>%
compose(value = as_paragraph(
as_chunk("foo", props = fp_text(shading.color = "orange", font.size=11))
)) %>%
compose(value = as_paragraph(
as_chunk("bar", props = fp_text(bold = TRUE, font.size=11))
))
The default font.size param in fp_text is 10 and I always have to set it to 11.
Can fp_text_default be used to set font.size to 11 permaently?

You can use set_flextable_defaults() so that you don't have to call again and again fontsize() or some other functions (i.e. padding, color).
https://davidgohel.github.io/flextable/reference/set_flextable_defaults.html
fp_text_default() is a convenient function to overwrite only values that are specified, it keeps other formatting parameters as they are. So far more convenient than fp_text() that force you to specify all params...
Both can be used together...
---
title: "Untitled"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(flextable)
library(magrittr)
set_flextable_defaults(
font.family = "Arial", font.size = 10,
padding = 3, border.color = "gray"
)
```
```{r}
flextable(head(iris)) %>%
append_chunks(
i = 1, j = 1,
as_chunk(" yo", props = fp_text_default(color = "red"))
) %>%
autofit()
flextable(head(mtcars)) %>%
append_chunks(
i = 1, j = 1,
as_chunk(" yo", props = fp_text_default(color = "red"))
) %>%
autofit()
set_flextable_defaults(font.size = 12, padding = 5)
flextable(head(mtcars)) %>%
append_chunks(
i = 1, j = 1,
as_chunk(" yo", props = fp_text_default(color = "red"))
) %>%
autofit()
```

Related

Dynamically generating figures with captions in Word output from Rmarkdown document

I'm trying to generate a Word document with figures. I use {officedown} and {officer} packages. I need to do it dynamically, in a loop since I don't know how many figures there will be. This is my Rmarkdown code:
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
```
```{r}
block_toc(seq_id = "fig")
```
```{r results='asis'}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- lapply(seq_len(length(ttp)), function(i) {
fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]],
external_img(src = tmps[[i]], width = 6, height = 5)
)
})
do.call(block_list, fpars)
```
The problem is when I generate the table of figures in the rendered document. It looks like this:
An entry is kept together with the image itself, I don't know why.
I save temporary png files to be able to use them inside fpar function. Using plot function directly inside fpar causes bad effects. Maybe there's another/better way?
I found this construction useful, but unfortunately it puts captions under the figures by default. My goal is figure captions behave more like table captions, i.e. a caption is above a figure.
```{r fig.cap=unlist(titles)}
plot(iris[1:10, 1:2])
```
How can I generate the plots with captions dynamically with {officedown} or {officer} packages?
The only issue is about the last lapply, you need to put the image in a separate paragraph, so a for loop will be easier to stack 2 paragraphs into a list instead of 1 for each iteration.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- list()
for (i in seq_along(ttp)) {
fpars[[length(fpars)+1]] <- fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]]
)
fpars[[length(fpars)+1]] <- fpar(
external_img(src = tmps[[i]], width = 6, height = 5)
)
}
do.call(block_list, fpars)
```
This is an answer for "how to do it with officer" from scratch.
But the following is much more simple. There is an option fig.topcaption that do the same thing.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r fig.cap = "miaou", fig.topcaption=TRUE}
plot(cars)
```
```{r fig.cap = "ouaf", fig.topcaption=TRUE}
plot(cars)
```

Efficient way of showing Datatables in loop

I have a dataset in which there is a variable named "Variables". I want to display tables in shiny app of each unique value of column "Variables". See the snapshot of image below. I am using it via lapply( ). It works fine. But it takes some time to show tables as I have close to 20 tables. Each table has close to 15 columns. Is there any better way to do it in loop other than lapply( ).
stratsgroups <- Detailed %>% distinct(Variables) %>% pull()
observe({
lapply(stratsgroups, function(x) {
output[[paste0('T_', x)]] <- DT::renderDataTable({
# Data Preparation
data() %>% dplyr::filter(Variables == x) %>% select(2:(ncol(Detailed)-2)) %>%
rename(!!x := !!sym("Categories")) %>%
# ==============
# DT Option
# ==============
datatable(rownames=FALSE,
extensions = c('Buttons', 'FixedColumns'), selection = 'none',
options = list(
columnDefs = list(list(className = 'dt-center', targets = '_all')),
paging = T,
pageLength = 10,
searching = FALSE,
ordering=F,
info = F,
dom = 'Bfrtip',
scrollX = TRUE,
fixedColumns = list(leftColumns = 1),
# Callbacks
rowCallback = lastrow(),
fnDrawCallback = DTpagination(),
# Button
buttons = DTmenuitems(Table_Menu, title)
) )
})
})
})
output$dt <- renderUI({
tagList(lapply(stratsgroups, function(i) {
box(dataTableOutput(session$ns(paste0('T_', i))), width = 12)
}))
})

Flexdashboard and absolute panel on a lealfet

Is there a way to include an absolute panel like in this example (https://shiny.rstudio.com/gallery/superzip-example.html) to a flexdashboard (on a leaflet) ?
The idea would be to have a mobile panel dedicated to the leaflet output instead of a sidebar panel.
The absolute panel example here based on a shiny example (with ui and server parts)
library(shiny)
ui <- shinyUI(bootstrapPage(
absolutePanel(
id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
HTML('<button data-toggle="collapse" data-target="#demo">Collapsible</button>'),
tags$div(id = 'demo',
checkboxInput('input_draw_point', 'Draw point', FALSE ),
verbatimTextOutput('summary')))
))
server <- shinyServer(function(input, output, session) {
output$summary <- renderPrint(print(cars))
})
shinyApp(ui = ui, server = server)
a code example below for the Flexdashboard part :
---
title: "Waste Lands - America's forgotten nuclear legacy"
author: Philipp Ottolinger
output:
flexdashboard::flex_dashboard:
theme: journal
social: menu
source_code: embed
---
```{r setup, include = FALSE}
library(flexdashboard)
library(shiny)
library(jsonlite)
library(maptools)
library(ggplot2)
library(tidyr)
library(dplyr)
library(purrr)
library(leaflet)
library(plotly)
sites <- fromJSON(flatten=TRUE,
"https://raw.githubusercontent.com/ottlngr/2016-15/ottlngr/ottlngr/sites.json")
sites$locations <- map(sites$locations, function(x) {
if (nrow(x) == 0) {
data_frame(latitude=NA, longitude=NA, postal_code=NA, name=NA, street_address=NA)
} else {
x
}
})
sites <- unnest(sites)
sites <- sites[complete.cases(sites[,c("longitude", "latitude")]),]
sites$ratingcol <- ifelse(sites$site.rating == 0, "orange",
ifelse(sites$site.rating == 1, "green",
ifelse(sites$site.rating == 2, "red", "black")))
sites$ratingf <- factor(sites$site.rating,
levels=c(3:0),
labels=c("Remote or no potential for radioactive contamination.",
"No authority to clean up or status unclear.",
"Cleanup declared complete.",
"Cleanup in progress."))
sites$campus <- ifelse(grepl("University", sites$site.name) |
grepl("University", pattern = sites$street_address) |
grepl("Campus", sites$street_address), 1, 0)
sites$campuscol <- ifelse(sites$campus == 1, "red", "black")
```
Column {data-width=650}
-----------------------------------------------------------------------
### All sites and their current status
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites$longitude,
sites$latitude,
color = sites$ratingcol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites$site.city,
sites$site.name,
sep = "")) %>%
addLegend("bottomleft",
colors = c("orange","green", "red", "black"),
labels = c("Cleanup in progress.",
"Cleanup complete.",
"Status unclear.",
"No potential for radioactive contamination."),
opacity = 0.8)
```
Column {data-width=350}
-----------------------------------------------------------------------
### Number of sites
```{r}
sites %>%
count(ratingf) %>%
plot_ly(type = "bar",
x = ratingf,
y = n,
color = ratingf,
text = paste(n,ratingf,sep=""),
hoverinfo = "text") %>%
layout(xaxis = list(showline = F,
showticklabels = F,
fixedrange = T,
title = ""),
yaxis = list(fixedrange = T,
title = ""))
```
### Sites on campus
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites[sites$campus == 1, ]$longitude,
sites[sites$campus == 1, ]$latitude,
color = sites[sites$campus == 1, ]$campuscol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites[sites$campus == 1, ]$site.city,
sites[sites$campus == 1, ]$site.name,
sep = ""))
```
Thanks
Try this.
---
title: "haha"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
editor_options:
chunk_output_type: console
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(flexdashboard)
library(shiny)
library(leaflet)
```
# without container-fluid
### Sites on campus
```{r}
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
renderLeaflet(mapfunction())
```
```{r}
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto',
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
```
### server
```{r}
mapfunction <- reactive({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
```
# with container-fluid
```{r}
shinyApp(
fluidPage(
leafletOutput(outputId = "somemap"),
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto', fixed = TRUE,
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
),
server = function(input, output, session){
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
output$somemap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
}
)
```
If you need to use interactive components from shiny, like XXinput, you need to specify runtime: shiny on the top, otherwise, you can delete this line.
I use reactive as the simplest server part. If you want to use a more complex server (logic), e.g. several components interact together, you need to write the actual server function. I would suggest just write a shiny app instead of a flexdashboard.
unfortunately, components in flexdash are not inside container-fluid class which with this can allow you to drag the panel. There may be a way to work around, you can search for it. Look at the last chunck, I inserted a actual shiny app and the panel is draggable. You should see two tabs when you run the doc, watch the difference. So, if you really want to drag this panel, you should write a "real" shiny app.

R Shiny App working locally but not on shinyapps.io

I have seen that this problem has happened to other people, but their solutions have not worked for me. I have my app.R file and a .RData file with the required inputs in the same ECWA_Strategic_Planning_Tool directory. When I run:
library(rsconnect)
rsconnect::deployApp('C:/Users/mikialynn/Documents/Duke/Spring2017/MP/GISTool/Final/ECWA_Strategic_Planning_Tool')
I get the following error on the web page that opens up:
ERROR: An error has occurred. Check your logs or contact the app author for clarification.
However, I cannot find anything wrong. I install all of my packages, I use relative pathways etc. I am pasting all of the code from my app below. If anyone can spot what I'm doing wrong, I would greatly appreciate it!
library(shiny)
library(leaflet)
library(sp)
library(rgdal)
library(rstudioapi) # For working directory
library(raster)
library(RColorBrewer)
library(rgeos) #Maybe use gSimplify to simplify polygon
library(DT) #To make interactive DataTable
library(plotly) #For pie chart
library(ggplot2) # for layout
# Set Working Directory
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
# Load R Workspace
load('Shiny.Strategies.RData')
# UI variables
neigh.names <- levels(merge.proj$View)
neigh.default <- c("Urban7")
dt.names <- c('PARCEL_ID', 'PIN', 'OWNER_NAME', 'SITE_ADDRE', 'OWNER_ADDR',
'SUM_ACRE', 'LANDUSE_DE', 'LAND_VALUE', 'TOTAL_VALU', 'SALE_PRICE',
'Pluvial_WtScore', 'Rest_WtScore', 'GI_WtScore', 'SC_WtScore',
'UNCWI_WtScore', 'Total_Score', 'View')
dt.default <- c('PARCEL_ID', 'Pluvial_WtScore', 'Rest_WtScore',
'GI_WtScore', 'SC_WtScore', 'UNCWI_WtScore', 'Total_Score', 'View')
# Build UI
ui <- fluidPage(
titlePanel("ECWA Strategic Planning Tool"),
HTML('<br>'),
column(2,
HTML("<strong>Instructions:</strong><br/><br/>"),
HTML("<p>1) Select weights for parameters and click 'Run' to
initiate tool.<br/><br/>
2) Use rightside panel to adjust Table and Map Settings.<br/>
<br/>
3) Use search/sort functions of Table to identify parcels.
Select row to display Total Score Chart.<br/><br/>
4) Input View and Parcel ID from Table to Map settings to
identify parcel in Map.<br/><br/>
5) When satisfied with weights, click 'Export Shapefile' to
save shapefile of all parcels.<p/><br/>"),
HTML("<strong>Calculate Parcel Scores: </strong><br/>"),
helpText('The sum of the weights must equal to 1.'),
sliderInput(inputId = "weightPluvial", label = "Weight for Pluvial
Flooding",
value = 0.20, min = 0, max = 1),
sliderInput(inputId = "weightRest", label = "Weight for
Restoration",
value = 0.20, min = 0, max = 1),
sliderInput(inputId = "weightGI", label = "Weight for Green
Infrastructure",
value = 0.20, min = 0, max = 1),
sliderInput(inputId = "weightSC", label = "Weight for City
Stormwater Controls",
value = 0.20, min = 0, max = 1),
sliderInput(inputId = "weightUNCWI", label = "Weight for UNCWI",
value = 0.20, min = 0, max = 1),
actionButton("run", "Run"),
actionButton("export", "Export Shapefile")),
column(8,
HTML("<h3><strong>Table Summary</strong></h3>"),
HTML("<br>"),
dataTableOutput("table")),
column(2,
HTML("<p><br><br></p>"),
HTML("<h4>Table Settings:</h4>"),
checkboxGroupInput(inputId = 'show_vars', label = 'Select column(s)
to display in Table:', choices = dt.names, selected = dt.default),
HTML("<strong>Total Score Chart:</strong>"),
helpText("Please select Table row to display pie chart."),
plotlyOutput("pie")
),
fluidRow(
column(8, offset = 2,
HTML("<br>"),
HTML("<h3><strong>Map Display</strong></h3>"),
leafletOutput("map", height = 800),
HTML("<br><br>")),
column(2,
HTML("<p><br><br><br></p>"),
HTML("<h4>Map Settings:</h4>"),
checkboxGroupInput(inputId = 'show_neigh', label = 'Select
View(s) to display in Map:', choices = neigh.names,
selected = neigh.default),
HTML("<br>"),
sliderInput("range", "Select score range to display in Map:", min
= 0.0, max= 10.0, value = as.numeric(c("0.0", "10.0")), step = 0.1),
HTML("<br>"),
HTML("<strong>Parcel Zoom:</strong>"),
helpText("The View and Score Range must contain the parcel of
interest to execute zoom."),
numericInput('parcel','Enter Parcel ID',0)
)
))
# SERVER
server <- function(input, output) {
defaultData <-
eventReactive(input$run, {
# Multiply by Weights
merge.proj#data$Pluvial_WtScore <-
round(merge.proj#data$Pluvial_Score*input$weightPluvial, digits = 1)
merge.proj#data$Rest_WtScore <-
round(merge.proj#data$Rest_Score*input$weightRest, digits = 1)
merge.proj#data$GI_WtScore <-
round(merge.proj#data$GI_Score*input$weightGI, digits = 1)
merge.proj#data$SC_WtScore <-
round(merge.proj#data$SC_Score*input$weightSC, digits = 1)
merge.proj#data$UNCWI_WtScore <-
round(merge.proj#data$UNCWI_Score*input$weightUNCWI, digits = 1)
# Find Total Score
merge.proj#data$Total_Score <- merge.proj#data$Pluvial_WtScore +
merge.proj#data$Rest_WtScore + merge.proj#data$GI_WtScore +
merge.proj#data$SC_WtScore + merge.proj#data$UNCWI_WtScore
return(merge.proj)
})
# Subset by neighborhood
neighData <- reactive ({
merge.proj <- defaultData()
merge.proj[merge.proj$View%in%input$show_neigh,]
})
# Plot with leaflet
# Palette for map
colorpal <- reactive({
merge.proj <- neighData()
colorNumeric(palette = "YlOrRd",
domain = merge.proj$Total_Score)
})
# Pop Up Option for map
# popup <- paste0("<strong>Parcel ID: </strong>",
# merge.proj#data$PARCEL_ID,
# "<br><strong>Total Score: </strong>",
# merge.proj#data$Total_Score)
# Label Option for map
labels <- reactive({
merge.proj <- neighData()
sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score:
</strong>%g",
merge.proj$PARCEL_ID,
merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})
# Render Default Map
output$map <- renderLeaflet ({
merge.proj <- neighData()
pal <- colorpal()
lab <- labels()
leaflet() %>%
#addProviderTiles(provider='Esri.WorldImagery') %>%
# setView(zoom =) %>%
addTiles() %>%
addPolygons(
#data = merge.proj[input$show_neigh,, drop = FALSE],
data=merge.proj,
fillColor = ~pal(Total_Score),
weight = 1,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 3,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
# popup= popup) %>%
label = lab,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(position = "bottomleft",pal = pal, opacity = 0.7, values =
merge.proj$Total_Score, title = "<strong>Total Score</strong>")
})
# Build Data Table
output$table <- renderDataTable({
merge.proj <- defaultData()
table.dat <- merge.proj[, c('PARCEL_ID', 'PIN', 'OWNER_NAME',
'SITE_ADDRE', 'OWNER_ADDR', 'SUM_ACRE', 'LANDUSE_DE', 'LAND_VALUE',
'TOTAL_VALU', 'SALE_PRICE', 'Pluvial_WtScore', 'Rest_WtScore', 'GI_WtScore',
'SC_WtScore', 'UNCWI_WtScore', 'Total_Score', 'View')]
datatable(data = table.dat#data[, input$show_vars, drop = FALSE],
options = list(lengthMenu = c(5, 10, 20, 30), pageLength = 20), rownames =
FALSE)
})
# Plot-ly
output$pie <- renderPlotly({
merge.proj <- defaultData()
names <- c('Pluvial', 'Rest', 'GI', 'SC', 'UNCWI')
colors <- c('rgb(128,133,133)', 'rgb(211,94,96)', 'rgb(144,103,167)',
'rgb(114,147,203)', 'rgb(171,104,87)')
selectedrowindex <-
input$table_rows_selected[length(input$table_rows_selected)]
selectedrowindex <- as.numeric(selectedrowindex)
df <- data.frame(merge.proj[selectedrowindex, c('Pluvial_WtScore',
'Rest_WtScore', 'GI_WtScore', 'SC_WtScore', 'UNCWI_WtScore')])
vector <- unname(unlist(df[1,]))
if (!is.null(input$table_rows_selected)) {
par(mar = c(4, 4, 1, .1))
plot_ly(labels = names, values = vector, type = 'pie',
textposition = 'inside',
textinfo = 'label+percent',
insidetextfont = list(color = '#FFFFFF'),
hoverinfo = 'text',
text = ~paste('Score:', vector),
marker = list(colors = colors,
line = list(color = '#FFFFFF', width = 1)),
#The 'pull' attribute can also be used to create space between the sectors
showlegend = FALSE) %>%
layout(#title = '% Total Score',
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
}
else {return(NULL)}
})
# Update map to parcel score slider
# Subset data
filteredData <- reactive({
merge.proj <- neighData()
merge.proj[merge.proj#data$Total_Score >= input$range[1] &
merge.proj#data$Total_Score <= input$range[2],]
})
# New Palette
colorpal2 <- reactive({
merge.proj <- filteredData()
colorNumeric(palette = "YlOrRd",
domain = merge.proj$Total_Score)
})
# Pop Up Option
# popup <- paste0("<strong>Parcel ID: </strong>",
# merge.proj#data$PARCEL_ID,
# "<br><strong>Total Score: </strong>",
# merge.proj#data$Total_Score)
# Label Option
labels2 <- reactive({
merge.proj <- filteredData()
sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score:
</strong>%g",
merge.proj$PARCEL_ID,
merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})
#Leaflet Proxy
observe({
merge.proj <- filteredData()
pal2 <- colorpal2()
lab2 <- labels2()
leaf <- leafletProxy("map", data = filteredData()) %>%
clearShapes() %>%
addPolygons(
fillColor = ~pal2(Total_Score),
weight = 1,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 3,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
# popup= popup) %>%
label = lab2,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))
if(input$parcel>0){
sub.dat <- merge.proj[merge.proj$PARCEL_ID==input$parcel,]
zx <- mean(extent(sub.dat)[1:2])
zy <- mean(extent(sub.dat)[3:4])
leaf <- leaf %>%
setView(lng=zx,lat=zy,zoom=16)
}
leaf
})
#Update Legend
observe({
proxy <- leafletProxy("map", data = filteredData())
pal2 <- colorpal2()
proxy %>% clearControls()
proxy %>% addLegend(position = "bottomleft",pal = pal2, opacity = 0.7,
values = ~Total_Score, title = "<strong>Total Score</strong>")
})
# Export new shapefile
#make so that user can choose name and allow overwrite
observeEvent(input$export, {
merge.proj <- defaultData()
writeOGR(merge.proj, dsn = "Data", layer = "Strategies_Output", driver =
"ESRI Shapefile")
})
}
shinyApp(ui = ui, server = server)
Issue resolved! My initial suspicion was correct; it had to do with the .rdata file. It also relates to shinyapp.io's servers which run on a Linux based server. From my reading, Linux only handles lowercase file paths and extensions. The reason why it worked for the .csv file is because it's pretty common to have the file extension saved in all lowercase. This was not the case for the .RData file. Using the RStudio IDE and the physical "Save Workspace" button, the default file extension is .RData (case sensitive). I couldn't rename the file extension (for some reason, I'm not the most tech-savvy person). Similar to the load() function, there's the save() function. Previously, I used the save() file as follows (note the capitalized .RData at the end):
save(df_training_separated_with_models, file = "sample_data_with_models.RData")
However, using the same function in all lowercase fixes the issue:
save(df_training_separated_with_models, file = "sample_data_with_models.rdata")
Hope this helps any other poor soul with the same issue that is scouring the internet and other forums.
Cheers!

Create slide with render dynamically in Rmarkdown shiny presentation

I want to produce slide dynamically in my Rmarkdown presentation with shiny
Here below the code works.
But as soon as I uncomment the for loop it doesn't.
---
title: "dynamic_plots"
output: ioslides_presentation
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
```{r, echo = FALSE, results = "asis"}
number_of_bins_selected <- c(20,30)
i <- 1 # If for loop commented
#for (i in 1:length(number_of_bins_selected)) {
cat("## New slide \n")
input1_id <- paste(i, "nbreaks", sep = "_")
input2_id <- paste(i, "bw_adjust", sep = "_")
inputPanel(
selectInput(input1_id, label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = number_of_bins_selected[i]),
sliderInput(input2_id, label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
renderPlot({
hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input[[input1_id]]),
xlab = "Duration (minutes)", main = "Geyser eruption duration")
dens <- density(faithful$eruptions, adjust = input[[input2_id]])
lines(dens, col = "blue")
})
cat(" \n\n") # End the slide
#}
```
Isn't it possible to create slides on a for loop ?