Embed Shiny widgets in a row in a DT table
Here is a solution using selectInput
. We can wrap the inputs in a div
and use the escape = FALSE
argument - and add Shiny.bindAll
in the drawCallback
.
Furthermore I'm using dataTableProxy
along with replaceData
to update the table otherwise you'll run into the problems described here.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(DT)
# library(tidyverse)
library(data.table)
#reproducible minimal data frame
YLMI <- structure(list(X = c(511L, 700L, 943L, 1402L, 1429L, 1483L, 1726L, 1834L, 1861L, 2266L),
name = c("Austria", "Belgium", "Bulgaria", "Cyprus", "Czech Republic", "Denmark",
"Estonia", "Finland", "France", "Iceland"),
year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L),
X1 = c(6.0948572, 5.1031427, 5.145143, 4.3162856, 5.9200001, 6.0751429, 5.8771429,
5.0911427, 4.8957143, 6.262857),
X2 = c(5.7982831, 5.1347985, 4.1193204,3.9259963, 5.9878144, 5.8885102, 5.5807657,
4.5704818, 4.8845162, 5.7285347),
X3 = c(5.8720002, 5.1729999, 4.1079998, 4.7049999, 5.8794999, 6.0700002, 5.3740001,
5.4159999, 5.2164998, 6.3175001),
X4 = c(6.0436354, 3.9714868, 6.0058327, 4.7928214, 4.636817, 6.1576967, 5.9891138,
3.3220425, 3.2921035, 4.1184382),
X5 = c(6.3000154, 5.7192054, 6.5671687, 3.4370663, 6.6064062, 5.8908257,
6.8782973, 4.7578831, 4.3325543, 6.2499504),
X6 = c(4.9257145, 5.5085716, 4.0457144, 3.737143, 2.817143, 5.0228572, 4.0057144,
3.0914288, 5.3942857, 1.7485714),
X7 = c(5.2685714, 5.8857141, 5.1657143, 4.4285712, 6.6914287, 3.7942855,
4.8914285, 5.7142859, 5.2857141, 5.0457144),
X8 = c(5.7268553, 5.3676248, 5.7317734, 5.1083288, 4.9277864, 6.2327962,
6.1439047, 5.5020885, 5.9025269, 5.6717625),
X9 = c(4.7919998, 5.428, 5.1039996, 4.7199998, 5.4880004, 6.2319999, 5.1399999,
5.3560004, 5.4160004, 5.3560004),
X10 = c(4.7384157, 3.7913544, 4.4407039, 5.8613172, 3.5934217, 5.534936,
4.0672798, 4.2066154, 4.3676648, 3.6402931),
X11 = c(5.7328, 5.1810961, 5.4579573, 5.5078635, 5.3274336, 5.7784905,
5.5863309, 5.2231383, 5.3318233, 5.2328768),
X12 = c(5.6389961, 3.9419262, 2.6277056, 4.8922715, 4.4109187, 6.3135815,
5.6100388, 6.3433652, 4.5896773, 6.6938777),
W1 = c(0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833,
0.0833),
W2 = c(0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833,
0.0833, 0.0833, 0.0833),
W3 = c(0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833, 0.0833,
0.0833),
W4 = c(0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05),
W5 = c(0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05),
W6 = c(0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05),
W7 = c(0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05),
W8 = c(0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05),
W9 = c(0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125),
W10 = c(0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125),
W11 = c(0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125),
W12 = c(0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125, 0.125),
indicators = c(12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L),
classes = c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A"),
index_constant = c(5.51, 4.9, 4.69, 4.78, 5.12, 5.84, 5.35, 5.02, 4.92, 5.28),
ranking = c(18L, 48L, 59L, 53L, 31L, 7L, 25L, 36L, 45L, 27L)),
row.names = c(511L, 700L, 943L, 1402L, 1429L, 1483L, 1726L, 1834L, 1861L, 2266L),
class = "data.frame")
#helper function:
# ---- Index Calculation Based on User Weights ---- #
calculate_index_w_weights <- function(w1,w2,w3,w4) {
# Obtaining weights
weights <- array(rep(1,4))
# Creating weight matrices to re-calculate the indicator scores.
w1_matrix <- matrix(weights[1], nrow= 10, ncol=3)
w2_matrix <- matrix(weights[2], nrow= 10, ncol=5)
w3_matrix <- matrix(weights[3], nrow= 10, ncol=2)
w4_matrix <- matrix(weights[4], nrow= 10, ncol=2)
# Unnecessary for now
YLMI[,c("W1","W2","W3")]<-YLMI[,c("W1","W2","W3")] * w1_matrix
YLMI[,c("W4","W5","W6","W7", "W8")]<-YLMI[,c("W4","W5","W6", "W7","W8")] * w2_matrix
YLMI[,c("W9","W10")]<-YLMI[,c("W9","W10")] * w3_matrix
YLMI[,c("W11","W12")]<-YLMI[,c("W11","W12")] * w4_matrix
ActivityState = YLMI[,c("X1", "X2", "X3")] * YLMI[,c("W1","W2","W3")] #5454x3
WorkingConditions= YLMI[,c("X4", "X5", "X6", "X7", "X8")] * YLMI[,c("W4","W5","W6", "W7", "W8")] #5454x5
Education= YLMI[,c("X9", "X10")] * YLMI[,c("W9","W10")] #5454x2
TransitionSmoothness= YLMI[,c("X11", "X12")] * YLMI[,c("W11","W12")] #5454x2
c1 <- rowSums(ActivityState) #5454 x 1 sum(x1*w1....)
c2 <- rowSums(WorkingConditions)
c3 <- rowSums(Education)
c4 <- rowSums(TransitionSmoothness)
w1_i <-rowSums(YLMI[,c("W1","W2","W3")])
w2_i <-rowSums(YLMI[,c("W4","W5","W6","W7", "W8")])
w3_i <-rowSums(YLMI[,c("W9","W10")])
w4_i <-rowSums(YLMI[,c("W11","W12")])
# weighted_index = YLMI_Nominator / sum_weights
ActivityState = c1 / w1_i
WorkingConditions = c2 / w2_i
Education = c3 / w3_i
TransitionSmoothness = c4 / w4_i
# Category weighting
weights_category <- array(rep(0.25,4))
# User input on weights
w_unit <- 1 / (w1+w2+w3+w4)
weights_category[1] <- w_unit * w1
weights_category[2] <- w_unit * w2
weights_category[3] <- w_unit * w3
weights_category[4] <- w_unit * w4
w1_cat_matrix <- matrix(weights_category[1], nrow= 10, ncol=1)
w2_cat_matrix <- matrix(weights_category[2], nrow= 10, ncol=1)
w3_cat_matrix <- matrix(weights_category[3], nrow= 10, ncol=1)
w4_cat_matrix <- matrix(weights_category[4], nrow= 10, ncol=1)
categories <- data.frame(ActivityState, WorkingConditions, Education, TransitionSmoothness,
W1_C=w1_cat_matrix, W2_C=w2_cat_matrix, W3_C= w3_cat_matrix, W4_C=w4_cat_matrix)
categories[is.na(categories) == TRUE] = 0
# If category value is zero, then no weight assigned to that category for the index calculation.
categories <- within(categories, W1_C[ActivityState == 0] <- 0)
categories <- within(categories, W2_C[WorkingConditions == 0] <- 0)
categories <- within(categories, W3_C[Education == 0] <- 0)
categories <- within(categories, W4_C[TransitionSmoothness == 0] <- 0)
weights_category_sum <-rowSums(categories[,c("W1_C","W2_C","W3_C","W4_C")])
YLMI_Nominator1=categories[,c("ActivityState")] * categories[,c("W1_C")]
YLMI_Nominator2=categories[,c("WorkingConditions")] * categories[,c("W2_C")]
YLMI_Nominator3=categories[,c("Education")] * categories[,c("W3_C")]
YLMI_Nominator4=categories[,c("TransitionSmoothness")] * categories[,c("W4_C")]
YLMI_Nominator = YLMI_Nominator1 + YLMI_Nominator2 + YLMI_Nominator3 + YLMI_Nominator4
index = YLMI_Nominator / weights_category_sum
YLMI["weighted_index"]<-index
YLMI["ActivityState"]<-ActivityState
YLMI["WorkingConditions"]<-WorkingConditions
YLMI["Education"]<-Education
YLMI["TransitionSmoothness"]<-TransitionSmoothness
#creating subset for single indicator scores
YLMI_IScores <- data.frame(
Country = YLMI[, c("name")],
Year = YLMI[, c("year")],
Classes = YLMI[, c("classes")],
Index = YLMI[, c("index_constant")],
Weighted_Index = YLMI[, c("weighted_index")],
ActivityState=YLMI[, c("ActivityState")],
WorkingConditions=YLMI[, c("WorkingConditions")],
Education=YLMI[, c("Education")],
TransitionSmoothness=YLMI[, c("TransitionSmoothness")],
UnemploymentRate = YLMI[, c("X1")],
RelaxedUnemploymentRate = YLMI[, c("X2")],
NEETRate = YLMI[, c("X3")],
TemporaryWorkersRate = YLMI[, c("X4")],
InvoluntaryPartTimeWorkersRate = YLMI[, c("X5")],
AtypicalWorkingHoursRate = YLMI[, c("X6")],
InWorkatRiskofPovertyRate = YLMI[, c("X7")],
VulnerableEmploymentRate = YLMI[, c("X8")],
FormalEducationandTrainingRate = YLMI[, c("X9")],
SkillsMismatchRate = YLMI[, c("X10")],
RelativeUnemploymentRatio = YLMI[, c("X11")],
LongTermUnemploymentRate = YLMI[, c("X12")])
# Deleting rows if calculated index is NaN
YLMI_IScores <- YLMI_IScores[!is.na(YLMI_IScores$Index), ]
YLMI_IScores[is.na(YLMI_IScores) == TRUE] = "-"
return(YLMI_IScores)
}
##server##
server <- function(input, output, session) {
#scoreboard
#table layout for scoreboard
sketch <- htmltools:: withTags(
table(
class = "display",
thead(
tr(
th(colspan = 3, "Selection", style = "border-right: solid 2px;"),
th(colspan = 2, "Aggregate Index", style = "border-right: solid 2px;"),
th(colspan = 4, "Sub-Index Values by Dimension", style = "border-right: solid 2px;"),
th(colspan = 3, "Dimension: Activity State", style = "border-right: solid 2px;"),
th(colspan = 5, "Dimension: Working Conditions", style = "border-right: solid 2px;"),
th(colspan = 2, "Dimension: Education", style = "border-right: solid 2px;"),
th(colspan = 2, "Dimension: Transition Smoothness", style = "border-right: solid 2px;")
),
tr(
th("Country"),
th("Year"),
th("Classes", style = "border-right: solid 2px;"),
th("Index"),
th("Weighted Index", style = "border-right: solid 2px;"),
th(div("Activity State", br(), br(), br(), selectInput("w_1",
label = "Select weight of Dimension Activity State:",
choices = 0:3,
selected = 1
))),
th(div("Working Conditions", br(), br(), selectInput("w_2",
label = "Select weight of Dimension Working Conditions:",
choices = 0:3,
selected = 1
))),
th(div("Education", br(), br(), br(), selectInput("w_3",
label = "Select weight of Dimension Education:",
choices = 0:3,
selected = 1
))),
th(div("Transition Smoothness", br(), br(), selectInput("w_4",
label = "Select weight of Dimension Transitional Smoothness:",
choices = 0:3,
selected = 1
)), style = "border-right: solid 2px;"),
th("Unemployment Rate"),
th("Relaxed Unemployment Rate"),
th("NEET Rate", style = "border-right: solid 2px;"),
th("Temporary Workers Rate"),
th("Involuntary Part Time Workers Rate"),
th("Atypical Working Hours Rate"),
th("In Work at Risk of Poverty Rate"),
th("Vulnerable Employment Rate", style = "border-right: solid 2px;"),
th("Formal Educationand Training Rate"),
th("Skills Mismatch Rate", style = "border-right: solid 2px;"),
th("Relative Unemployment Ratio"),
th("Long Term Unemployment Rate")
)
)
)
)
#data filtering based on user input
filterData <- reactive({
w1 <- ifelse(is.null(input$w_1), yes = 1, no = as.integer(input$w_1))
w2 <- ifelse(is.null(input$w_2), yes = 1, no = as.integer(input$w_2))
w3 <- ifelse(is.null(input$w_3), yes = 1, no = as.integer(input$w_3))
w4 <- ifelse(is.null(input$w_4), yes = 1, no = as.integer(input$w_4))
YLMI_IScores <- calculate_index_w_weights(w1,w2,w3,w4)
rows <- (YLMI_IScores$Country %in% input$country_scb) & (YLMI_IScores$Classes %in% input$country_classes_scb)
data <- YLMI_IScores[rows,, drop = FALSE]
data
})
# receive initial dataset only once to avoid re-rendering the table
initData <- reactiveVal()
observeEvent(filterData(), {
initData(filterData())
}, once = TRUE)
output$scb_table <- DT::renderDT({
datatable(initData(), rownames = FALSE, container = sketch, escape = FALSE,
options = list(info = TRUE, order= list(3,"dsc"), pageLength = 50, ordering = FALSE,
columnDefs = list(list(targets = "_all", className = "dt-center")),
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
) %>%
formatStyle(c(3,5,9,12,17,19,21), `border-right` = "solid 2px") %>%
formatStyle(columns = "Index", backgroundColor = "#fdb9c4") %>%
formatStyle(columns = "Weighted_Index", backgroundColor = "#f72a66") %>%
formatStyle(columns = "ActivityState", backgroundColor = "#fff9ee") %>%
formatStyle(columns = "WorkingConditions", backgroundColor = "#fff9ee") %>%
formatStyle(columns = "Education", backgroundColor = "#fff9ee") %>%
formatStyle(columns = "TransitionSmoothness", backgroundColor = "#fff9ee") %>%
formatRound(columns = c(4:21), digits = 2)
}, server = TRUE)
scb_table_proxy <- dataTableProxy(outputId = "scb_table", session = session, deferUntilFlush = TRUE)
observeEvent(filterData(), {
replaceData(proxy = scb_table_proxy, data = filterData(), resetPaging = FALSE, rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
})
}
##ui ##
ui <- fluidPage(
sidebarLayout(
#scoreboard
sidebarPanel(
pickerInput(
inputId = "country_scb",
label = "Select country/countries",
selected = unique(sort(YLMI$name)), # Default selecting all the countries here! TODO
choices = unique(sort(YLMI$name)),
multiple = TRUE,
options = list(`actions-box` = TRUE)
),
awesomeCheckboxGroup(
inputId = "country_classes_scb",
label = "Filter countries by data availability:",
choices = unique(sort(YLMI$classes)),
selected = unique(sort(YLMI$classes)),
)
),
mainPanel(
# Show data table
DT::dataTableOutput("scb_table")
)
)
)
shinyApp(ui = ui, server = server)
Shiny widgets in DT Table
Sliders
For the sliders, you have to start with a text input:
SLIDER = '<input type="text" id="s" name="slider" value="" />'
and then turn it into a slider with JavaScript:
js <- c(
"function(settings){",
" $('#s').ionRangeSlider({",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20,",
" from: 5,",
" to: 15",
" });",
"}"
)
See ionRangeSlider for the options.
You can pass the JavaScript code with the initComplete
option:
server <- function(input, output, session) {
output$table <- renderDT({
data <- data.frame(ROW = 1:5,
TEXT = '<input id="text" type="text" class="form-control" value=""/>',
SINGLE_SELECT = '<select id="single_select" style="width: 100%;">
<option value="" selected></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
SLIDER = '<input type="text" id="s" name="slider" value="" />',
MULTIPLE_SELECT = '<select id="multiple_select" class="form-control" multiple="multiple">
<option value=""></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>',
stringsAsFactors = FALSE)
datatable(data = data,
selection = "none",
escape = FALSE,
rownames = FALSE,
options =
list(
initComplete = JS(js)
))
})
}
Then you get the slider for the first row only:
That's because the five text inputs have the same id. You have to set a different id for the five text inputs:
SLIDER = sapply(1:5, function(i) {
sprintf('<input type="text" id="Slider%d" name="slider" value="" />', i)
}),
Then use this JavaScript code to turn them into sliders:
js <- c(
"function(settings){",
" $('[id^=Slider]').ionRangeSlider({",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20,",
" from: 5,",
" to: 15",
" });",
"}"
)
To set the initial values of from
and to
, it's better to give them in the value
argument of the input text like this:
SLIDER = sapply(1:5, function(i) {
sprintf('<input type="text" id="Slider%d" name="slider" value="5;15" />', i)
})
js <- c(
"function(settings){",
" $('[id^=Slider]').ionRangeSlider({",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20",
" });",
"}"
)
Multiple selects
To get the desired display of a multiple select, you have to call selectize()
:
MULTIPLE_SELECT = '<select id="mselect" class="form-control" multiple="multiple">
<option value=""></option>
<option value="A">A</option>
<option value="B">B</option>
<option value="C">C</option>
</select>'
js <- c(
"function(settings){",
" $('[id^=Slider]').ionRangeSlider({",
" type: 'double',",
" grid: true,",
" grid_num: 10,",
" min: 0,",
" max: 20",
" });",
" $('#mselect').selectize()",
"}"
)
Similarly, this applies to the first multiple select only. Use individual id's to apply to the five ones.
Binding
Finally, you have to bind the inputs to get their value available in Shiny:
datatable(data = data,
selection = "none",
escape = FALSE,
rownames = FALSE,
options =
list(
initComplete = JS(js),
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
Now you can get the values in input$Slider1
, input$Slider2
, ..., and input$mselect
. Note that input$Slider[1/2/3/4/5]
returns the values of the slider in this format: "3;15"
.
add shinyWidgets into datatable in R
Here is an example.
library(shiny)
library(shinyWidgets)
library(DT)
ui <- fluidPage(
br(),
DTOutput("dt"),
br(),
tags$label("Slider1:"),
verbatimTextOutput("choice1"),
tags$label("Slider2:"),
verbatimTextOutput("choice2")
)
sti <- function(id){
as.character(sliderTextInput(
inputId = id,
label = "Your choice:",
grid = TRUE,
force_edges = TRUE,
choices = c("Disagree", "Agree"))
)
}
js <- c(
"function(settings){",
" $('[id^=slider]').each(function(){",
" $(this).ionRangeSlider({values: $(this).data('swvalues')});",
" });",
"}"
)
server <- function(input, output){
dat <- data.frame(
word = c("hello", "goodbye"),
status = c(sti("slider1"), sti("slider2"))
)
output[["dt"]] <- renderDT({
dtable <- datatable(dat, escape = FALSE,
callback = JS(c('Shiny.unbindAll(table.table().node());',
'Shiny.bindAll(table.table().node());')),
options = list(
initComplete = JS(js)
))
dep1 <- htmltools::htmlDependency(
"ionrangeslider", "2.1.6",
src = "www/shared/ionrangeslider",
script = "js/ion.rangeSlider.min.js",
stylesheet = c("css/ion.rangeSlider.css", "css/ion.rangeSlider.skinShiny.css"),
package = "shiny")
dep2 <- htmltools::htmlDependency(
"strftime", "0.9.2",
src = "www/shared/strftime",
script = "strftime-min.js",
package = "shiny")
dep3 <- htmltools::htmlDependency(
"shinyWidgets", "0.4.5",
src = "www",
script = "shinyWidgets-bindings.min.js",
stylesheet = "shinyWidgets.css",
package = "shinyWidgets")
dtable$dependencies <- c(dtable$dependencies, list(dep1,dep2,dep3))
dtable
}, server = FALSE)
output[["choice1"]] <- renderPrint(input[["slider1"]])
output[["choice2"]] <- renderPrint(input[["slider2"]])
}
shinyApp(ui, server)
Create a dynamic table on shiny app based on shiny widget and row selection of another datatable
Perhaps this will meet your needs. Please note that you may need to modify the formula for elective_se
and elective_se2
.
server <- function(input, output, session) {
output$costs <- DT::renderDataTable({
dtable <- datatable(
filtercost, selection = "multiple",rownames=FALSE
)
dep <- htmltools::htmlDependency("jqueryui", "1.12.1",
"www/shared/jqueryui",
script = "jquery-ui.min.js",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
})
#output$value2 <- renderPrint({ input$somevalue2 })
selectedrow_costsrows <- reactive({
#req(input$costs_rows_selected)
s <- input$costs_rows_selected
data <- as.data.frame(datacost[s,])
names(data) <- NULL
data
if (is.null(input$costs_rows_selected)) {costtable <- NULL
}else {
n <- length(input$costs_rows_selected)
elective_mean<- weighted.mean(as.numeric(data[,2]),as.numeric(data[,1]),na.rm = F)
elective_se <- ifelse(n>1, sqrt(sum((as.numeric(data[,2])-elective_mean)^2)/(n*(n-1))), 0)
elective_CI_l<- elective_mean-1.96*elective_se
elective_CI_h<- elective_mean+1.96*elective_se
Service_type <- c("Elective")
Weighted_mean <- round(c(elective_mean),0)
Weighted_SR <- round(c(elective_se),0)
CI_Lower_95 <- round(c(elective_CI_l),0)
CI_Upeer_95 <- round(c(elective_CI_h),0)
costtable1 <- as.data.frame(rbind(Service_type,Weighted_mean,Weighted_SR,CI_Lower_95,CI_Upeer_95))
elective_mean2<- weighted.mean(as.numeric(data[,4]),as.numeric(data[,3]),na.rm = F)
elective_se2 <- ifelse(n>1, sqrt(sum((as.numeric(data[,4])-elective_mean2)^2)/(n*(n-1))), 0)
elective_CI_l2<- elective_mean2 - 1.96*elective_se2
elective_CI_h2<- elective_mean2 + 1.96*elective_se2
Service_type2 <- c("Non-elective Long Stay")
Weighted_mean2 <- round(c(elective_mean2),0)
Weighted_SR2 <- round(c(elective_se2),0)
CI_Lower_952 <- round(c(elective_CI_l2),0)
CI_Upeer_952 <- round(c(elective_CI_h2),0)
costtable2 <- as.data.frame(rbind(Service_type2,Weighted_mean2,Weighted_SR2,CI_Lower_952,CI_Upeer_952))
colnames(costtable2) <- "V2"
if (is.null(input$somevalue2)) {costtable <- NULL
}else if (length(input$somevalue2)==2){
costtable <- cbind(costtable1,costtable2)
}else{
if (input$somevalue2=="Elective"){
costtable <- costtable1
}else {
costtable <- costtable2
}
}
}
costtable
})
output$selectedrow_costs <- DT::renderDataTable({
df=selectedrow_costsrows()})
}
shinyApp(ui = ui, server = server)
Add, remove and edit rows in a DT::datatable of a shiny app
Here is an approach using reactiveValues
.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(tidyverse)
Input <- structure(list(`Security Type` = c("Stock", "Stock", "Load Fund"), Ticker = c("XOM", "NFLX", "AMCPX"), `Purchase Date` = structure(c(
16070,
17084, 17084
), class = "Date"), `Sale Date` = structure(c(
18627,
NA, 18545
), class = "Date"), `Amount Invested` = c(
"$10,000",
"$8,000", "$10,000"
)), class = c(
"spec_tbl_df", "tbl_df", "tbl",
"data.frame"
), row.names = c(NA, -3L))
shinyApp(
ui = tags$body(class = "skin-blue sidebar-mini control-sidebar-open", dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading", titleWidth = 450),
sidebar = dashboardSidebar(
minified = F, collapsed = F,
selectInput(
"sectype", "Security Type",
c(unique(Input$`Security Type`))
),
selectInput(
"sectick", "Ticker",
c(unique(Input$Ticker))
),
dateInput("PurDate", "Purchase Date", value = as.Date("2013-12-31")),
dateInput("selDate", "Sale Date", value = as.Date("2019-01-31")),
selectInput(
"aminv", "Amount Invested",
c(unique(Input$`Amount Invested`))
),
actionButton("add", "Add"),
actionButton("edit", "Edit"),
actionButton("deleteRows", "Delete Rows")
),
body = dashboardBody(
h3("Results"),
tabsetPanel(
id = "tabs",
tabPanel(
"InsiderTraining",
dataTableOutput("TBL1")
)
)
),
controlbar = dashboardControlbar(width = 300),
title = "DashboardPage"
)), ###### SERVER
server = function(input, output)
Related Topics
Vue.Js - How to Properly Watch for Nested Data
How to Use Componentwillmount() in React Hooks
How Is a JavaScript String Not an Object
Resize Svg When Window Is Resized in D3.Js
How to Convert a String to Bytearray
Explanation of [].Slice.Call in JavaScript
Sort JavaScript Array by Two Numeric Fields
Differencebetween Compile and Link Function in Angularjs
Can Mustache Templates Do Template Extension
How to Check If Function Exists in JavaScript
Inline Ruby in :JavaScript Haml Tag
How to Prevent the Backspace Key from Navigating Back
Losing "This" Context in JavaScript When Passing Around Members
Reserved Keywords in JavaScript
How to Wait in Node.Js (Javascript)? L Need to Pause for a Period of Time
Format a Number as 2.5K If a Thousand or More, Otherwise 900