Reputation: 495
I am trying to add a summary row to a filterable table that shows the totals/subtotals and other summary functions. In my example below I would like totals for investment
, Value
, and Profit
and average ROI
for any combination of the the filters Asset
and Symbol
.
Here are pictures to show my desired result:
All Assets:
Stock Selected:
Bond Selected:
I am also trying to format my columns but wherever I add this formatting code in theif
pipeline it does not work.
formatCurrency( ~investment+Value+Profit ) %>%
formatStyle( c('ROI','Profit'),color = styleInterval(c(0),
c('red', 'green')),fontWeight = 'bold') %>%
formatPercentage(~ROI,digits=1)
R Shiny code:
library(tidyverse)
library(DT)
library(formattable)
library(shiny)
assetTable <- structure(list(symbol = c("A", "B", "C", "D", "E", "F", "G",
"H", "I"), Asset = c("Stock", "Stock", "Bond", "Bond", "Stock",
"Bond", "Stock", "Bond", "Stock"), investment = c(154, 362, 181,
851, 510, 539, 527, 369, 234), Value = c(330, 763, 911, 535,
220, 450, 576, 903, 905), Profit = c(176, 401, 730, -316, -290,
-89, 49, 534, 671), ROI = c(1.14285714285714, 1.10773480662983,
4.03314917127072, -0.371327849588719, -0.568627450980392,
-0.165120593692022,0.0929791271347249, 1.44715447154472,
2.86752136752137)), row.names = c(NA,-9L),
class = c("tbl_df", "tbl", "data.frame"))
ui <- fluidPage(
titlePanel("Table with column summary"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("Asset",
"Asset Type:",
c("All",
unique(as.character(assetTable$Asset))))
)
,
column(4,
selectInput("symbol",
"Symbol",
c("All",
unique(as.character(assetTable$symbol))))
)
),
DT::dataTableOutput("table")
)
server <- function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
data <-assetTable
if (input$Asset!= "All") {
data <- data[data$Asset == input$Asset,]
}
if (input$symbol != "All") {
data <- data[data$symbol == input$symbol,]
}
data
}))
}
# Run the application
shinyApp(ui = ui, server = server)
Upvotes: 1
Views: 1060
Reputation: 887951
In order to get the sum
and mean
, we can use adorn_totals
from janitor
library(dplyr)
library(janitor)
Also, as we are redoing the same summarisation, it could be made into a function
f1 <- function(dat, colnm, colval) {
dat %>%
# // filter the rows based on the input string from colval
filter({{colnm}} == colval) %>%
# // create a mean column for ROI
mutate(ROImean = mean(ROI)) %>%
# // make use of adorn_totals for the selected columns
adorn_totals(where = "row", fill = '-',
na.rm = TRUE, name = 'Total', c('investment', 'Value',
'Profit', 'ROI', 'ROImean')) %>%
# // replace the ROI last row (n() => last row index)
# // with first element of ROImean
mutate(ROI = replace(ROI, n(), first(ROImean))) %>%
# // remove the temporary ROImean column
select(-ROImean) %>%
# // change the format of specific columns
mutate(across(c(investment, Value, Profit),
~ as.character(formattable::currency(., symbol = '$',
digits = 2L, format = "f", big.mark = ","))),
ROI = as.character(formattable::percent(ROI, digits = 2)))
}
Now, the call becomes much more compact within server
server <- function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
data <- assetTable
if (input$Asset!= "All") {
data <- f1(data, Asset, input$Asset)
}
if (input$symbol != "All") {
data <- f1(data, symbol, input$symbol)
}
data
}))
}
-output
Upvotes: 5