I am trying to only show two decimal places for all data in my table and align everything centrally. The first column is countries, but the rest are numbers. This is the code
output$Composite <- renderDataTable(FVI_DATA_COMPOSITE, options = list(pageLength = 15,lengthChange=FALSE))
Any idea how to do that?
Edit: This does not work.
output$Composite <- renderDataTable(FVI_DATA_COMPOSITE,
options = list(pageLength = 10,lengthChange=FALSE), round(FVI_DATA_COMPOSITE[3:9], digits=2)
output$Composite <- renderDataTable(datatable(FVI_DATA_COMPOSITE,
options = list(pageLength = 10,lengthChange=FALSE)) %>% formatRound(c(3:9), 2)
Documentation here
Edit: To center align
output$Composite <- renderDataTable(datatable(FVI_DATA_COMPOSITE,
options = list(pageLength = 10,lengthChange=FALSE)) %>%
formatRound(c(3:9), 2) %>%
formatStyle(columns = c(3:9), 'text-align' = 'center')
The accepted answer's code pattern kept returning the following warning/error:
Warning: Error in : object of type 'closure' is not subsettable
I had to use a slightly different pattern within a Shiny app.R file:
server <- function(input, output) {
output$dtable <- DT::renderDataTable({
datatable(FVI_DATA_COMPOSITE) %>%
formatRound(columns = c(3:9), digits = 2)
})
}
Related
I have a network diagram with a fairly large amount of nodes (~600), each node having some data, including an ID and its name.
I want to be able to run a very simple function when double-clicking on a specific node.
For that purpose, I have followed the instructions from this thread.
Using the code provided:
library(shiny)
library(visNetwork)
ui <- fluidPage(
visNetworkOutput('network')
)
server <- function(input, output, session) {
getDiagramPlot <- function(nodes, edges){
v <- visNetwork(
nodes,
edges
) %>%
visPhysics(stabilization = TRUE, enabled = TRUE) %>%
visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
visEdges(color = list(highlight = "red")) %>% # The colour of the edge linking nodes
visLayout(improvedLayout = TRUE) %>%
visEdges(arrows = edges$arrows) %>%
visInteraction(multiselect = F) %>%
visEvents(doubleClick = "function(nodes) {
Shiny.onInputChange('current_node_id', nodes.nodes);
;}")
return(v)
}
testFunction <- function(node_id){
print(paste("The selected node ID is:", node_id))
}
nodes <- data.frame(id = 1:3, label = 1:3)
edges <- data.frame(from = c(1,2), to = c(1,3))
output$network <- renderVisNetwork(
getDiagramPlot(nodes, edges)
)
observeEvent(input$current_node_id,{
testFunction(input$current_node_id)
})
}
shinyApp(ui, server)
The codes works well but when I replace the simple nodes and edges dataframe provided as example by my data (much larger network) then the code doesn't work anymore (nothing gets printed in the console when I double-click on any nodes).
Would anyone know why the code is not running with my data ?
Here is the adjustments that should be done to the code below:
load("NodesEdges.RData")
# nodes <- data.frame(id = 1:3, label = 1:3)
# edges <- data.frame(from = c(1,2), to = c(1,3))
Best wishes,
C.
I have tried:
adding more columns to the example nodes/edges (group, value, color, etc.) and the codes still runs well.
restricting my larger nodes/edges dataframes respectively to the "id", "label" and "from", "to" columns (same as example data) but the codes still fails.
I wonder whether the problem comes from the size of the dataframe.
How to filter out columns in shiny DT datatable based on cell color. Just like we have in excel.
[Need to filter the column with yellow color in background.]
Below is the code for cells with color:
input_data <- data.frame(Record_Status = c("Modified","NO","NO","Modified","NO","NO","Modified","NO","NO"),
Field_Changed = c("Brand,ratio","Gender","Name","ratio,Name,Gender","cost","Brand,cost","ratio,cost","cost","Name"),
Brand = c(3,6,9,12,15,18,21,24,27),
ratio = c (1,2,3,4,5,6,7,8,9),
cost = c(3,6,9,12,15,18,21,24,27),
Name = c("A","B","C","A","B","C","A","B","C"),
Gender = c("A","B","C","A","B","C","A","B","C"),
stringsAsFactors = FALSE)
# Build hidden logical columns for conditional formatting
dataCol_df <- ncol(input_data)
dataColRng <- 3:dataCol_df
argColRng <- (dataCol_df + 1):(dataCol_df * 2 -2)
df <- sapply(1:ncol(input_data),function(i) ifelse(input_data[[1]]=="Modified" &
str_detect(input_data[[2]], names(input_data)[i]),
"1","0"))
df <- df[,-c(1,2)]
input_data <- data.frame(input_data, df)
# Create Shiny Output
shinyApp(
ui =
navbarPage("Testing",dataTableOutput('dt')),
server = function(input, output, session) {
output$dt = DT::renderDataTable(
datatable(input_data,
# Hide logical columns
options=list(columnDefs = list(list(visible=FALSE,
targets=argColRng)))) %>%
# Format data columns based on the values of hidden logical columns
formatStyle(columns = dataColRng,
valueColumns = argColRng,
backgroundColor = styleEqual(c('1', '0'),
c("yellow", "white")))
)}
)
I think you have more than I issue here. For me the shiny app is not running and I believe this might be due to a mixup what should be in the ui and what in the server function.
About your original question. You could use the library DT and color the cells you like. This is independent of your shiny app, however, I believe you can use this also in the app, once you have the app running without the coloring.
library(DT)
datatable(input_data) %>% formatStyle(
'Brand', 'X1',
backgroundColor = styleEqual(c(0, 1), c('gray', 'yellow'))
)
It's my first time creating a dashboard and I'm running into a problem I can't seem to solve. I have created a sankey diagram and I want to be able to interactively change its contents through different dataframes (in this example: level_1, level_2, level_3). I've only ever practiced this with a regular plot, where the input would come from a variable within one dataframe which is my starting point in this piece of code (e.g. I have a df$country, so I use input$country in my plot --> Then I could choose from different countries in the dashboard sidebar, in order to change the contents of the plot). I have no idea how to do this when the input has to come from seperate dataframes.
My code: (in app.R)
level_1 <- as.data.frame(matrix(sample(seq(0,40), 15, replace=T ), 3, 5))
level_2 <- as.data.frame(matrix(sample(seq(0,40), 20, replace=T ), 4, 5))
level_3 <- as.data.frame(matrix(sample(seq(0,40), 25, replace=T ), 5, 5))
levels <- list(level_1, level_2, level_3)
ui <- dashboardPage(
dashboardHeader(title = "title"),
dashboardSidebar(
selectInput("in_levels", "Levels", choices = levels)
),
dashboardBody(
fluidRow(sankeyNetworkOutput("widget1"))
)
)
server <- function(input, output) {
links <- input$in_levels %>%
rownames_to_column(var="source") %>%
gather(key="target", value="value", -1) %>%
filter(value != 0)
nodes <- data.frame(
name=c(as.character(links$source), as.character(links$target)) %>%
unique()
)
links$IDsource <- match(links$source, nodes$name)-1
links$IDtarget <- match(links$target, nodes$name)-1
output$widget1 <- renderSankeyNetwork({
sankeyNetwork(Links = links, Nodes = nodes,
Source = "IDsource", Target = "IDtarget",
Value = "value", NodeID = "name", fontSize = 14, nodeWidth = 60,
fontFamily = "Arial", iterations = 0, sinksRight=TRUE)
})
}
shinyApp(ui, server)
I thought maybe it would help to create a list(), levels, of all the dataframes, but that does not work. I get this error:
Error : Can't access reactive value 'in_levels' outside of reactive consumer.
i Do you need to wrap inside reactive() or observer()?
I've googled reactive() and observer() to try to find out what my next step should be, but I haven't found the solution yet. It would be much appreciated if someone could give me advice on how to proceed, changes to make or something to read to increase my understanding.
Thanks in advance!
If you want to access any input values in the server you need to use a reactive context. shiny won't allow you to do otherwise, but even if it did, if an input value is updated, the server-side code won't update to reflect the change. Since you want both links and nodes to be dynamic and both depend on each other, a neat solution might be to store both objects in a list as follows:
server <- function(input, output) {
plot_data <- reactive({
# Perform all your computation inside this reactive!
links <- input$in_levels %>%
rownames_to_column(var="source") %>%
gather(key="target", value="value", -1) %>%
filter(value != 0)
nodes <- data.frame(
name = c(as.character(links$source), as.character(links$target)) %>%
unique()
)
links$IDsource <- match(links$source, nodes$name)-1
links$IDtarget <- match(links$target, nodes$name)-1
# Return the data in a list
list(links = links, nodes = nodes)
})
# Access the datasets by calling the reactive and then treating as a normal list
output$widget1 <- renderSankeyNetwork({
sankeyNetwork(Links = plot_data()$links, Nodes = plot_data()$nodes,
Source = "IDsource", Target = "IDtarget",
Value = "value", NodeID = "name", fontSize = 14, nodeWidth = 60,
fontFamily = "Arial", iterations = 0, sinksRight=TRUE)
})
}
This is untested as my current version of R doesn't support the network3d package.
The concept of reactivity is tricky, but chapter 3 of Mastering Shiny should be very illuminating if you're new to shiny.
I have this data set:
Area <- c("Mexico", "USA", "USA", "Canada").
Type_of_participants <- c("Doctor", "Doctor", "Engineer", "Dancer".
Salary <- c("4000", "6000", "8000", "5000").
and I am trying to plot the salary base on the user input of Area(level1) and Type_of_participants(level2), but nothing appears. I modified aes to aes_string as I looked up here. Please help me find the error
My Code
`ui <- fluidPage(
titlePanel("Survey Results"),
sidebarLayout(
sidebarPanel(strong("Overview Plot"),
br(),
###1a.Area input
selectInput("selection","Var",
choices = c("Area","Type_of_participants"),
selected = "Area"),
uiOutput("choice_selection")
),
mainPanel(
plotOutput("Overview"))
`server <- function(input, output) {
output$choice_selection <- renderUI({
checkboxGroupInput("baseinput","Detail",
unique(df[,input$selection])
)`
})
dt1 <- reactive({
df %>%
group_by(input$selection,Type) %>%
filter (input$selection %in% input$baseinput) %>%
summarise(avg_salary_by_area = mean(Salary, na.rm = TRUE)) %>%
select(input$selection, Type, avg_Salary_by_area)
})
output$Overview <- renderPlot({
ggplot(data= dt1())+
aes(fill = Type)+
geom_bar(x=input$selection, y = avg_salary_by_area,stat="identity",
position = position_dodge())
The result is I can select the input but can not visualize the plot. The error "unknown column Area or unknow Type of participants
Please help me find the mistake
Thank you
*** Update
Thanks to Mr Flick, I have fixed my code but it still informs error "Object area not found". Please help to advise. Thank you so much
`dt1 <- reactive({
df[df[,input$selection] %in% input$baseinput,] %>%
group_by(input$selection,Type) %>%
summarise(avg_score_by_area = mean(Score, na.rm = TRUE))
})
output$Overview <- renderPlot({
ggplot(data= dt1(),aes_string(x= input$selection,
y = "avg_score_by_area",fill = "Type"))+
geom_bar(stat="identity",
position = position_dodge())`
#Suzie - as mentioned above, it would help if you edited your question with your complete code as you currently have it.
A few things that would help:
Salary should be numeric in your df (or be converted with as.numeric before trying to take the mean
Your reactive expression can use !!as.symbol with input$selection to filter by the string name from df
The plot can use aes_string for the variable names.
Edit:
For further explanation of !!as.symbol, first consider what the result of input$selection. If you use browser() in your shiny code, and inspect what input$selection returns, you will see something like "Area" (it returns a string). But a string would not be appropriate in your filter - it is expecting a symbol that represents a column in your data frame. (A symbol is the name of an object like df or mtcars, etc.)
First, you want to convert a string to a symbol. You can do that either by using as.symbol() or rlang::sym(). You can try this out in your console. If you do as.symbol("df") it would return the symbol df. If you entered eval(as.symbol("df")) it would be the same as just entering df itself (and it would show the contents of your data frame).
The other issue is that tidyverse functions evaluate code expressions in a special context (searching for names within a data frame, for example). In this case dplyr knows that the name Area is in the context of df (one of the column names). This is a complicating factor since arguments are quoted. To address this, you need to unquote (replace a name with its value) with the bang-bang !! operator.
Putting both together you get !!as.symbol().
Of note, varSelectInput is a newer shiny alternative to selectInput that can be considered for use in situations like these.
For more information:
shinymeta special topics
advanced R
library(tidyverse)
library(shiny)
Area <- c("Mexico", "USA", "USA", "Canada")
Type_of_participants <- c("Doctor", "Doctor", "Engineer", "Dancer")
Salary <- c(4000, 6000, 8000, 5000)
df <- data.frame(Area, Type_of_participants, Salary)
ui <- fluidPage(
titlePanel("Survey Results"),
sidebarLayout(
sidebarPanel(strong("Overview Plot"),
br(),
###1a.Area input
selectInput("selection","Var",
choices = c("Area","Type_of_participants"),
selected = "Area"),
uiOutput("choice_selection")
),
mainPanel(
plotOutput("Overview")
)
)
)
server <- function(input, output) {
output$choice_selection <- renderUI({
checkboxGroupInput("baseinput", "Detail", unique(df[,input$selection]))
})
dt1 <- reactive({
df %>%
group_by(Area, Type_of_participants) %>%
filter(!!as.symbol(input$selection) %in% input$baseinput) %>%
summarise(avg_salary_by_area = mean(Salary, na.rm = TRUE))
})
output$Overview <- renderPlot({
ggplot(data = dt1(), aes_string(x = input$selection, y = "avg_salary_by_area", fill = "Type_of_participants")) +
geom_bar(stat="identity", position = position_dodge())
})
}
shinyApp(ui, server)
I wish to implement formatCurrency() and formatPercentage() (both from DT package) across multiple columns simultaneously in a shiny dashboard. I am using shinymaterial for the given example.
I am currently doing the following:
# The packages to load.
required_packages <- c("shiny", "shinymaterial", "DT", "tidyverse")
# This function will load in all the packages needed.
lapply(required_packages, require, character.only = TRUE)
# A table example.
ui <- material_page(
title = "Example table",
tags$h1("Table example"),
material_card(
title = "Table",
material_row(
DT::dataTableOutput("data_table_example")
),
depth = 1
)
)
server <- function(input, output) {
data_table_example_data = tibble(
Person = paste0("Person ", c(1:100)),
`Price $` = rnorm(100, 50000, 500),
`Cost $` = rnorm(100, 30000, 300),
`Probability %` = rnorm(100, 0.6, 0.1),
`Win %` = rnorm(100, 0.5, 0.2)
)
# This will create an output summary table
output$data_table_example = renderDataTable({
result = datatable(data_table_example_data, options = list(pageLength = 100, scrollX = TRUE),
class = 'cell-border stripe compact', rownames = FALSE) %>%
formatCurrency("Price $") %>%
formatCurrency("Cost $") %>%
formatPercentage("Probability %", digits = 1) %>%
formatPercentage("Win %", digits = 1)
})
}
shinyApp(ui = ui, server = server)
However, what I wish to do is, within the renderDataTable() function, to simplify the format functions into fewer lines. For example, implement formatCurrency() in any column with a "$" and formatPercentage() in any column with a "%".
I have done a fair bit of searching for an appropriate but could not find a solution, but I assume I am just missing a fairly simple solution.
Something like:
# This will create an output summary table
output$data_table_example = renderDataTable({
result = datatable(data_table_example_data, options = list(pageLength = 100, scrollX = TRUE),
class = 'cell-border stripe compact', rownames = FALSE) %>%
formatCurrency(grepl("$", colnames()) %>%
formatPercentage(grepl("%", colnames()), digits = 1)
})
A few additional points:
The tibble will actually be a reactive
This example is a very trivial version of a rather more complex table and set of reactives
I do not want to implement the formatting in the reactive part since I find this then messes with the DT sorting function, since it assumes the column is a character string
Any help will be greatly appreciated
Try:
# This will create an output summary table
output$data_table_example = renderDataTable({
result = datatable(data_table_example_data, options = list(pageLength = 100, scrollX = TRUE),
class = 'cell-border stripe compact', rownames = FALSE) %>%
formatCurrency(grepl("$", colnames(data_table_example_data)) %>%
formatPercentage(grepl("%", colnames(data_table_example_data)), digits = 1)
})
It seems you need to be explicit with the data so colnames() doesn't work - you need colnames(data_table_example_data).
I noticed during testing if you use grepl with rownames = TRUE that rownames becomes the first column name which means all the formatting is out by one. grep seems to not have this issue.