I need to have the outputText (Key_facts) as a hyperlink, whenever I extract it from csv file could you please help me to figure out how to solve this issue
library(shiny)
info_360 <- read.csv('data/360_photos.csv')
ui <-
fluidRow(
box(
title = "Key Facts",
closable = FALSE,
width = 9,
status = "primary",
solidHeader = FALSE,
collapsible = TRUE,
textOutput("keyfacts"))
server <- function(input, output,session) {
Keyfactstext <- reactive({
if (input$mySliderText %in% info_360$press )
{
info_360 %>%
filter(press == input$mySliderText)%>%
pull(Key_facts)
**#this contains a text that includes a website link, I need only the link to appear as a hyperlink?????????????????**
}
})
output$keyfacts<- renderText({ Keyfactstext ()})
}
shinyApp(ui = ui, server = server)
This might work but I can't test without your file
library(shiny)
info_360 <- read.csv('data/360_photos.csv')
ui <-
fluidRow(
box(
title = "Key Facts",
closable = FALSE,
width = 9,
status = "primary",
solidHeader = FALSE,
collapsible = TRUE,
uiOutput("keyfacts"))
server <- function(input, output,session) {
Keyfactstext <- reactive({
if (input$mySliderText %in% info_360$press )
{
info_360 %>%
filter(press == input$mySliderText)%>%
pull(Key_facts)
**#this contains a text that includes a website link, I need only the link to appear as a hyperlink?????????????????**
}
})
output$keyfacts<- renderUI({
tagList$a(href = Keyfactstext(), "Click me")})
}
shinyApp(ui = ui, server = server)
Related
I create an R shiny app that allow to enter text to implemente a clickable table. Now I would like to retrieve the value of selected cell. For now I only get the row and column number but the value of the cell appear empty. Thanks a lot for your help.
Here is my code:
library(shiny)
library(dplyr)
library(DT)
ui <- fluidPage(
textInput("caption", "Saisir votre addresse", ""),
theme = bs_theme(version = 4, bootswatch = "minty"),
mainPanel(
width = 8,
dataTableOutput('my_table')
),
mainPanel( textOutput("selected_text") )
)
server <- function(input, output) {
output$my_table = DT::renderDataTable(as.data.frame(input$caption),selection = list(mode = "single", target = "cell"),options = list(paging = FALSE,searching = FALSE))
observeEvent(input$my_table_cells_selected, {
info <- input$my_table_cells_selected
output$selected_text <- renderText({
paste(info) # info[3] for value
})
}) #Observe event
} # server
shinyApp(ui, server)
EDIT : This new code is working
library(shiny)
library(dplyr)
library(DT)
ui <- fluidPage(
textInput("caption", "Saisir votre addresse", ""),
theme = bs_theme(version = 4, bootswatch = "minty"),
mainPanel(
width = 8,
dataTableOutput('my_table')
),
mainPanel( textOutput("selected_text") )
)
server <- function(input, output) {
output$my_table = DT::renderDataTable(as.data.frame(input$caption),selection = list(mode = "single", target = "cell"),options = list(paging = FALSE,searching = FALSE))
observeEvent(input$my_table_cells_selected, {
info <- input$my_table_cells_selected
output$selected_text <- renderText({
as.data.frame(as.data.frame(input$caption))[info]
})
}) #Observe event
} # server
shinyApp(ui, server)
I'd like to use shinyWidgets::materialSwitch instead of a checkbox in my app for an improved UI.
However, I can't seem to get materialSwitch to work when used with renderUI/uiOutput. The input displays properly but doesn't seem to register a click to "switch".
For the purposes of my app - I need this to be inside a renderUI.
Pkg Versions:
shinyWidgets_0.7.2
shiny_1.7.2
library(shiny)
library(shinyWidgets)
# library(shinyjs)
ui <- fluidPage(
div(class="row",
column(width = 3,
uiOutput("switch")
)
)
)
server <- function(input, output, session) {
output$switch = renderUI({
materialSwitch(
inputId = "switch",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE
)
})
}
shinyApp(ui = ui, server = server)
Why is this happening, and how can the problem be fixed?
The issue is that you give same name "switch" to both uiOutput.outputId and materiaSwitch.inputId.
It works OK when they get different ids:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
div(class="row",
column(width = 3,
uiOutput("switch"),
textOutput("result")
)
)
)
server <- function(input, output, session) {
output$switch = renderUI({
materialSwitch(
inputId = "switchButton",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE
)
})
output$result = renderText(input$switchButton)
}
shinyApp(ui = ui, server = server)
Here is how it should work:
library(shiny)
library(shinyWidgets)
# library(shinyjs)
ui <- fluidPage(
div(style = 'position: absolute;left: 50px; top:100px; width:950px;margin:auto',
materialSwitch(inputId = "switch",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE)
)
)
server <- function(input, output, session) {
output$value1 <- renderText({ input$switch })
}
shinyApp(ui = ui, server = server)
I am trying to upload images to my shiny app, but seem to be stuck on a basic step. The images are in my www directory. I am able to implement a drop down option, and would like the user to select an image (e.g, mouse.png) which would upload said image. However, the image itself is not uploading.
This is my code, does anyone have any ideas?
library(shiny)
#create a box function
my.box <- function(title, obj) {
box(
title = title,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput(obj, height = "300px")
)
}
# List of choices for selectInput
mylist <- list.files("~/APP/www/")
body <- dashboardBody(tableOutput("filtered_table"),
my.box("Table1", "Table1"))
#create dropbox
ui <- fluidPage(
#drop down box
selectInput(inputId ="gene",label = h3("Select an image from below"),choices = mylist),
#name of the plot.
mainPanel(plotOutput("image")) #NOT SURE WHAT TO PLACE HERE
)
#server function
server = shinyServer(function(input, output,session){
observeEvent(input$myFile, {
inFile <- input$myFile
if (is.null(inFile))
return()
file.copy(inFile$datapath, file.path("~/APP/www/", inFile$name) )
})
})
Following the example from the shiny tutorial, you can use renderImage/imageOutput. Note that I've adjusted the file paths a bit.
library(shiny)
library(shinydashboard)
#create a box function
my.box <- function(title, obj) {
box(
title = title,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput(obj, height = "300px")
)
}
# List of choices for selectInput
mylist <- list.files("./www")
body <- dashboardBody(tableOutput("filtered_table"),
my.box("Table1", "Table1"))
#create dropbox
ui <- fluidPage(
#drop down box
selectInput(inputId ="gene",label = h3("Select an image from below"),choices = mylist),
#name of the plot.
mainPanel(imageOutput("image"))
)
#server function
server = shinyServer(function(input, output,session){
output$image <- renderImage({
filename <- normalizePath(file.path('www',
input$gene))
list(src = filename)
}, deleteFile = FALSE)
})
shinyApp(ui, server)
I am making a shiny app that interacts with a big data.frame that I have stored as an RData file. I want the user to select the file, and once the RData is completely loaded (takes ~15 seconds) a second panel should show up allowing the user to input some sample name and do some operations.
Here is how my app looks now
header <- dashboardHeader(title="Analysis and database")
sidebar <- dashboardSidebar(
useShinyjs(),
sidebarUserPanel(),
hr(),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "sidebarmenu",
menuItem("Analyse old data by Sample", tabName="oldfile", icon = icon("table"), startExpanded = FALSE),
fileInput(inputId = "file1", "Choose database file"),
conditionalPanel(
#condition = "input.sidebarmenu === 'oldfile'",
condition = "output.fileUploaded == 'true' ",
textInput(inputId = "sample", label ="Type a sample ID"),
actionButton("go2", "Filter")
)
)
)
body <- dashboardBody(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"),
tabItems(
tabItem("oldfile", "Sample name data.table",
fluidRow(DT::dataTableOutput('tabla_oldfile') %>% withSpinner(color="#0dc5c1")))
)
)
ui <- dashboardPage(header, sidebar, body)
### SERVER SIDE
server = function(input, output, session) {
options(shiny.maxRequestSize=100000*1024^2)
prop <- reactive({
if (input$go2 <= 0){
return(NULL)
}
result <- isolate({
if (is.null(input$file1))
return(NULL)
if (is.null(input$sample))
return(NULL)
inFile <- input$file1
print(inFile$datapath)
#big_df <- load(inFile$datapath)
print (big_df)
print(input$sample)
oldtable <- big_df1 %>% filter_at(vars(GATK_Illumina.samples:TVC_Ion.samples),
any_vars(stringi::stri_detect_fixed(., as.character(input$sample))))
oldtable
})
result
})
output$fileUploaded <- reactive({
return(!is.null(prop()))
})
outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
output$tabla_oldfile <- DT::renderDataTable({
DT::datatable(prop(),
filter = 'top',
extensions = 'Buttons',
options = list(
dom = 'Blftip',
buttons =
list('colvis', list(
extend = 'collection',
buttons = list(list(extend='csv',
filename = 'results'),
list(extend='excel',
filename = 'results'),
list(extend='pdf',
filename= 'results')),
text = 'Download'
)),
scrollX = TRUE,
pageLength = 5,
lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
), rownames = FALSE
)
})
}
shinyApp(ui, server)
I have used the solution provide in Make conditionalPanel depend on files uploaded with fileInput but I can't make it work, there is another implementation using shinyjs package but don't know how to use it on my example
I am a newbie to shiny dashboard. I want to know how to print str() of the table which i have imported in shiny dashboard. my code is not working. When i print str(), i get the below output,
str()
Please check the code which i have written,
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Analytics Workbench 2.0", titleWidth = 250,
dropdownMenuOutput("msgs")),
dashboardSidebar(
sidebarMenu(
fileInput("Table1", "Train Data"),
fileInput("Table2", "Test Data"),
menuItem("Variable Analysis", icon = icon("edit"),
menuSubItem("Uni-Variate Analysis"),
menuSubItem("Multi-Variate Analysis"))
)
),
dashboardBody(
fluidRow(
column(12, box(title = "Train Data", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, DT::DTOutput("Train")),
box(title = "Test Data", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, DT::DTOutput("Test")))),
fluidRow(
column(12, box(title = "Structure", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, verbatimTextOutput("str1")),
box(title = "Structure", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, verbatimTextOutput("str2"))))
)
)
server <- function(input, output) {
output$msgs <- renderMenu({
msg <- apply(read.csv("messages.csv"), 1, function(row){
messageItem(from = row[["from"]], message = row[["message"]]) })
dropdownMenu(type = "messages", .list = msg)
})
output$Train <- DT::renderDT({
if (is.null(input$Table1)) return(NULL)
data1 <- read.table(input$Table1$datapath, fill = TRUE, header=T, sep=",")
DT::datatable(data1, options = list(scrollX = TRUE))
})
output$Test <- DT::renderDT({
if (is.null(input$Table2)) return(NULL)
data2 <- read.table(input$Table2$datapath, fill = TRUE, header=T, sep=",")
DT::datatable(data2, options = list(scrollX = TRUE))
})
output$str1 <- renderText({
paste(capture.output(str(input$Table1)), collapse = "\n")
})
output$str2 <- renderText({
paste(capture.output(str(input$Table1)), collapse = "\n")
})
}
I am not able to find out the input to be given for str()
Thanks
Balaji
Switch out your textOutput for verbatimTextOutput. Also, you require a reactive to treat the fileInput... specifically take note that you should trap the case when the input value is NULL.
app.R
library(shiny)
write.csv(mtcars, "mtcars.csv") # file created to test file input
ui <- fluidPage(
mainPanel(
verbatimTextOutput("strfile"),
fileInput("file1", "File")
)
)
server <- function(input, output) {
df <- reactive({
if (is.null(input$file1)) {
return(NULL)
} else {
read.csv(input$file1$datapath, row.names = 1) # note the row.names are dependent on your input requirements
}
})
output$strfile <- renderPrint({str(df())})
}
shinyApp(ui = ui, server = server)
To get this output...