I would like to incorporate a custom font in my Rshiny App. I have a hunch the code would go in tags$style, but haven't the actual code to include this.
Example code:
ui <- fluidPage(
tags$style( ),
column(12,
dataTableOutput("testtab")
) # close column
) #close fluidpage
server <- function(input, output, session) {
output$testtab <-
DT::renderDataTable({
tab <- data.frame(a = 1:10, b = 11:20, c = 21:30)
dat.tab <- datatable(tab) %>% formatPercentage('a', 0) %>%
formatCurrency(1:ncol(tab), '$')
return(dat.tab)
}) # close renderDataTable
} # close server
shinyApp(ui=ui, server=server)
For example's sake, let's say I want to use any custom font out there on the web.
This should help.
First you need to download the font from http://www.fontspace.com/gunarta/surabanglus and install it by clicking on the file with the ttf extension and clicking install. Here I have added tags to control the default body font, and tags that use the "id tag" to control the fonts in specific controls and the background colors.
There are other ways to do this using seperate CSS files, etc. But this is quick and easy and not too dirty.
library(shiny)
library(dplyr)
library(DT)
ui <- fluidPage(
tags$style(HTML('body {font-family:"Times New Roman",Georgia,Serif; background-color:orange}')),
tags$style(HTML('#testtab {font-family:"surabanglus",Georgia,Serif; background-color:lightblue}')),
tags$style(HTML('#hello2 {font-family:"Courier",Georgia,Serif; background-color:pink}')),
column(12,
dataTableOutput("testtab"),
actionButton("hello1","Hello There (uses font inherited from body)"),
actionButton("hello2","Hello There again (uses Courier)")
) # close column,
) #close fluidpage
server <- function(input, output, session) {
output$testtab <- DT::renderDataTable({
tab <- data.frame(a = 1:10, b = 11:20, c = 21:30)
dat.tab <- datatable(tab) %>% formatPercentage('a', 0) %>%
formatCurrency(1:ncol(tab), '$')
return(dat.tab)
}) # close renderDataTable
} # close server
shinyApp(ui=ui, server=server)
Yielding this:
Related
I am trying to split a dataframe based on a grouping variable and then display each group as a table in a separate box in a shiny dashboard app.
However, I keep getting the same group in all the tables. The title for each box is shown correctly though and if I introduce some print statements I can also see that the correct data seems to be handled.
Below is an example that reproduces the problem:
library(tidyverse)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("tables"))
)
server <- function(input, output) {
output$tables <- renderUI({
df <- iris %>%
group_by(Species) %>%
group_split()
ui <- tagList()
for(df.split in df) {
id <- paste0("tbl_", df.split[1, "Species"])
output[[id]] <- renderTable(head(df.split, 3))
ui <- append(
ui,
box(
title = df.split[1, "Species"],
tableOutput(id)
)
)
}
return(ui)
})
}
shinyApp(ui = ui, server = server)
It is an interesting case. I think this should work, tell me if it is not :
library(tidyverse)
library(shiny)
library(shinydashboard)
multiple_dt <- function(output,id,table_list){
ns <- NS(id)
ui <- tagList(lapply(table_list,function(df.split){
box(
title = as.character(df.split[1, "Species"]),
tableOutput(ns(as.character(df.split[1,"Species"]))),
output[[ns(df.split[1,"Species"])]] <- renderTable(head(df.split, 3))
)
}))
ui
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("tables"))
)
server <- function(input, output) {
output$tables <- renderUI({
df <- iris %>%
group_by(Species) %>%
group_split()
multiple_dt(output,"tables",df)
})
}
shinyApp(ui = ui, server = server)
I think there are multiple errors in your code. First of all, I think that your appending is not working correctly because the tables to be rendered are not well stored in the list (they are just successively stored while there should be a hierarchical dimension, which is made in the function multiple_dt with the lapply).
Moreover, when you create complicated shiny objects like this one, you should create a new function to render it, like I did with a structured code having an NS id, etc.
I would like to use a Shiny interface to collect data from user inputs, such as in this Medium Article
The article is written for the googlesheets package, but we now need to use googlesheets4.
I think my code will not work due to may lay of understanding of reactive elements.
#load libraries
library(shiny)
library(shinydashboard)
library(googlesheets4)
library(DT)
ui <- fluidPage(
# Define UI
ui <- fluidPage(
# App title ----
titlePanel("Seflie Feedback"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(
# Input: Overall Rating
sliderInput(inputId = "helpful",
label = "I think this app is helpful",
min = 1,
max = 7,
value = 3),
actionButton("submit", "Submit")
),
mainPanel(
))
)
)
server <- function(input, output, session) {
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
usefulRating <- input$helpful
Data <- data.frame(
Value = as.character(usefulRating),
stringsAsFactors = FALSE)
})
#This will add the new row at the bottom of the dataset in Google Sheets.
observeEvent(input$submit, {
MySheet <- gs4_find() #Obtain the id for the target Sheet
MySheet <- gs4_get('https://docs.google.com/spreadsheets/d/162KTHgd3GngqjTm7Ya9AYz4_r3cyntDc7AtfhPCNHVE/edit?usp=sharing')
sheet_append(MySheet , data = Data)
})
}
shinyApp(ui = ui, server = server)
I replaced the gs4_get() with the link rather than the ID to support you in helping me. If you are not able to access the link, you can replace the link with a google sheet ID from your own sheets temporarily.
When I run the code, I see the following: Warning: Error in is.data.frame: object 'Data' not found.
When I replace the usefulRating <- input$helpful with usefulRating <- 4 or usefulRating <- 5 or some other value, the data writes to the Sheet.
Thanks for any insights :)
#load libraries
library(shiny)
library(shinydashboard)
library(googlesheets4)
library(DT)
ui <- fluidPage(
titlePanel("Seflie Feedback"),
sidebarLayout(
sidebarPanel(
#This is where a user could type feedback
textInput("feedback", "Plesae submit your feedback"),
),
#This for a user to submit the feeback they have typed
actionButton("submit", "Submit")),
mainPanel())
server <- function(input, output, session) {
textB <- reactive({
as.data.frame(input$feedback)
})
observeEvent(input$submit, {
Selfie <- gs4_get('https://docs.google.com/spreadsheets/d/162KTHgd3GngqjTm7Ya9AYz4_r3cyntDc7AtfhPCNHVE/edit?usp=sharing')
sheet_append(Selfie, data = textB())
})
}
shinyApp(ui = ui, server = server)
When a DT datatable initilaly renders in a shiny app it appears to grow from the top and push all other elements down the page. Is there a way to render the datatable more smoothly so that other elements are not pushed out of the way like this?
You can see in the example code the h1 renders first at the top of the screen and is then pushed down when the datatable renders. I have tried creating a div with minimum height for the table but it didn't work.
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput('table'),
h1('placeholder text'))
server <- function(input, output, session) {
my_data <-
data.frame(
a = rnorm(5000),
b = rnorm(5000),
c = rnorm(5000),
d = rnorm(5000)
)
output$table <- DT::renderDataTable({
datatable(my_data, options = list(pageLength = 25))
})
}
shinyApp(ui, server)
There is some nice functionality in the DT package to reload data smoothly when the data changes after the initial render (using replaceData()). However, I cannot seem to render the data smoothly initially.
So, you can define a height in pixels, but that may not match the pageLength argument you made on the server. I think if you want to control the height in the rendering of the page, the best way to do that is to define height in pixels, not page length. This way the height gets enforced when the page is being loaded AND when the table gets rendered:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput('table', height = "500px"),
h1('placeholder text'))
server <- function(input, output, session) {
my_data <-
data.frame(
a = rnorm(5000),
b = rnorm(5000),
c = rnorm(5000),
d = rnorm(5000)
)
output$table <- DT::renderDataTable({
datatable(my_data)
})
}
shinyApp(ui, server)
I'm creating a Shiny app which displays images and text in a data table. This table will need to update depending on the user's input. When I run the app in a window the table updates as expected. However, when I run it in a browser the text updates but the image does not. How do I make it work in a browser?
EDIT: For clarity, the below example is just to reproduce the issue. The real app could display any number of different pictures, which aren't saved locally until the user makes a selection (they're pulled from a database). I was hoping to avoid having different filenames because I could potentially end up with hundreds of thousands of pictures saved locally, but if that's the only solution then I will have to cleanup the folder periodically
Reproducible example (requires 2 local images)
library(shiny)
library(imager)
library(DT)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Tables to export"),
sidebarLayout(
sidebarPanel(
actionButton("pic1","Pic1"),
actionButton("pic2","Pic2")
),
# Show tables
mainPanel(
fluidRow(
dataTableOutput('tab1')
)
)
)
)
# Define server logic
server <- function(input, output) {
observeEvent(input$pic1, {
pic <- load.image("www/pic1.png")
save.image(pic,"www/picToShow.png")
tab1 <- datatable(t(data.frame("Pic"='<img src="picToShow.png" width=150 height=100>',x1=1,x2=2,x3=3,row.names="p1")),
escape = F, options = list(dom = 't',pageLength = 20))
output$tab1 <- renderDataTable(tab1)
})
observeEvent(input$pic2, {
pic <- load.image("www/pic2.png")
save.image(pic,"www/picToShow.png")
tab1 <- datatable(t(data.frame("Pic"='<img src="picToShow.png" width=150 height=100>',x1=4,x2=5,x3=6,row.names="p1")),
escape = F, options = list(dom = 't',pageLength = 20))
output$tab1 <- renderDataTable(tab1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Expected behaviour (behaviour in window)
Behaviour in the browser
I agree with #MrFlick's comment. Why do you load both images and resave them with the same name? The browser will think that it knows the image already and will re-use the already loaded image.
Why not just include pic1.png and pic2.png directly?
server <- function(input, output) {
observeEvent(input$pic1, {
tab1 <- datatable(t(data.frame("Pic"='<img src="pic1.png" width=150 height=100>',x1=1,x2=2,x3=3,row.names="p1")),
escape = F, options = list(dom = 't',pageLength = 20))
output$tab1 <- renderDataTable(tab1)
})
observeEvent(input$pic2, {
tab1 <- datatable(t(data.frame("Pic"='<img src="pic2.png" width=150 height=100>',x1=4,x2=5,x3=6,row.names="p1")),
escape = F, options = list(dom = 't',pageLength = 20))
output$tab1 <- renderDataTable(tab1)
})
}
library(shiny)
library(imager)
library(DT)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Tables to export"),
sidebarLayout(
sidebarPanel(
actionButton("pic1","Pic1"),
actionButton("pic2","Pic2")
),
# Show tables
mainPanel(
fluidRow(
DT::dataTableOutput('tab1')
)
)
)
)
# Define server logic
server <- function(input, output) {
vals = reactiveValues(pic1 = 0, pic2 = 0)
observeEvent(input$pic1, {
vals$pic1 <- 1
vals$pic2 <- 0
})
observeEvent(input$pic2, {
print(vals$pic1)
print(vals$pic2)
vals$pic1 <- 0
vals$pic2 <- 1
})
dynamicdf <- reactive({
if(vals$pic1 == 1) {
df <- data.frame(
pic = c('<img src="http://flaglane.com/download/american-flag/american-flag-large.png" height="52"></img>'),
x1 = c(1),
x2 = c(2),
x3 = c(3)
)
} else {
df <- data.frame(
pic = c('<img src="img2.jpg" width=150 height=100></img>'),
x1 = c(4),
x2 = c(5),
x3 = c(6)
)
}
print(df)
return(df)
})
output$tab1 <- DT::renderDataTable({
DT::datatable(dynamicdf(), escape = FALSE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
In Shiny Apps you do not load or saves images. You display them by using a path to the folder, where your pictures are stored. This can be a Link on the internet or a path on your machine.
Do it like this. I use a reactiveValue to track the last click of your button. This is a good solution if you have a large number of pictures you may want to render. (I adopted that style from the modern JS Library ReactJS) Based on the state you display your pictures. Do NOT use the www path, this is already expected by shiny. Leave it as in the example2 in the App.
For me it also only worked with the escape = FALSE parameter in the App. Try that if it does not work without it.
I have the following Shiny Application:
library(shiny)
list1 <- c(0.2,0.8,0.5)
list2 <- c("element1", "element2", "element3")
df <- data.frame(list1, list2)
UI <- fluidPage(
formattableOutput("table1")
)
Server <- function(input, output) {
output$table1 <- renderFormattable({
formattable(df, list(
list1 = color_tile("green", "red")
))
})
}
shinyApp(ui = UI, server = Server)
This works fine. However, I am looking for a way to set the column widths. I might be overlooking it in the documentation but I cant find a way to adjust the widths.
Any feedback on how I should change it?
Shiny renders it's code into HTML, so you can actually use CSS to adjust any aesthetic you'd like to change post render. Here's an easy fix using CSS.
First create a directory, www in the app directory, and create a file called styles.css which will serve as your CSS file. Add the following lines to styles.css:
table {
width: 400px !important;
}
This adjusts the width of all tables displayed in your app to be 400px, you can change this value as needed. Next, add includeCSS("www/styles.css") to the UI portion of your app like so:
library(shiny)
list1 <- c(0.2,0.8,0.5)
list2 <- c("element1", "element2", "element3")
df <- data.frame(list1, list2)
UI <- fluidPage(
includeCSS("www/styles.css"),
formattableOutput("table1")
)
Server <- function(input, output) {
output$table1 <- renderFormattable({
formattable(df, list(
list1 = color_tile("green", "red")
))
})
}
shinyApp(ui = UI, server = Server)
This will let Shiny know to use the CSS in the file we just created when rendering the page.