Develop Reference

Shiny CRUD not working in golem module (but working in simple shiny app)

I have adapted some CRUD code which works perfectly in a classical shiny app. I decided to include it in a golem module. But in golem the edit and delete buttons don't launch the modal window.
I checked if I missed some ns(), but I don't think so. I have also tried to load in a different way the get_id() function (see below) but it changed nothing.
The only curious clue I found was in the browser dev environment which indicated "Couldn't find table with id CRUD_1-dt_table"
I am new to Stack Overflow. Thank your for your help.
Please find below the code in script.js which seems to be loaded normally
function get_id(clicked_id) {
Shiny.setInputValue("current_id", clicked_id, {priority: "event"});
}
The code is simple for the UI part of the module
mod_CRUD_ui <- function(id){
ns <- NS(id)
tagList(
# Button to add a project -> it works
div(
class = "container",
div(
style = "margin-top: 50px;", shiny::actionButton(
inputId = ns("add_project"), label = "Ajouter un projet",
icon = shiny::icon("plus"), class = "btn-success"
)
)
),
# To display the DT table
div(
class = "container",
style = "margin-top: 50px;",
DT::DTOutput(outputId = ns("dt_table"), width = "100%")
),
shiny::includeScript(system.file("app/www", "script.js", package = "REXDI"))
# shiny::includeScript("app/www/script.js")
# tags$script(src= "script.js")
)
}
The data is first contained in global$CRUD_init (reactiveValues) which is initialized when the app is launched in another module
#' CRUD Server Functions
mod_CRUD_server <- function(id, global){
moduleServer( id, function(input, output, session){
ns <- session$ns
observeEvent(global$CRUD_init , {
global$CRUD_init_co <- global$CRUD_init
# the get_id() function from the script.js file is used in the next part of # the code. Normally it works
global$create_btns <- function(x) {
x %>%
purrr::map_chr(~
paste0(
'<div class = "btn-group">',
'<button class="btn btn-default action-button btn-info action_button" id="edit_',
.x, '" type="button" onclick=get_id(this.id)>
<i class="fas fa-edit"></i>
</button>
<button class="btn btn-default action-button btn-danger action_button" id="delete_',
.x, '" type="button" onclick=get_id(this.id)>
<i class="fa fa-trash-alt"></i>
</button>
</div>'
))
}
# Buttons in df global$CRUD
x <- global$create_btns(global$CRUD_init_co$id)
global$CRUD_init_co <- global$CRUD_init_co %>%
dplyr::bind_cols(tibble("Buttons" = x))
## reactiveValues global$CRUD ----
global$CRUD <- shiny::reactiveValues(
df = global$CRUD_init_co %>%
dplyr::select(-id),
dt_row = NULL,
add_or_edit = NULL,
edit_button = NULL,
keep_track_id = max(global$CRUD_init_co$id) + 1
)
})
It is followed by the function modal_dialog (because it's long I kept only few arguments and inputs
modal_dialog <- function(Projet,
Centre,
...and so forth...,
edit) {
if(edit) {
x <- "Soumettre modifications"
} else {
x <- "Ajouter un projet"
}
shiny::modalDialog(
title = "Editer un projet",
div(
class = "text-center",
div(
style = "display: inline-block;",
shiny::textInput(inputId = ns("Projet"),
label = "Projet",
value = Projet,
placeholder = "",
width = "200px")
),
div(
style = "display: inline-block;",
shiny::textInput(inputId = ns("Centre"),
label = "Centre",
value = Centre,
placeholder = "Entrer un Centre",
width = "200px")
),
...and so forth...
),
size = 'm',
easyClose = TRUE,
footer = div(
class = "pull-right container",
shiny::actionButton(inputId = ns("final_edit"),
label = x,
icon = shiny::icon("edit"),
class = "btn-info"),
shiny::actionButton(inputId = ns("dismiss_modal"),
label = "Fermer",
class = "btn-danger")
)
) %>% shiny::showModal()
}
I also tried to add ns("dt_table") to DT::dataTableProxy("dt_table") but it did not work and I am not really sure to understand the dataTableProxy in a module
## output DT ----
output$dt_table <- DT::renderDT(
{
shiny::isolate(global$CRUD$df)
},
escape = F,
rownames = FALSE,
options = list(processing = FALSE)
)
## Proxy DT ----
proxy <- DT::dataTableProxy("dt_table")
shiny::observe({
DT::replaceData(proxy, global$CRUD$df, resetPaging = FALSE, rownames = FALSE)
})
The code for deleting is clear
## delete row ----
shiny::observeEvent(input$current_id, {
shiny::req(!is.null(input$current_id) &
stringr::str_detect(input$current_id,
pattern = "delete"
))
global$CRUD$dt_row <- which(stringr::str_detect(global$CRUD$df$Buttons,
pattern = paste0("\\b", input$current_id, "\\b")
))
The purpose of the next chunk of code is only for keeping memory of what has been deleted, so I did not include it in this post
then deleting
sql_id <- global$CRUD$df[global$CRUD$dt_row, ][["Buttons"]] %>%
stringr::str_extract_all(pattern = "delete_[0-9]+") %>%
unlist() %>%
readr::parse_number()
query <- stringr::str_glue("DELETE FROM TDP WHERE id = {sql_id}")
DBI::dbSendQuery(
con,
query
)
...
})
The edit part like the deleting part is not launched when clicking on the buttons. All the code works in a classic shiny app, and I don't see any missing ns(), so it is a mystery for me
# when edit button is clicked, modal dialog shows current editable row filled out ----
shiny::observeEvent(input$current_id, {
shiny::req(!is.null(input$current_id) &
stringr::str_detect(input$current_id,
pattern = "edit"
))
global$CRUD$dt_row <- which(stringr::str_detect(global$CRUD$df$Buttons,
pattern = paste0("\\b", input$current_id, "\\b")
))
df <- global$CRUD$df[global$CRUD$dt_row, ]
modal_dialog(
### A modifier -----
Projet = df$Projet,
Centre = df$Centre,
...and so forth or else the code is too long...
edit = TRUE
)
global$CRUD$add_or_edit <- NULL
})
# when final edit button is clicked, table will be changed ----
shiny::observeEvent(input$final_edit, {
shiny::req(!is.null(input$current_id) &
stringr::str_detect(input$current_id, pattern = "edit") &
is.null(global$CRUD$add_or_edit))
global$CRUD$edited_row <- dplyr::tibble(
Projet = input$Projet,
Centre = input$Centre,
....and so forth...or else it is too long
Buttons = global$CRUD$df$Buttons[global$CRUD$dt_row]
)
sql_row <- global$CRUD$edited_row %>%
dplyr::select(-Buttons)
id <- global$CRUD$df[global$CRUD$dt_row, ][["Buttons"]] %>%
stringr::str_extract_all(pattern = "delete_[0-9]+") %>%
unlist() %>%
readr::parse_number()
# browser()
query <- paste0(
"UPDATE TDP SET ",
paste0(names(sql_row), "=", "'", unlist(c(sql_row)), "'", collapse = ", "),
stringr::str_glue("WHERE id = {id}")
)
DBI::dbSendQuery(
global$con,
query
)
global$CRUD$df[global$CRUD$dt_row, ] <- global$CRUD$edited_row
})
The next part is for adding a project which works so it is not added below and then code to remove modals

R Shiny JS jump to last page conflicting with auto generate value in new row

I have a Shiny app that allows the user to enter their project details to the database. This is achieved by the Add Project Details Button that adds an empty row to the table. When the add button is clicked the app auto generates the next reference number (under column Reference.Number) in the new row based on the previous one.
Another function of the Add button is also to make the app jump to the last page of the table rather than having the user click on the last page number under the table.
The app almost works fine because when I click the Add button, the app does temporarily go the last page, but as soon as the auto generate value is calculated, the app goes back to the first page of the table.
What could be causing this conflict and how can this be fixed?
Sample data (df):
df <- structure(list(Reference.Number = c("33331", "33332", "33333",
"33334", "33335"),
Request.Date = c("1/6/2022", "1/6/2022", "1/19/2022",
"1/20/2021", "1/24/2022"),
Requestor.Name = c("Comm Dist 3 by Kitty", "Comm Dist 3 by Kitty", "Updated maps for David", " Stone Cold", "Updated SOE 60 inch wall map"),
Requestor.Dept.Div = c("C 3 Staff", "C 3 Staff", "Unincorp & Comm", "Mt.Rushmore AME Church Ft. Billy", "SOE"),
Requestor.Phone = c("", "", "", "", ""),
Contact.Person = c("Tommy", "Tommy", "Bob", "Bob", "Joe"),
Contact.Phone = c("1111", "2222", "3333", "ext 1111", "3434"),
Deadline = c("1/20/2022", "1/20/2022", "1/22/2022", "", "1/24/2022"),
Project.Description = c("45x36 portrait map ", "45x36 portrait map ", "24x24 Unincorporated areas", "Percent Females Aged 25 - 55 Below Poverty Level By Zip Code", "SOE Wall Map 60x60 p"),
Project.File.Location = c("",
"", "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14785 Unincorporated 24x24.pdf",
"C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\FemalesAge10-18BelowPoveryLevel.aprx",
"C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14786 V P 60x60.pdf"
Code:
library(shiny)
library(shinythemes)
library(DT)
library(tidyverse)
# Define UI for application
ui = navbarPage(tags$style("table, .table {color: unset;} .dataTable th, .datatables input {color: white}"),
title = div("GIS Team Projects"),
theme = shinytheme("cyborg"),
tabPanel("GIS Projects",
icon = icon("info"),
div(p(h1("Instructions:"),style="text-align: justify;")),
p("1. The user can add their project details.", style="color:black"),
uiOutput("all"),
sidebarLayout(
sidebarPanel(
actionButton("addData", "Add Project Details"),
),
mainPanel(
downloadButton("download1","Download data as csv"),
DTOutput("contents"),
tags$script(HTML("
Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
// select the target table via its container ID and class:
var target = $('#contents .dataTable');
// display last page:
target.dataTable().api().page('last').draw(false);
});
"))),
)
)
)
# Define server logic required
server <- function(input, output) {
myData = reactiveVal(df)
# Create an 'empty' tibble
user_table =
df %>%
slice(1)
user_table[1,]<-NA
# Display data as is
output$contents =
renderDT(myData(),
server = FALSE,
editable = TRUE,
options = list(lengthChange = TRUE),
rownames = FALSE)
# Store a proxy of contents
proxy = dataTableProxy(outputId = "contents")
# Each time addData is pressed, add user_table to proxy
observeEvent(eventExpr = input$addData, {
myData(myData() %>% bind_rows(user_table %>%
mutate(Reference.Number=as.character(max(as.numeric(myData()$Reference.Number), na.rm = T)+1))))
session$sendCustomMessage('messageJumpToLast', 'some payload here, if needed') # Don't know if this should be added or not!
})
}
# Run the application
shinyApp(ui = ui, server = server)

I didn't try with your app because it gives me headache. Here is a minimal example:
library(shiny)
library(DT)
ui <- basicPage(
br(),
actionButton("addData", "Add Project Details", class = "btn-primary"),
br(), br(),
fluidRow(
column(
width = 12,
DTOutput("mytable")
)
)
)
callback <- c( # with this callback, the app does not jump to the last page if
'$("#addData").on("click", function(){', # the added row goes to a new page
' table.page("last").draw("page");',
'});'
)
callback <- c( # so we use this callback which includes a small delay (200ms)
'$("#addData").on("click", function(){',
' setTimeout(function(){table.page("last").draw("page");}, 200);',
'});'
)
#server
server <- function(input, output, session) {
Dat <- reactiveVal(iris)
#mytable
output[["mytable"]] <- renderDT({
datatable(
isolate(Dat()),
rownames = FALSE,
editable = list(target = "cell"),
callback = JS(callback)
)
}, server = FALSE)
proxy <- dataTableProxy("mytable")
#bind clicks
observeEvent(input[["addData"]], {
newRow <- data.frame(
"Sepal.Length" = runif(1, 5, 7),
"Sepal.Width" = runif(1, 2, 4),
"Petal.Length" = runif(1, 3, 5),
"Petal.Width" = runif(1, 0, 2),
"Species" = "setosa"
)
Dat(rbind(Dat(), newRow)) # just to keep track of the changes
addRow(proxy, newRow, resetPaging = FALSE)
})
# remove btn
observeEvent(input[["mytable_edit"]], {
info <- input[["mytable_edit"]]
Dat(editData(Dat(), info, proxy))
})
}
shinyApp(ui, server)

#Stéphane Laurent deserves all credit for this. Essentially I just used the original posters code and updated it with the answer from Stéphane Laurent. There are certain things like the observeEvent() that don't work as originally posted without the user of the addRow(). Anyways, this should work. Best of luck
df <- data.frame(structure(list(Reference.Number = c("33331", "33332", "33333",
"33334", "33335"),
Request.Date = c("1/6/2022", "1/6/2022", "1/19/2022",
"1/20/2021", "1/24/2022"),
Requestor.Name = c("Comm Dist 3 by Kitty", "Comm Dist 3 by Kitty", "Updated maps for David", " Stone Cold", "Updated SOE 60 inch wall map"),
Requestor.Dept.Div = c("C 3 Staff", "C 3 Staff", "Unincorp & Comm", "Mt.Rushmore AME Church Ft. Billy", "SOE"),
Requestor.Phone = c("", "", "", "", ""),
Contact.Person = c("Tommy", "Tommy", "Bob", "Bob", "Joe"),
Contact.Phone = c("1111", "2222", "3333", "ext 1111", "3434"),
Deadline = c("1/20/2022", "1/20/2022", "1/22/2022", "", "1/24/2022"),
Project.Description = c("45x36 portrait map ", "45x36 portrait map ", "24x24 Unincorporated areas", "Percent Females Aged 25 - 55 Below Poverty Level By Zip Code", "SOE Wall Map 60x60 p"),
Project.File.Location = c("",
"", "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14785 Unincorporated 24x24.pdf",
"C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\FemalesAge10-18BelowPoveryLevel.aprx",
"C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14786 V P 60x60.pdf"
))))
#Made data into dataframe, slice for me doesn't work with the list
library(shiny)
# library(shinythemes #I don't think this is important to the question and I don't have shinythemes
library(DT)
library(tidyverse)
callback <- c( # with this callback, the app does not jump to the last page if
'$("#addData").on("click", function(){', # the added row goes to a new page
' table.page("last").draw("page");',
'});'
)
callback <- c( # so we use this callback which includes a small delay (200ms)
'$("#addData").on("click", function(){',
' setTimeout(function(){table.page("last").draw("page");}, 200);',
'});'
)
# Define UI for application
ui = navbarPage(tags$style("table, .table {color: unset;} .dataTable th, .datatables input {color: white}"),
title = div("GIS Team Projects"),
# theme = shinytheme("cyborg"), #I don't think this is important to the question
tabPanel("GIS Projects",
icon = icon("info"),
div(p(h1("Instructions:"),style="text-align: justify;")),
p("1. The user can add their project details.", style="color:black"),
uiOutput("all"),
sidebarLayout(
sidebarPanel(
actionButton("addData", "Add Project Details"),
),
mainPanel(
downloadButton("download1","Download data as csv"),
DTOutput("contents"),
tags$script(HTML("
Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
// select the target table via its container ID and class:
var target = $('#contents .dataTable');
// display last page:
target.dataTable().api().page('last').draw(false);
});
"))
),
)
)
)
# Define server logic required
server <- function(input, output) {
myData = reactiveVal(df)
# Create an 'empty' tibble
user_table =
df %>%
slice(1)
user_table[1,]<-NA
# Display data as is
output$contents =
renderDT({
datatable(isolate(myData()), #Isolate is needed for Stéphane Laurent's answer
# server = FALSE, #Moved to below
editable = TRUE,
options = list(lengthChange = TRUE),
rownames = FALSE,
callback = JS(callback)
)}, server = FALSE
)
# Store a proxy of contents
proxy = dataTableProxy(outputId = "contents")
# Each time addData is pressed, add user_table to proxy
observeEvent(eventExpr = input$addData, {
#Original way of adding data doesn't work with Stéphane Laurent's answer, so I updated using their format
# myData(myData() %>% bind_rows(user_table %>%
# mutate(Reference.Number=as.character(max(as.numeric(myData()$Reference.Number), na.rm = T)+1))))
newRow<-user_table %>% #replaced the original info with the answer from Stéphane Laurent
mutate(Reference.Number=as.character(max(as.numeric(as.character(myData()$Reference.Number)), na.rm = T)+1))
myData(rbind(myData(), newRow)) # just to keep track of the changes
addRow(proxy, newRow, resetPaging = FALSE)
})
observeEvent(input[["contents_edit"]], {
info <- input[["contents_edit"]]
myData(editData(myData(), info, proxy))
})
}
# Run the application
shinyApp(ui = ui, server = server)

Combine JS with shiny to view plot produced with fieldImageR in a shiny app environment

I want to upload a .tif file, in a shiny application, which you can download from here. Then I need to plot it and process it further. But Im not sure how can I display the plot that I see in Rstudio when processing the .tif in a shiny environment . Im curious if this can happen by combining JS and shiny.
library("devtools")
library("sp")
library("raster")
devtools::install_github("filipematias23/FIELDimageR")
library(FIELDimageR)
EX1<-stack("EX1_RGB.tif")
plotRGB(EX1, r = 1, g = 2, b = 3)
EX1.Crop <- fieldCrop(mosaic = EX1) # For heavy images (large, high resolution, etc.) please use: fast.plot=T
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
fileInput(inputId = 'file1',
label = 'Upload Image',
placeholder = 'JPEG, PNG, and TIFF are supported',
accept = c(
"image/jpeg",
"image/x-png",
"image/tiff",
".jpg",
".png",
".tiff"))
),
dashboardBody()
)
options(shiny.maxRequestSize = 100 * 1024 ^ 2) # to acommodate larger images
server <- function(input, output) { }
shinyApp(ui, server)

How to create language selection wrapper from a gist script?

I have a Gist file written in different languages all do the same thing.
So, I would like to create a language select option similar to Google docs documentation.
Is it possible to create such a wrapper class that accepts a Gist script tag and display as above?
As in embed single file, I tried different query command like <script src="https://gist.github.com/gistid.js?language=python">, but none of them work.

This is the processing code that I ended up with.
With some CSS + javascript hide and toggle logic, it would work like google docs documentation.
I'd appreciate it if anyone updates this answer, with css or js.
import requests
from bs4 import BeautifulSoup
def render_gist_by_file(gist_id):
result = requests.get(f'https://gist.github.com/{gist_id}.js', headers=git_credential)
if result.text.startswith("<!DOCTYPE html>"):
return None
result = result.text
result = result.replace("\\/", "/").replace("\\&", "&").replace("\\$", "$").replace("\\<", "<").replace("\\`", "`").replace("\\n", "\n").replace('\\"', '"')
result = html.unescape(result)
result = result.split("document.write('")[-1][:-3]
bs = BeautifulSoup(result, "html.parser")
for tag in bs.find_all(class_="gist"):
file_box = tag.find(class_="file-box")
root = tag.find(class_="file-box")
toggle_div = bs.new_tag('div', attrs={"class": "gist-meta"})
for i, d in enumerate(tag.find_all(class_="file")):
d["class"] = f"file gist-toggle gist-id-{gist_id}"
if i != 0:
file_box.append(d) # combine to first table
for d in tag.find_all(class_="gist-meta"):
siblings = list(d.next_elements)
file_id, file_name = siblings[4].attrs["href"].split("#")[-1], siblings[5]
gist.file_names.append(file_name)
toggle_a = bs.new_tag('a', attrs={"id": file_id, "class": f"gist-toggle gist-id-{gist_id}", "onclick": f"toggle('gist-id-{gist_id}', '{file_id}')", "style": "padding: 0 18px"})
toggle_a.append(file_name)
toggle_div.append(toggle_a)
d.extract() # remove bottom nav
root.insert(0, toggle_div)
for d in islice(tag.find_all(class_="gist-file"), 1, None):
d.extract() # remove except first
gist.html = str(bs)
return gist

CKeditor remove symbol $100

I Have plugin CKeditor, when I Write text with "$100", ckeditor remove this string, when I save. How I Can resolve this problem?
JS:
<script type="text/javascript">
jQuery(document).ready(function () {
CKEDITOR.config.allowedContent = true;
CKEDITOR.config.extraPlugins = 'dragresize,jsplus_stat';
var editorMd = CKEDITOR.replace('edit_md', {contentsCss: '/css/tools.css'});
var editorRu = CKEDITOR.replace('edit_ru', {contentsCss: '/css/tools.css'});
var editorEn = CKEDITOR.replace('edit_en', {contentsCss: '/css/tools.css'});
//CKFinder.SetupCKEditor( null, '/js/ckfinder3/' );
//CKEDITOR.config.wordcount = {showWordCount: true}
CKEDITOR.config.filebrowserBrowseUrl = '/js/kcfinder/browse.php?opener=ckeditor&type=files';
CKEDITOR.config.filebrowserImageBrowseUrl = '/js/kcfinder/browse.php?opener=ckeditor&type=imagesnew';
CKEDITOR.config.filebrowserFlashBrowseUrl = '/js/kcfinder/browse.php?opener=ckeditor&type=flash';
CKEDITOR.config.filebrowserUploadUrl = '/js/kcfinder/upload.php?opener=ckeditor&type=files';
CKEDITOR.config.filebrowserImageUploadUrl = '/js/kcfinder/upload.php?opener=ckeditor&type=imagesnew';
CKEDITOR.config.filebrowserFlashUploadUrl = '/js/kcfinder/upload.php?opener=ckeditor&type=flash';
//CKFinder.setupCKEditor(null);
/*
CKFinder.setupCKEditor( null, {
skin: 'moono',
swatch: 'b',
onInit: function( finder ) {
finder.on( 'files:choose', function( evt ) {
var file = evt.data.files.first();
//console.log( 'Selected: ' + file.get( 'name' ) );
} );
}
} );
*/
/*
CKEDITOR.editorConfig = function(config) {
config.filebrowserBrowseUrl = '/js/kcfinder/browse.php?opener=ckeditor&type=files';
config.filebrowserImageBrowseUrl = '/js/kcfinder/browse.php?opener=ckeditor&type=images';
config.filebrowserFlashBrowseUrl = '/js/kcfinder/browse.php?opener=ckeditor&type=flash';
config.filebrowserUploadUrl = '/js/kcfinder/upload.php?opener=ckeditor&type=files';
config.filebrowserImageUploadUrl = '/js/kcfinder/upload.php?opener=ckeditor&type=images';
config.filebrowserFlashUploadUrl = '/js/kcfinder/upload.php?opener=ckeditor&type=flash';
};
*/
jQuery('#date_show').datetimepicker({
locale: 'en',
format: 'YYYY-MM-DD HH:mm:ss'
});
});
function openMedia() {
window.open('<?=$adminRoot . 'news/media/id/' . $item->id . '/'?>', '_blank', 'width=800,height=600');
return false;
}
</script>
Code when I load CKeditor, and config this. Please help me fix this problem.

CKEditor is a JavaScript application. It has nothing to do with saving data. I also haven't heard of any built-in filter removing "$100" string. Things you might want to check:
Run CKEDITOR.instances.yourEditorInstanceName.getData();. If "$100" is not there, please look for some third-party script reacting to \$\d pattern or something similar. Another thing to check would be a third-party CKEditor plugins. Perhaps you have some "before save" plugin which filters out such strings.
Please check your server-side code if it doesn't contain any filter removing strings starting with $. Debugging whole request (when editor data is submitted) might also help you find out where exactly "$100" gets removed.