Manage Shiny Sweetalert Size with Bootstrap - javascript

Below is code showing that the size of a sweetalert when bootstrap is used is very large. If you comment out the navbarpage() code chunk I note in the sample below the sweetalert is smaller.
I suppose I could overwrite with new .css which is fine. But, is there an alternative way to deal with that via arguments in the function itself? I don't see an argument in the help, but there is the ... which passes to .js. I'm not savvy enough with js to know if that's an option and if so what might that look like?
Thanks for any suggestions
library(shiny)
library(bslib)
library(shinyBS)
ui <- fluidPage(
### Code Chunk to comment out
navbarPage(
theme = bs_theme(bootswatch = "flatly", version = 4),
title = 'Methods',
tabPanel('One'),
),
### end BS code chunk
tags$h2("Sweet Alert examples"),
actionButton(
inputId = "success",
label = "Launch a success sweet alert",
icon = icon("check")
),
actionButton(
inputId = "error",
label = "Launch an error sweet alert",
icon = icon("remove")
),
actionButton(
inputId = "sw_html",
label = "Sweet alert with HTML",
icon = icon("thumbs-up")
)
)
server <- function(input, output, session) {
observeEvent(input$success, {
sendSweetAlert(
title = "Success !!",
text = "All in order",
type = "success"
)
})
observeEvent(input$error, {
sendSweetAlert(
title = "Error !!",
text = "It's broken...",
type = "error"
)
})
observeEvent(input$sw_html, {
sendSweetAlert(
title = NULL,
text = tags$span(
tags$h3("With HTML tags",
style = "color: steelblue;"),
"In", tags$b("bold"), "and", tags$em("italic"),
tags$br(),
"and",
tags$br(),
"line",
tags$br(),
"breaks",
tags$br(),
"and an icon", icon("thumbs-up")
),
html = TRUE
)
})
}
shinyApp(ui, server)

Related

TradingView javascript widget deleting the UI in Shiny

I would like to integrate a JS code to a Shiny application to load a TradingView JS widget.
The problem is when the app is loading, the selector input disappears and the TradingView widget replaces the whole UI, I do not know why.
library(shiny)
library(shinyjs)
jsCode <- 'shinyjs.pageCol = function(para){new TradingView.widget( {"width": 640,"height": 400,"symbol": para,"interval": "D","timezone": "Etc/UTC","theme": "light", "style": "1",
"locale": "en", "toolbar_bg": "#f1f3f6","enable_publishing": false, "allow_symbol_change": true,"container_id": "tradingview_e9634"} );}'
shinyApp(
ui = fluidPage(
div(selectInput("ticker", "Ticker:",
c('NASDAQ:AMD', 'NASDAQ:TSLA', 'NASDAQ:GE'))),
tags$head(HTML('<script type="text/javascript" src="https://s3.tradingview.com/tv.js"></script>')) ,
useShinyjs(),
div(extendShinyjs(text = jsCode, functions = c("pageCol")))
),
server = function(input, output) {
observeEvent(input$ticker, {
js$pageCol(input$ticker)
})
}
)
There are two ways of making it work, as described in this other post (related only to Javascript): TradingView widget replacing entire HTML body.
Either give the ID attribute name you chose in your jsCode to the div tag:
div(id="tradingview_e9634", extendShinyjs(text = jsCode, functions = c("pageCol")))
Or use an iframe: place the following chart.html file in a www subfolder of your app folder.
<html>
<head>
<script type="text/javascript" src="https://s3.tradingview.com/tv.js"></script>
<script>
function getParameterByName(name, url) {
if (!url) {
url = window.location.href;
}
name = name.replace(/[\[\]]/g, "\\$&");
var regex = new RegExp("[?&]" + name + "(=([^&#]*)|&|#|$)"),
results = regex.exec(url);
if (!results) return null;
if (!results[2]) return '';
return decodeURIComponent(results[2].replace(/\+/g, " "));
}
var para = getParameterByName('value');
console.log(para);
var fxWidget = new TradingView.widget({
"width": 640,
"height": 400,
"symbol": para,
"interval": "1",
"timezone": "Etc/UTC",
"theme": "light",
"style": "1",
"locale": "en",
"toolbar_bg": "#f1f3f6",
"enable_publishing": false,
"allow_symbol_change": true,
"container_id": "tradingview_e9634"
});
</script>
</head>
<body>
</body>
</html>
and use this app.R (simpler than the other version, no need for shinyjs):
library(shiny)
shinyApp(
ui = fluidPage(
div(selectInput("ticker", "Ticker:",
c('NASDAQ:AMD', 'NASDAQ:TSLA', 'NYSE:GE'))),
htmlOutput("frame")
),
server = function(input, output) {
observeEvent(input$ticker, {
query <- paste0("chart.html?value=", input$ticker)
output$frame <- renderUI({
tags$iframe(src=query, width=660, height=450)
})
})
})

Using values selected from a javascript based select menu in shiny

I am using the jQuery plugin ComboTree to display a tree-like select menu in my shiny app.
I am having trouble retrieving those values (e.g. c("Item 2", "Item 2-1")) to use in some output. So the issue here is to retrieve whatever values are selected from the select menu ($("example").val();).
ui.r:
ui <- function(){
fluidPage(
tags$head(
tags$script(src = "comboTreePlugin.js"),
tags$script(src = "icontains.js"),
tags$link(rel = "stylesheet", type = "text/css", href = "comboTreeStyle.css")
),
includeScript("myData.json"),
# layouy content ----
sidebarLayout(
sidebarPanel(width = 3,
tags$input(type = "text", id = "example", placeholder = "Select"),
uiOutput("comboTreeMenu")
),
mainPanel(width = 9)
)
)
}
server.r:
server <- function(input, output, session){
output$comboTreeMenu <- renderUI({
includeScript("www/example.js")
})
# want to do some manipulation with the resulting selections from the
# combo tree. Something along the lines of:
# selections <- eventReactive(input$click, {
# return(input$comboTreeSelections)
# })
}
example.js:
comboTree1 = $('#example').comboTree({
source: myData,
isMultiple: true
});
myData.json:
var myData = [
{
id: 0,
title: 'Item 1 '
}, {
id: 1,
title: 'Item 2',
subs: [
{
id: 10,
title: 'Item 2-1'
}, {
id: 11,
title: 'Item 2-2'
}, {
id: 12,
title: 'Item 2-3'
}
]
}, {
id: 2,
title: 'Item 3'
}
];
I've tried to add an extra piece of js script like so:
selectedValues = $("#example").val();
Shiny.onInputChange("comboTreeSelections", selectedValues);
Thank you!
This is just a quick fix, as I don't really recommend using a pure jQuery plugin, since you will have to write all the interaction between combotree and Shiny yourself. But when you're only interested in the actual selected items, you could do this:
In comboTreePlugin.js change the function at line 129 to:
this._elemItemsTitle.on('click', function(e){
e.stopPropagation();
if (_this.options.isMultiple)
_this.multiItemClick(this);
else
_this.singleItemClick(this);
var selItem = comboTree1.getSelectedItemsTitle();
Shiny.onInputChange('selTitle', selItem);
});
This example will only work, when you really click on an item, it wont fire when you select an item by hitting Enter. You would have to copy/paste the last 2 lines above in the keydown-event handler (code 13).
Then you can access the variable selTitle with input$selTitle in Shiny.
Here's a small ShinyApp which prints out the selected titles:
library(shiny)
ui <- {fluidPage(
tags$head(
tags$script(src = "comboTreePlugin.js"),
tags$script(src = "icontains.js"),
tags$link(rel = "stylesheet", type = "text/css", href = "comboTreeStyle.css")
),
includeScript("www/myData.json"),
sidebarLayout(
sidebarPanel(width = 3,
tags$input(type = "text", id = "example", placeholder = "Select"),
uiOutput("comboTreeMenu"),
verbatimTextOutput("selected")
),
mainPanel(width = 9)
)
)}
server <- function(input, output, session){
output$comboTreeMenu <- renderUI({
includeScript("www/example.js")
})
output$selected <- renderPrint({
req(input$selTitle)
print(input$selTitle)
})
}
shinyApp(ui, server)
I found another method, where you dont have to mess with the source code and just inject some javascript.
This will trigger a setInterval function, when the dropdown is visible/openend and will re-run every 500ms.
library(shiny)
js <- HTML("
$(function() {
var selection = setInterval(function() {
if($('.comboTreeDropDownContainer').is(':visible')) {
var selItem = comboTree1.getSelectedItemsTitle();
Shiny.onInputChange('selTitle', selItem)
}
}, 500);
});
")
ui <- {fluidPage(
tags$head(
tags$script(src = "comboTreePlugin.js"),
tags$script(src = "icontains.js"),
tags$script(js),
tags$link(rel = "stylesheet", type = "text/css", href = "comboTreeStyle.css")
),
includeScript("www/myData.json"),
sidebarLayout(
sidebarPanel(width = 3,
tags$input(type = "text", id = "example", placeholder = "Select"),
uiOutput("comboTreeMenu"),
verbatimTextOutput("selected")
),
mainPanel(width = 9)
)
)}
server <- function(input, output, session){
output$comboTreeMenu <- renderUI({
includeScript("www/example.js")
})
output$selected <- renderPrint({
req(input$selTitle)
print(input$selTitle)
})
}
shinyApp(ui, server)

Show image as a node in GoJS with React

im trying to show a picture as a node to be draggable for a react projet.
Im using GoJS for that. I managed to create the node and it's draggble but the image doesnt appear in it.
Here is my code :
renderCanvas(){
try{
//1- Create a diagram (act as the view to the model/data )
let myDiagram =
$(go.Diagram, "MyDiagDiv",
{
initialContentAlignment: go.Spot.Center,
"undoManager.isEnabled": true
}
);
// 1- End
//4- define node template
myDiagram.nodeTemplate =
$(go.Node, "Horizontal",
{background:"#44CCFF"},
$(go.Picture,
{margin:10, width:50, height:50, background:"red"},
new go.Binding("source")
),
$(go.TextBlock,
"Default Text",
{margin:12, stroke:"white", font:"bold 16px sans-serif"},
new go.Binding("text", "name")
)
);
//4- End
// 2- Create a model (hold the data)
let myModel = $(go.Model);
myModel.nodeDataArray = [
{name: 'Alpha', source:"./Sinkv4.png"},
{name: 'Beta', source:"./Sinkv4.png"},
{}
];
//2- End
//3- Link diagram to model
myDiagram.model = myModel;
//3- End
}catch(e){
console.log("Error : ", e);
}
} //End RenderCanvas
this is the result im getting :
result
Any Idea why the pictures doesnt appear pls.
Thanks for your help
PS : the images are in the same dir as the file

How to get row values from selected row in a Data Table in R Shiny App

I need to get the selected row 1st column value from the DT Data Table. Using, DataTable_rows_selected , I am able to get the selected row count, Now I am looking for ways to extract the row values from the data table. In the example below, there are two observeEvent based on action button, 1st observe event is import and displays the data and 2nd one needs to display the selected row 1st col value so that I can use the same achieve other features. Please note,In Actual Application, the imported data is a web service API and which I am parsing in R and converting to data frame.
Sample Example:
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Data Table Example"),
dashboardSidebar(
sidebarMenu(
menuItem('Tabs', tabName='tabs',
menuSubItem('Tab 1', tabName='tab1'),
menuSubItem('Tab 2', tabName='tab2')
)
)
),
dashboardBody(
tabItems(
tabItem(tabName='tab1',
actionButton("import","Import"),
br(),
tags$div(tags$h3(tags$b(" Get Selected Row Values",align="middle",style="color: rgb(57,156,8)"))),
br(),
DT::dataTableOutput('ProductDataTable')
),
tabItem(tabName='tab2',
actionButton("display","Display"),
uiOutput('info')
)
)
)
)
server <- function(input, output) {
observeEvent(input$import,{
Product <- read.csv2("RulesData.csv", header=TRUE, sep=";")
output$ProductDataTable <- DT::renderDataTable({
DT::datatable(Product,selection = "single",
extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
rownames=FALSE,
options=list(dom = 'Bfrtip',
searching = T,
pageLength = 25,
searchHighlight = TRUE,
colReorder = TRUE,
fixedHeader = TRUE,
filter = 'bottom',
buttons = c('copy', 'csv','excel', 'print'),
paging = TRUE,
deferRender = TRUE,
scroller = TRUE,
scrollX = TRUE,
scrollY = 700
))
})
})
observeEvent(input$display,{
row_count <- input$ProductDataTable_rows_selected
output$info <- renderPrint({
cat('Row Selected: ')
cat(row_count, sep = ', ')
cat(Product[1,2], sep = ', ')
})
})
}
shinyApp(ui, server)
check this code below if this is what You are looking for:
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Data Table Example"),
dashboardSidebar(
sidebarMenu(
menuItem('Tabs', tabName='tabs',
menuSubItem('Tab 1', tabName='tab1'),
menuSubItem('Tab 2', tabName='tab2')
)
)
),
dashboardBody(
tabItems(
tabItem(tabName='tab1',
actionButton("import","Import"),
br(),
tags$div(tags$h3(tags$b(" Get Selected Row Values",align="middle",style="color: rgb(57,156,8)"))),
br(),
DT::dataTableOutput('ProductDataTable')
),
tabItem(tabName='tab2',
actionButton("display","Display"),
uiOutput('info')
)
)
)
)
server <- function(input, output) {
Product <- reactive({mtcars})
observeEvent(input$import,{
output$ProductDataTable <- DT::renderDataTable({
DT::datatable(Product(),selection = "single",
extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
rownames=FALSE,
options=list(dom = 'Bfrtip',
searching = T,
pageLength = 25,
searchHighlight = TRUE,
colReorder = TRUE,
fixedHeader = TRUE,
filter = 'bottom',
buttons = c('copy', 'csv','excel', 'print'),
paging = TRUE,
deferRender = TRUE,
scroller = TRUE,
scrollX = TRUE,
scrollY = 700
))
})
})
observeEvent(input$display,{
output$info <- renderPrint({
row_count <- input$ProductDataTable_rows_selected
data <- Product()[row_count, ]
cat('Row Selected: ')
cat(data[,1]) #display the selected row 1st col value
})
})
}
shinyApp(ui, server)
I have used mtcars dataset as an example, the problem was that Your data was inside of the observer (one with input$import) and as You need to use it for other analysis such as displaying of the row value of first column (i have not understood well what did You mean about that as Your code is telling different thing), data had to be moved outside of the observer and put into reactive.
[UPDATE]
I have used if statement to import the data instead of observeEvent
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Data Table Example"),
dashboardSidebar(
sidebarMenu(
menuItem('Tabs', tabName='tabs',
menuSubItem('Tab 1', tabName='tab1'),
menuSubItem('Tab 2', tabName='tab2')
)
)
),
dashboardBody(
tabItems(
tabItem(tabName='tab1',
actionButton("import","Import"),
br(),
tags$div(tags$h3(tags$b(" Get Selected Row Values",align="middle",style="color: rgb(57,156,8)"))),
br(),
DT::dataTableOutput('ProductDataTable')
),
tabItem(tabName='tab2',
actionButton("display","Display"),
uiOutput('info')
)
)
)
)
server <- function(input, output) {
Product <- reactive({
if(input$import == 0)
{
return()
}
isolate({
input$import
data <- mtcars # Here read Your data: read.csv2("RulesData.csv", header=TRUE, sep=";")
})
})
output$ProductDataTable <- DT::renderDataTable({
DT::datatable(Product(),selection = "single",
extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
rownames=FALSE,
options=list(dom = 'Bfrtip',
searching = T,
pageLength = 25,
searchHighlight = TRUE,
colReorder = TRUE,
fixedHeader = TRUE,
filter = 'bottom',
buttons = c('copy', 'csv','excel', 'print'),
paging = TRUE,
deferRender = TRUE,
scroller = TRUE,
scrollX = TRUE,
scrollY = 700
))
})
observeEvent(input$display,{
output$info <- renderPrint({
row_count <- input$ProductDataTable_rows_selected
data <- Product()[row_count, ]
cat('Row Selected: ')
cat(data[,1]) #display the selected row 1st col value
})
})
}
shinyApp(ui, server)
one more way to get row values from Data Table is DT:DataTable Call Back option in association with Java Script JS().
Here is the code:
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Data Table Example"),
dashboardSidebar(
sidebarMenu(
menuItem('Tabs', tabName='tabs',
menuSubItem('Tab 1', tabName='tab1'),
menuSubItem('Tab 2', tabName='tab2')
)
)
),
dashboardBody(
tabItems(
tabItem(tabName='tab1',
actionButton("import","Import"),
br(),
tags$div(tags$h3(tags$b("Get Selected Row Values",style="color: rgb(57,156,8)"))),
br(),
DT::dataTableOutput('ProductDataTable')
),
tabItem(tabName='tab2',
actionButton("display","Display"),
uiOutput('info')
)
)
)
)
server <- function(input, output) {
observeEvent(input$import,{
Product <- mtcars
output$ProductDataTable <- DT::renderDataTable({
DT::datatable(Product,selection = "single",
# JS using call back function to get the row values on single click
callback = JS("table.on('click.dt', 'tr',
function() {
Shiny.onInputChange('rows', table.rows(this).data().toArray());
});"),
extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
rownames=FALSE,
options=list(dom = 'Bfrtip',
searching = T,
pageLength = 25,
searchHighlight = TRUE,
colReorder = TRUE,
fixedHeader = TRUE,
filter = 'bottom',
buttons = c('copy', 'csv','excel', 'print'),
paging = TRUE,
deferRender = TRUE,
scroller = TRUE,
scrollX = TRUE,
scrollY = 700
))
})
})
observeEvent(input$display,{
row_count <- input$ProductDataTable_rows_selected
output$info <- renderPrint({
cat('Row Selected 1st Col Value: ')
# getting 1st row col value
cat(input$rows[1], sep = ', ')
})
})
}
shinyApp(ui, server)

Shiny module synchronous XMLHttpRequest on the main thread

I'm working on a Shiny module and generating data table using Javascript code through Ajax. But when the module is used in a Shiny app, Chrome keeps saying there is synchronous XMLHttpRequest on the main thread and I can't figure out why.
The module ui is generated by Javascript code which has a data table listing some data objects retrieved by Ajax call to a local desktop application's RESTful API. There is two buttons in the UI, one is 'Refresh', when it is clicked, ajax.reload() gets called while the other one is an 'Import' button which will import the selected row into the Shiny app.
I'm assuming the issue is not caused by the 'Import' button because when the page loads, the warning message shows up immediately, the 'Import' button didn't get clicked and plus the importing process is explicitly specified to use an async call. So the issue is caused by the initial ajax call that initializes the data table but I think it should default use a async call as well.
Any suggestions? Thanks!
wrapWithDocumentReady <- function(jsCode) {
return(paste0("$(document).ready(function(){", jsCode, "});"))
}
myModuleUI <- function(id) {
ns <- NS(id)
jsCode <- paste0(
# 1st to initialize the data table
"let objectTable = $('#",
ns("dataObjectTable"),
"').DataTable( {
ajax: {
url: 'http://localhost:XXXX/some_application/data',
dataSrc: ''
},
columns: [
{ name: 'name', data: 'name', title: 'Name' },
{ name: 'data_type', data: 'data_type', title: 'Data Type', visible:false },
{ name: 'id', data: 'id', title: 'ID', visible: false },
{ name: 'dimension', data: 'dimension', title: 'Dimension'},
],
select: {
style: 'single'
},
} );",
# 2nd to bind the 'Import' button with event
"$('#",
ns("importButton"),
"').click(function() {",
"
let selectedDataId = objectTable.cell('.selected', 'id:name').data();
var xmlhttp = new XMLHttpRequest();
var url = 'http://localhost:XXXX/some_application/data/'.concat(selectedDataId);
xmlhttp.onreadystatechange = function() {
if (this.readyState == 4) {
if (this.status == 200) {
var dataJson = this.responseText;
Shiny.onInputChange('", ns("addDataObject"),"', dataJson);
}
}
};
xmlhttp.open('GET', url, true);
xmlhttp.send();
});",
# 3rd to bind the 'Reresh' button with event
"$('#",
ns("refreshButton"),
"').click(function() {
objectTable.ajax.reload();
});"
);
tagList(
div(tags$table(id = ns("dataObjectTable"), width="100%")),
actionButton(ns("refreshButton"), "Refresh"),
actionButton(ns("importButton"), "Import"),
tags$script(wrapWithDocumentReady(jsCode))
)
}
myModule <- function(input, output, session) {
importedData <- reactive ({
jsonStr <- input$addDataObject
if (!is.null(jsonStr)) {
# passing the data and return
} else {NULL}
})
return(importedData)
}

Categories