embed iframe inside shiny app - r

this is my UI. R
shinyUI(fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6,
selectInput("Member", label=h5("Choose a option"),
choices=c('BCRA1','FITM2'))
))),
mainPanel(fluidRow(
column(3, htmlOutput("frame"))
)
)
)))
This is my server.R
library(shiny)
members <- data.frame(name=c("Name 1", "Name 2"), nr=c('BCRA1','FITM2'))
shinyServer(function(input, output) {
loadframe <- reactive({
validate(
need(input$Member, "Member input is null!!")
)
query <- members[which(members$nr==input$Member),2]
paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
})
output$frame <- renderUI({
tags$iframe(src=loadframe(), height=600, width=535)
})
})
I want to get the iframe from the web page but its printing blank any help on this would be appreciated ?

library(shiny)
members <- data.frame(name=c("Name 1", "Name 2"), nr=c('BCRA1','FITM2'))
ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, selectInput("Member", label=h5("Choose a option"),choices=c('BCRA1','FITM2'))
))),
mainPanel(fluidRow(
htmlOutput("frame")
)
)
))
server <- function(input, output) {
observe({
query <- members[which(members$nr==input$Member),2]
test <<- paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
})
output$frame <- renderUI({
input$Member
my_test <- tags$iframe(src=test, height=600, width=535)
print(my_test)
my_test
})
}
shinyApp(ui, server)

Related

Contents inside Iframe in shiny

i am trying to put contents inside iframe and I am not sure why the below application is not working (Nothing is displayed inside iframe )
library(shiny)
members <- data.frame(name=c("Name 1", "Name 2"), nr=c('BCRA1','FITM2'))
ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, selectInput("Member", label=h5("Choose a option"),choices=c('BCRA1','FITM2'))
))),
mainPanel(fluidRow(
htmlOutput("frame")
)
)
))
server <- function(input, output) {
observe({
query <- members[which(members$nr==input$Member),2]
test <<- paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
})
output$frame <- renderUI({
input$Member
my_test <- tags$iframe(src=test, height=600, width=535)
print(my_test)
my_test
})
}
shinyApp(ui, server)
Can anyone help me here?

Embedding a webpage with d3 into shiny [duplicate]

this is my UI. R
shinyUI(fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6,
selectInput("Member", label=h5("Choose a option"),
choices=c('BCRA1','FITM2'))
))),
mainPanel(fluidRow(
column(3, htmlOutput("frame"))
)
)
)))
This is my server.R
library(shiny)
members <- data.frame(name=c("Name 1", "Name 2"), nr=c('BCRA1','FITM2'))
shinyServer(function(input, output) {
loadframe <- reactive({
validate(
need(input$Member, "Member input is null!!")
)
query <- members[which(members$nr==input$Member),2]
paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
})
output$frame <- renderUI({
tags$iframe(src=loadframe(), height=600, width=535)
})
})
I want to get the iframe from the web page but its printing blank any help on this would be appreciated ?
library(shiny)
members <- data.frame(name=c("Name 1", "Name 2"), nr=c('BCRA1','FITM2'))
ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(6, selectInput("Member", label=h5("Choose a option"),choices=c('BCRA1','FITM2'))
))),
mainPanel(fluidRow(
htmlOutput("frame")
)
)
))
server <- function(input, output) {
observe({
query <- members[which(members$nr==input$Member),2]
test <<- paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
})
output$frame <- renderUI({
input$Member
my_test <- tags$iframe(src=test, height=600, width=535)
print(my_test)
my_test
})
}
shinyApp(ui, server)

R Shiny two rows by two columns

I would like to place four plots in a two rows by two columns layout. The code below returns two rows by one column. How can the second column be added?
Any help is appreciated.
ui <- shinyUI(
fluidRow(
column(6,
plotOutput(outputId = "hist1")
),
column(6,
plotOutput(outputId = "hist2")
)
)
)
server <- function(input,output){
output$hist1 <- renderPlot({
hist(rnorm(100,50,5))
})
output$hist2 <- renderPlot({
hist(rnorm(100,75,5))
})
output$hist3 <- renderPlot({
hist(rnorm(100,100,5))
})
output$hist4 <- renderPlot({
hist(rnorm(100,125,5))
})
}
runApp(list(ui = ui, server = server))
Answer from brittenb in comments : fluidPage() needs to be added.
ui <- shinyUI(
fluidPage(
fluidRow(
column(6,
plotOutput(outputId = "hist1")
),
column(6,
plotOutput(outputId = "hist2")
)
),
fluidRow(
column(6,
plotOutput(outputId = "hist3")
),
column(6,
plotOutput(outputId = "hist4")
)
)
)
)
server <- function(input,output){
output$hist1 <- renderPlot({
hist(rnorm(100,50,5))
})
output$hist2 <- renderPlot({
hist(rnorm(100,75,5))
})
output$hist3 <- renderPlot({
hist(rnorm(100,100,5))
})
output$hist4 <- renderPlot({
hist(rnorm(100,125,5))
})
}
runApp(list(ui = ui, server = server))

Use dynamic radioButtons in Shiny

In a Shiny app I create radioButtons dynamically on the server and use renderUI to pass this to the client. Now I have a problem of getting the response of the radioButtons (selected item) back for further processing. Below the stripped down version of my problem.
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
print(paste("Radiobutton response is:", "reply()")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", "reply()" )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)
Do you want something like the following?
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
#print(paste("Radiobutton response is:", "reply")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", input$reply )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)

Modify shiny action button once it is clicked

I have the following in server.R
shinyServer(function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
ntext()
})
})
and the following in ui.R
shinyUI(pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
))
My goal is to make the go action button disappear once it is clicked five times and give a pop up window warning if clicked less than five times.
As #daattali is saying, shinyjs make this really easy, you can do it like this:
library(shiny)
library(shinyjs)
ui <- shinyUI(
fluidPage(
useShinyjs(),
sidebarPanel(
actionButton('btn','Click me')
),
mainPanel(
verbatimTextOutput("nText")
)
)
)
server <- shinyServer(function(input,output,session){
n <- 0
makeReactiveBinding('n')
observeEvent(input$btn, {
if(n < 5){
info('Msg')
} else if(n > 5){
hide('btn')
}
n <<- n + 1
})
output$nText <- renderText({
n
})
})
shinyApp(ui=ui,server=server)
Here's how you would hide the button without using shinyjs:
library(shiny)
ui <- shinyUI(
fluidPage(
tags$head(
tags$style(
HTML('#num{display: none;}')
)
),
useShinyjs(),
sidebarPanel(
conditionalPanel(
condition = "input.num < 5",
actionButton('btn','Click me')
),
numericInput('num','',0)
),
mainPanel(
verbatimTextOutput("nText")
)
)
)
server <- shinyServer(function(input,output,session){
n <- 0
makeReactiveBinding('n')
observeEvent(input$btn, {
n <<- n + 1
updateNumericInput(session,'num',value=n)
})
output$nText <- renderText({
n
})
})
shinyApp(ui=ui,server=server)
And finally without using observeEvent:
library(shiny)
ui <- shinyUI(
fluidPage(
tags$head(
tags$style(
HTML('#num{display: none;}')
)
),
useShinyjs(),
sidebarPanel(
conditionalPanel(
condition = "input.num < 5",
actionButton('btn','Click me')
),
numericInput('num','',0)
),
mainPanel(
verbatimTextOutput("nText")
)
)
)
server <- shinyServer(function(input,output,session){
n <- 0
makeReactiveBinding('n')
observe({
input$btn
isolate({
n <<- n + 1
updateNumericInput(session,'num',value=n)
})
})
output$nText <- renderText({
n
})
})
shinyApp(ui=ui,server=server)
You don't need to define a reactive n. It is already the value of input$btn.
library(shiny)
library(shinyjs)
ui <- shinyUI(
fluidPage(
useShinyjs(),
sidebarPanel(
actionButton('btn','Click me')
),
mainPanel(
verbatimTextOutput("nText")
)
)
)
server <- shinyServer(function(input,output,session){
observe({
if(input$btn < 5){
info('Msg')
} else {
hide('btn')
}
})
output$nText <- renderText({
input$btn
})
})
shinyApp(ui=ui,server=server)

Resources