Shiny Widgets in Dt Table

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:

Sample Image

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",
" });",
"}"
)

Sample Image

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)

Sample Image

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



Leave a reply



Submit