我正在开发到我的小型平台的Web界面，以在R中进行股票投资，并且在尝试实现简单的CRUD功能时遇到了一个问题，即使用捕获其结果的模式警报来确认行删除。我正在使用闪亮的模块方法。
要实现这一点，我发现了ShinyWidgets / confirmSweetAlert，所有示例代码都无缝运行。但是，在模块内部时，根本不会捕获单击确认按钮。
也许在代码中出现了问题，或者模块本身出现了问题，但是我对此深感困惑。
对于解决或实现此功能的任何建议，我将不胜感激。下面是我的模块代码。有关的行是从124到137和174到193
谢谢。
Francisco Bispo
.splitCandidates <<- data.frame()
.splitCalendar <<- data.frame()
.splitTypes <- c('PRICE_EVENT',
'VOLUME_EVENT',
'SPLIT',
'INPLIT')
splits <- function() {
dt <- bmfaGetSplitCandidates()
dt <- dt %>% transmute(Symbol = symbol,
Date = date,
`Prior Date` = prior_date,
Close = close,
`Prior Close` = prior_close,
`Split Factor` = split_factor,
`Reference Split Factor` = reference_split_factor,
`Last Split Date` = last_split_date)
.splitCandidates <<- dt
.splitCandidates
}
splitsCalendar <- function() {
dt <- bmfaGetSplitCalendar()
dt <- dt %>% transmute(Symbol = scal_symbol,
Date = scal_date,
`Split Type` = scal_type,
Issuer = scal_issuer,
`Split Factor` = scal_split_factor,
`Factor Value 1` = scal_split_factor_value1,
`Factor Value 2` = scal_split_factor_value2)
.splitCalendar <<- dt
.splitCalendar
}
quotes <- function(symbol, fromDate, toDate) {
dt <- bmfaXtsAsDataframe(bmfaGetQuotes(symbol,
dateFrom = fromDate,
dateTo = toDate,
source = 'bmfa',
autoAssign = FALSE,
normalizeColNames = TRUE))
dt <- dt %>%
mutate(Symbol = symbol) %>%
select(Symbol,
Date,
Open,
Close)
dt
}
splitsCalendarNewRecord <- function() {
.formData <- list()
.formData$symbol <- ""
.formData$date <- as.character(Sys.Date())
.formData$type <- .splitTypes[[1]]
.formData$issuer <- ""
.formData$factor <- ""
.formData$factorVal1 <- 0
.formData$factorVal2 <- 0
.formData
}
splitsCalendarManageRecord <- function(operation, data) {
#TODO perform data validations and user feedback
bmfaManageSplitCalendar(operation, data)
}
splitsCalendarSaveRecord <- function(data) {
splitsCalendarManageRecord('UPSERT', data)
}
splitsCalendarDeleteRecord <- function(data) {
splitsCalendarManageRecord('DELETE', data)
}
splitsCalendarUpdateInputs <- function(data, session) {
updateTextInput(session , "splitSymbol" , value = data$symbol)
updateDateInput(session , "splitDate" , value = data$date)
updateSelectInput(session , "splitType" , selected = data$type)
updateTextInput(session , "splitIssuer" , value = data$issuer)
updateTextInput(session , "splitFactor" , value = data$factor)
updateNumericInput(session, "splitFactorVal1", value = data$factorVal1)
updateNumericInput(session, "splitFactorVal2", value = data$factorVal2)
}
# ui function
stockQuotesSplitsUI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
column(12,div(actionButton(ns("refresh"), "Refresh", icon = icon("refresh")), class="moduleActionButtonPanel"))
),
fluidRow(
column(7,
p("Split Candidates", class="tableCaption"),
p("Select a symbol on table to show its history.", class="tableNotes"),
DTOutput(ns("splitCandidates"))),
column(5,
p("Quote History", class="formCaption"),
div(class="formBody", DTOutput(ns("quoteHistory"))))
),
fluidRow(hr()),
fluidRow(
column(8,
p("Splits Calendar", class="tableCaption"),
p("Select a split on the table to edit.", class="tableNotes"),
DTOutput(ns("splitCalendar"))),
column(4,
p("Edit Split", class="formCaption"),
div(class="formBody",
textInput(ns("splitSymbol"), "Symbol", value = "", width = "100%"),
dateInput(ns("splitDate"), "Date", value = NULL, min = NULL, max = NULL,
format = "yyyy-mm-dd", startview = "month", weekstart = 0,
language = "en", width = "100%", autoclose = TRUE),
selectInput(ns("splitType"), "Type", .splitTypes, multiple = FALSE, width = "100%"),
textInput(ns("splitIssuer"), "Issuer", value = "", width = "100%"),
textInput(ns("splitFactor"), "Split Factor", value = "", width = "100%"),
numericInput(ns("splitFactorVal1"), "Factor Value #1", value = 0, width = "100%"),
numericInput(ns("splitFactorVal2"), "Factor Value #2", value = 0, width = "100%"),
div(actionButton(ns("submit"), "Submit", icon = icon("check")),
actionButton(ns("new"), "New", icon = icon("plus")),
actionButton(ns("delete"), "Delete", icon = icon("minus")),
class="moduleActionButtonPanel")))
),
conditionalPanel(condition="$('html').hasClass('shiny-busy')",
div(class = "busyMessage",
img(src="images/loading.gif", class="busyIcon")
))
)
}
# server function
stockQuotesSplits <- function(input, output, session) {
##--crud functions
formData <- reactive({
.formData <- list()
.formData$symbol <- input$splitSymbol
.formData$date <- input$splitDate
.formData$type <- input$splitType
.formData$issuer <- input$splitIssuer
.formData$factor <- input$splitFactor
.formData$factorVal1 <- input$splitFactorVal1
.formData$factorVal2 <- input$splitFactorVal2
.formData
})
observeEvent(input$new, {
splitsCalendarUpdateInputs(splitsCalendarNewRecord(), session)
})
observeEvent(input$submit, {
splitsCalendarSaveRecord(formData())
}, priority = 1)
observeEvent(input$delete, {
confirmSweetAlert(
session = session,
inputId = "splitConfirmDelete",
type = NULL,
text = p(icon("question-circle", "fa-3x"), "Confirm deletion ?", class="messageDialogBox"),
btn_labels = c("Cancel", "Ok"),
danger_mode = TRUE, html = TRUE
)
})
observeEvent(input$splitConfirmDelete, {
if (isTRUE(input$splitConfirmDelete)) {
sendSweetAlert(session = session, title = "Ok! I'm ready to delete...", text = NULL, type = NULL,
btn_labels = "Ok", html = FALSE, closeOnClickOutside = TRUE)
# splitsCalendarDeleteRecord(formData())
} else
sendSweetAlert(session = session, title = "Oh! Oh!", text = NULL, type = NULL,
btn_labels = "Ok", html = FALSE, closeOnClickOutside = TRUE)
}, ignoreNULL = TRUE)
observeEvent(input$splitCalendar_rows_selected, {
if (!is.null(input$splitCalendar_rows_selected) && input$splitCalendar_rows_selected > 0) {
.tableData <- list()
i <- input$splitCalendar_rows_selected
.tableData$symbol <- .splitCalendar[i,1]
.tableData$date <- .splitCalendar[i,2]
.tableData$type <- .splitCalendar[i,3]
.tableData$issuer <- .splitCalendar[i,4]
.tableData$factor <- .splitCalendar[i,5]
.tableData$factorVal1 <- .splitCalendar[i,6]
.tableData$factorVal2 <- .splitCalendar[i,7]
splitsCalendarUpdateInputs(.tableData, session)
}
})
##-- end crud functions
output$splitCandidates <- renderDT({
input$refresh
splits()
}, selection = 'single', options = list(pageLength = 5))
output$quoteHistory <- renderDT({
if (!is.null(input$splitCandidates_rows_selected) && input$splitCandidates_rows_selected > 0) {
i <- input$splitCandidates_rows_selected
quotes(.splitCandidates[i,1], as.Date(.splitCandidates[i,8]), as.Date(.splitCandidates[i,2]))
} else
quotes('XXXX', Sys.Date(), Sys.Date())
}, selection = 'none', options = list(pageLength = 5))
output$splitCalendar <- renderDT({
input$refresh
input$submit
input$deleteOk
splitsCalendarUpdateInputs(splitsCalendarNewRecord(), session)
splitsCalendar()
}, selection = 'single')
}