kableExtra: set table width on ioslides_presentation - r-markdown

I am using kableExtra on a ioslides_presentation R markdown file.
The table however does not fit the width of the slide:
I am using the following code to generate the table:
library(kable)
library(kableExtra)
data %>%
kable() %>%
kable_styling(c("striped", "hover", "condensed", "responsive"),full_width = FALSE)
I've also tried the argument full_width = TRUE, but was not successful.
How can I force this to happen automatically?

It turns out that it is possible to add a scroll bar to the table.
This can be done using the scroll_box function as follows:
library(kable)
library(kableExtra)
data %>%
kable() %>%
kable_styling(c("striped", "hover", "condensed", "responsive")) %>%
scroll_box(width = "100%")

Related

How to move the caption of table generated by kable function in Rmarkdown to the bottom?

The following simple code in Rmarkdown will generate a table with a caption on top.
library(dplyr)
df <- iris %>% head()
knitr::kable(df, caption = "Table caption is on the top")
Is there any way to move the table caption generated by kable function to the bottom?
Try the package {xtable} which does put table caption at bottom and then pass the xtable object to kableExtra::xtable2kable to turn the xtable object into a kable object and then you have the caption at the bottom of the table.
```{r message=FALSE}
library(dplyr)
library(xtable)
library(kableExtra)
df <- iris %>% head()
xtable(df, caption = "Table caption is on the top") %>%
xtable2kable()
```
The rendered output looks like
To know more about this caption position issue, follow this issue-thread on Github.

How to filter databases in list based on column with different name

I have a list that includes different databases with different informations.
The first column of every database includes the informations that I need to create graphs. I need to filter information based on external vector referred to first column.
For example:
mtcars2 <- mtcars %>% rownames_to_column("cars_model") %>% as.data.frame()
mtcars3 <- mtcars %>% rownames_to_column("cars_model_second") %>% as.data.frame()
list_two_database <- list(mtcars2, mtcars3)
model_to_select <- c("Fiat 128", "Honda Civic", "Lotus Europa")
Is there a way to filter the list based on THE FIRST COLUMN OF EACH DATABASE included in the list (cars_model and cars_model_second) WITHOUT RENAME THE COLUMN ITSELF?
The goal is to obtain a list that includes the two databases each with the three model.
Thank you in advance
The following works by extracting the first column name as a string first_col and then converting this string into a form that can be used within dplyr:
mtcars2 <- mtcars %>% rownames_to_column("cars_model") %>% as.data.frame()
mtcars3 <- mtcars %>% rownames_to_column("cars_model_second") %>% as.data.frame()
list_two_database <- list(mtcars2, mtcars3)
model_to_select <- c("Fiat 128", "Honda Civic", "Lotus Europa")
func = function(df){
first_col = colnames(df)[1]
filter(df, !!sym(first_col) %in% model_to_select)
}
lapply(list_two_database, func)
Notes:
sym(.) is used to turn a text string into a symbol
!! only works inside dplyr commands and turns symbols into variables
Used together you have something like:
var = "my_col"
df %>% filter(!!sym(var) == 1)
Which is equivalent to df %>% filter(my_col == 1)

Select All/Deselect All Option Leaflet for R Overlay

I have a r leaflet map that has multiple layers and each layer can be checked or unchecked. I am trying to find a way to have a select all/deselect all option.
Below is my code where the overlays are reactive groups.
df() is a reactive dataframe
myLocation() is a reactive location (long,lat)
So in the map in the upper right hand corner is where I want a select all/ deselect all option
groups <- reactive({as.character(unique(df()$Folder))})
groupColors <- reactive({
colorFactor(palette = rainbow(length(groups())),
domain = df()$Folder)
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
leaflet::addMarkers(lng=c(myLocation()[1]), lat=c(myLocation()[2]),
popup = paste("Lat/Long: ",myLocation()[2],"/",myLocation()[1]),
popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE))
%>%
############more code here
#this section is where a select all/ deselect option has to be placed
addLayersControl(overlayGroups=groups(),options =
layersControlOptions(collapsed = TRUE))
})
Following shiny tutorial... try using leafletProxy to modify your existing map and use the hideGroup() function from leaflet to add/remove the entire group.

Rmarkdown Shiny Limits

I have a Rmarkdown document with an embedded shiny application (runtime: shiny) which I'd like to upload to shinyapps.io (eventually). When I build the document locally, it fails to completely build, as in the page stops halfway through the document. I've confirmed that if I remove some large leaflet objects in the middle of the document then the build finishes.
I'm working on making the leaflet objects smaller, but I've seen that there is a memory limit on Shiny apps that can be reconfigured (options(shiny.maxRequestSize=30*1024^2) for 30 MB). Supposedly this is supposed to go in the server section of an app, but if the entire document is an app, does this go in the yaml, or in a setup chunk, or somewhere else?
I was able to make an MWE that illustrates my basic environment, though it does not reproduce the error. The maps chunk shows a leaflet map of census tracts for each of the 50 states and DC, and then there's a true shiny app following.
---
title: "Test RMD"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(leaflet)
library(shiny)
library(tigris)
library(htmltools)
library(RColorBrewer)
options(shiny.maxRequestSize=30*1024^2)
```
# leaflet maps
```{r maps, echo=T,results='asis'}
us_states <- unique(fips_codes$state)[1:51] # for small, set to 2
createMaps <- function(state){
stmap <- tracts(state, cb = TRUE)
leaflet(stmap) %>% addTiles() %>% addPolygons()
}
htmltools::tagList(lapply(us_states, function(x) createMaps(x) ))
```
# Shiny application
```{r tabsets, echo=FALSE}
shinyApp(
ui = bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
value = range(quakes$mag), step = 0.1
),
selectInput("colors", "Color Scheme",
rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
),
checkboxInput("legend", "Show legend", TRUE)
)
),
server = function(input, output, session) {
# Reactive expression for the data subsetted to what the user selected
filteredData <- reactive({
quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
})
# This reactive expression represents the palette function,
# which changes as the user makes selections in UI.
colorpal <- reactive({
colorNumeric(input$colors, quakes$mag)
})
output$map <- renderLeaflet({
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
leaflet(quakes) %>% addTiles() %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
})
# Incremental changes to the map (in this case, replacing the
# circles when a new color is chosen) should be performed in
# an observer. Each independent set of things that can change
# should be managed in its own observer.
observe({
pal <- colorpal()
leafletProxy("map", data = filteredData()) %>%
clearShapes() %>%
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
)
})
# Use a separate observer to recreate the legend as needed.
observe({
proxy <- leafletProxy("map", data = quakes)
# Remove any existing legend, and only if the legend is
# enabled, create a new one.
proxy %>% clearControls()
if (input$legend) {
pal <- colorpal()
proxy %>% addLegend(position = "bottomright",
pal = pal, values = ~mag
)
}
})
}
)
```
I guess my main question is if the options() call is going in a place where Shiny can see it. It's also possible that if I made the application itself bigger that it would cause problems; I can try to get to that this evening.

add column with row wise mean over selected columns using dplyr

I have a data frame which contains several variables which got measured at different time points (e.g., test1_tp1, test1_tp2, test1_tp3, test2_tp1, test2_tp2,...).
I am now trying to use dplyr to add a new column to a data frame that calculates the row wise mean over a selection of these columns (e.g., mean over all time points for test1).
I struggle even with the syntax for calculating the mean over explicitly named columns. What I tried without success was:
data %>% ... %>% mutate(test1_mean = mean(test1_tp1, test1_tp2, test1_tp3, na.rm = TRUE)
I would further like to use regex/wildcards to select the column names, so something like
data %>% ... %>% mutate(test1_mean = mean(matches("test1_.*"), na.rm = TRUE)
You can use starts_with inside select to find all columns starting with a certain string.
data %>%
mutate(test1 = select(., starts_with("test1_")) %>%
rowMeans(na.rm = TRUE))
Here's how you could do it in dplyr - I use the iris data as an example:
iris %>% mutate(sum.Sepal = rowSums(.[grep("^Sepal", names(.))]))
This computes rowwise sums of all columns that start with "Sepal". You can use rowMeans instead of rowSums the same way.
Not a dplyr solution, but you can try:
cols_2sum <- grepl('test1',colnames(data))
rowMeans(data[,cols_2sum])