STRING interactive network in Shiny in R - javascript

Problem Statement:
I am trying to load interactive networks of STRING into a Shiny website using R
What I've Tried:
According to STRING, I can embed the interactive network but I need a couple of elements:
Javascript libary
<script type="text/javascript" src="http://string-db.org/javascript/combined_embedded_network_v2.0.2.js"></script>
Embed the div item
<div id="stringEmbedded"></div>
Call the specific protein with parameters e.g. TP53
getSTRING('https://string-db.org', {'ncbiTaxonId':'9606', 'identifiers':['TP53'], 'network_flavor':'confidence'})"
In theory, the produced network should be targetted to wherever the <div id="stringEmbedded"></div> is placed.
So I did this for Shiny:
library(shiny)
library(shinydashboard)
header <- dashboardHeader(title = "Test")
tags$head(HTML("<script type='text/javascript' src='http://string-db.org/javascript/combined_embedded_network_v2.0.2.js'></script>"))
sidebar <- dashboardSidebar(sidebarMenu(
menuItem("Item1", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Item2", tabName = "widgets", icon = icon("th")),
sidebarSearchForm(textId = "searchText", buttonId = "searchButton",label = "Search...") #input$searchText and input$searchButton
))
body <-dashboardBody(
fluidRow(
tags$body(tags$script(HTML("getSTRING('https://string-db.org', {'ncbiTaxonId':'9606', 'identifiers':['TP53'], 'network_flavor':'confidence'})")),
fluidRow(
tabBox(
side = "left", height = "250px",
selected = "Tab3",
tabPanel("Tab1", tags$div(id="stringEmbedded")),
tabPanel("Tab2", "Tab content 2"),
tabPanel("Tab3", "Note that when side=right, the tab order is reversed.")
)
)
ui <- fluidPage(dashboardPage(header, sidebar, body))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)

Following my comments from above, here is a minimal working example on how to embed a STRING gene network into a shiny app. I've made use of shinyjs which -- while not strictly necessary -- makes working with custom JS code easier.
library(shiny)
library(shinyjs)
jsCode <- "
shinyjs.loadStringData = function(gene) {
getSTRING('https://string-db.org', {
'ncbiTaxonId':'9606',
'identifiers': gene,
'network_flavor':'confidence'})
}"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
tags$head(tags$script(src = "http://string-db.org/javascript/combined_embedded_network_v2.0.2.js")),
textInput("gene", "Gene symbol", value = "TP53"),
actionButton("button", "Show"),
h3("Network:"),
tags$div(id = "stringEmbedded")
)
server <- function(input, output, session) {
onclick("button", {
req(input$gene)
js$loadStringData(input$gene)
})
}
shinyApp(ui, server)

Related

Incorporating JS in shiny with Jquery and without Jquery

I am trying to incorporate JS into Shiny that is without writing anything to server. Here is the code. Below are 2 methods (one with JQuery and another without JQuery). But without JQuery is not working. Can anyone help me here?
Not working
library(shiny)
ui <- fluidPage(
tags$head(HTML('<p id="res">Value</p>'),
tags$script("document.getElementById('res').innerHTMl=x")),
textInput("x", label = "Text")
)
server <- function(input, output) {
}
shinyApp(ui, server)
Working
library(shiny)
ui <- fluidPage(
HTML('<p id="res">Value</p>'),
textInput("x", label = "Text"),
tags$script("$('#x').on('input', function(){$('#res').text($(this).val());});")
)
server <- function(input, output) {}
shinyApp(ui, server)
Here is an option with straight javascript.
library(shiny)
ui <- fluidPage(
HTML('<p id="res">Value</p>'),
textInput("x", label = "Text"),
tags$script("
let inputEl = document.getElementById('x');
inputEl.addEventListener('keyup', function(){
document.getElementById('res').textContent = inputEl.value;
});
")
)
server <- function(input, output) {
}
shinyApp(ui, server)

query an arbitrary html element, e.g. to see if it is disabled, with shinyjs

Can shinyjs do something like if(is_disabled("#my_element_id")) do_something()?
I'd like to be able to see if a specific HTML element is disabled (by shinyjs or other means) before doing something else with it.
There's no such function. The answer depends on what you want exactly. Here is something which could help:
library(shiny)
library(shinyjs)
jsCode <- 'shinyjs.isDisabled = function(params) {
var el = $("#radiobtns");
Shiny.setInputValue("disabled", el.prop("disabled"));
}'
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode, functions = "isDisabled"),
actionButton("button", "Disable radio buttons"),
radioButtons("radiobtns", "Radio buttons", c("Yes", "No"))
)
server <- function(input, output) {
observeEvent(input$button, {
toggleState("radiobtns")
js$isDisabled()
})
observeEvent(input$disabled, {
if(input$disabled){
cat("disabled\n")
}else{
cat("enabled\n")
}
})
}
shinyApp(ui = ui, server = server)

Shiny Header (NavBar) with some buttons, not tabs

I want to create a Shiny App with a single tab navbar and the navbar has a logo and some download buttons. I used Shiny NavBar add additional info to create buttons using HTML, but I'd like the onClick function to be the same as the button I included as output$downloadData. Is it possible to mix and match R code and JS to have the button in the navbar be a downloadButton?
library(shiny)
# Define UI for application that draws a histogram
ui <- navbarPage(
# Application title
"Old Faithful Geyser Data",
# Sidebar with a slider input for number of bins
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# I included download buttons here for functionality,
# these are the buttons I'd like in the top right
# Can I use onclick=downloadData or something within my HTML?
mainPanel(
downloadButton("downloadData", "CSV"),
downloadButton("downloadData2", "TXT"),
tableOutput("dist")
),
# Can I add R code to the HTML code so that onclick
# by button uses output$Downloaddata below?
tags$script(HTML("var header = $('.navbar> .container-fluid');
header.append('<div style=\"float:right; valign:middle\"><button onClick=downloadCSV(); style=\"valign:middle;\">Download CSV</button><button>Download SAS</button></div>');
console.log(header)"))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
dummy <- data.frame(x = c(1,2,3), y = c(4,5,6))
output$dist <- renderTable({
dummy
})
output$downloadData <- downloadHandler(
filename = function() {
paste(dummy, ".csv", sep = "")
},
content = function(file) {
write.csv(dummy, file, row.names = FALSE)
}
)
output$downloadData2 <- downloadHandler(
filename = function() {
paste(dummy, ".csv", sep = "")
},
content = function(file) {
write.csv(dummy, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)

R Shiny selectizeInput: set minimum for amount of inputs

I have a selectizeInput with multiple = TRUE in a shiny application and I would like to prevent the user from selecting NULL (i.e., from leaving it blank). My goal is to ensure that at least one item is selected (no matter which one).
I found this question on the opposite problem (i.e., limiting maximum number of selections) and I checked selectize documentation. Unfortunately, there seem to be no minItems option. Is there a way to achieve my desired functionality?
Minimum example:
library(shiny)
shinyApp(
ui = fluidPage(
selectizeInput(
inputId = "testSelect",
label = "Test",
choices = LETTERS[1:4],
selected = LETTERS[1],
multiple = TRUE,
# Problem: how to specify 'minItems' here
options = list(maxItems = 2)
),
verbatimTextOutput("selected")
),
server = function(input, output) {
output$selected <- renderPrint({
input$testSelect
})
}
)
Seems to be an open issue: #https://github.com/selectize/selectize.js/issues/1228.
Concerning your R/Shiny implementation you could use a workaround with renderUI().
You would build the input on the server side and control the selected choices.
Before you build the input on the server side you can check the current value and if it does not fulfill your requirement you can overwrite it:
selected <- input$testSelect
if(is.null(selected)) selected <- choices[1]
Reproducible example:
library(shiny)
choices <- LETTERS[1:4]
shinyApp(
ui = fluidPage(
uiOutput("select"),
verbatimTextOutput("selected")
),
server = function(input, output) {
output$selected <- renderPrint({
input$testSelect
})
output$select <- renderUI({
selected <- input$testSelect
if(is.null(selected)) selected <- choices[1]
selectizeInput(
inputId = "testSelect",
label = "Test",
choices = choices,
selected = selected,
multiple = TRUE,
options = list(maxItems = 2)
)
})
}
)

Using observe function in shiny R

I am trying to send the value of a JavaScript variable from ui.R to Server.R whenever it is changed.
When a user clicks on a link, its href value is alerted . Till here it works fine.
The links are of the form
Sample link
Now, the href value is stored in variable link in ui.R .
I am sending the value of link to server.R using Shiny.onInputChange function.
But the observe function in server.R is not giving me any value. Please tell me how to do this by using observe function or any other way if possible.
ui.r
library(shiny)
shinyUI(fluidPage(
tags$script(HTML("
function clickFunction(link){
alert(link);
Shiny.onInputChange(\"linkClicked\",link);
}
"))
//rest of the code which is not related
)
server.R
library(shiny)
shinyServer(function(input, output) {
observe({
input$linkClicked
print(input$linkClicked)
})
})
I don't really fully understand where the link is coming from and how the app looks since you didn't provide enough code (for example: what does it mean "variable in the UI"?). But here's a small example that shows how the javascript sends info to the server successfully. I'm using the shinyjs package which is a package I wrote.
library(shinyjs)
jscode <- "
shinyjs.clickfunc = function(link) {
alert(link);
Shiny.onInputChange('linkClicked', link);
}"
runApp(shinyApp(
ui = fluidPage(
useShinyjs(),
extendShinyjs(text = jscode),
textInput("link", ""),
actionButton("btn", "submit")
),
server = function(input, output, session) {
observeEvent(input$btn, {
js$clickfunc(input$link)
})
observe({
input$linkClicked
print(input$linkClicked)
})
}
))
EDIT:
If I understand correctly how the links are generated, this works
runApp(shinyApp(
ui = fluidPage(
tags$script(HTML("
function clickFunction(link){
alert(link);
Shiny.onInputChange('linkClicked',link);
}
")),
tags$a(href="www.google.com", onclick="clickFunction('rstudio.org'); return false;", "click me")
),
server = function(input, output, session) {
observe({
input$linkClicked
print(input$linkClicked)
})
}
))

Categories