I am trying to get a custom field on the header so people know when the last time the data was refreshed.
In my test runs, I had it work when just putting a variable in the code but when I use textOutput it is giving me the HTML background logic instead.
<div id="Refresh" class="shiny-text-output"></div>
Below is my code:
library (shiny)
library (shinydashboard)
rm(list=ls())
header <- dashboardHeader(
title = "TEST",
tags$li(class = "dropdown", tags$a(paste("Refreshed on ", textOutput("Refresh")))))
body <- dashboardBody(
fluidRow(box(textOutput("Refresh")))
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$Refresh <- renderText({
toString(as.Date("2017-5-4"))
})
}
shinyApp(ui, server)
This is what I am currently seeing:
EDITED to show corrected code
library (shiny)
library (shinydashboard)
header <- dashboardHeader(
title = "TEST",
tags$li(class = "dropdown", tags$a((htmlOutput("Refresh1")))))
body <- dashboardBody(
fluidRow(box(textOutput("Refresh2")))
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$Refresh1 <- renderUI({
HTML(paste("Refreshed on ", toString(as.Date("2017-5-4"))))
})
output$Refresh2 <- renderText({
toString(as.Date("2017-5-4"))
})
}
shinyApp(ui, server)
You will have to paste the content as HTML inside tags$a, as shown below. You will also have to renderText twice, as the same value cannot be used in the UI.
library (shiny)
library (shinydashboard)
rm(list=ls())
header <- dashboardHeader(
title = "TEST",
tags$li(class = "dropdown", tags$a(HTML(paste("Refreshed on ", textOutput("Refresh1"))))))
body <- dashboardBody(
fluidRow(box(textOutput("Refresh2")))
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$Refresh1 <- renderText({
toString(as.Date("2017-5-4"))
})
output$Refresh2 <- renderText({
toString(as.Date("2017-5-4"))
})
}
shinyApp(ui, server)
Related
I am trying to run the following code, but keep getting this error:
Error in readLines: 'con' is not a connection
The following is my program:
library(shiny)
library(shinyFiles)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
fileInput("file1", "Choose the first HTML File", accept = ".html")
),
mainPanel(
p("File Name"),
verbatimTextOutput("file_name"),
htmlOutput(outputId = 'result')
)
)
)
server <- function(input, output) {
file <- reactive({input$file1})
req(file)
if(is.null( reactive(input$file1$datapath))) return(NULL)
rawHTML <- reactive(paste(readLines(input$file1$datapath), collapse="\n"))
output$file_name <- renderText({
print(rawHTML)
})
output$result <- renderUI({
getPage<-function() {
return(includeHTML( input$file1$datapath))
}
output$inc<-renderUI({getPage()})
})
}
runApp(list(ui = ui, server = server), launch.browser =T)
I want to read the html code from an external file, and save the code as a string. Is there a solution for this?
Is there a way to add a icon next to "Country" and when the user hover on it, it should show some text
library(shiny)
ui <- fluidPage(
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd")
)
server <- function(input, output, session) {
output$Sd <- renderUI({
"Country"
})
}
shinyApp(ui, server)
library(shiny)
library(shinyBS)
ui <- fluidPage(
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd")
)
server <- function(input, output, session) {
output$Sd <- renderUI({
tags$span(
"Country ",
tipify(
icon("bar-chart"),
"Hello, I am the tooltip!"
)
)
})
}
shinyApp(ui, server)
With a bit of HTML and CSS
Then you can use CSS to customize the hovering text
library(shiny)
ui <- fluidPage(
# Add CSS
tags$head(
tags$style(HTML("
#an_icon .text {
position:relative;
bottom:30px;
left:0px;
visibility:hidden;
}
#an_icon:hover .text {
visibility:visible;
}
"))
),
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd"),
# HTML for the icon
tags$div(id = 'an_icon',
icon("bar-chart"),
tags$span(class = "text", tags$p("text")))
)
server <- function(input, output, session) {
output$Sd <- renderUI({
"Country"
})
}
shinyApp(ui, server)
I would like to use a user defined function in Shiny to perform a simple calculation with output two variables. The function I wrote works when it is not part of a shiny app. However when part of a Shiny, the returned object (dfr) is ‘not in scope’. What am I missing?
library(shiny)
# Function ----------------------------------------------------------------
convert <- function(coef_1, coef_2, vec) {
part_1 <- coef_1/(2*sin((vec/2)*pi/180))
part_2 <- 2*(180/pi)*(asin(coef_2/(2*part_1)))
dfr <- data.frame(part_1, part_2)
return(dfr)
}
# End Function ------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("num", h3("Enter number to convert:"), value = NULL)
),
mainPanel(
verbatimTextOutput("text1", placeholder = TRUE),
verbatimTextOutput("text2", placeholder = TRUE)
)
)
)
server <- function(input, output) {
nums_str <- as.character(input$num)
nums_vector <- as.numeric(unlist(strsplit(nums_str, split = ",")))
convert(1.5, 1.1, nums_vector)
output$text1 <- renderText({
req(input$num)
dfr$part_1
})
output$text2 <- renderText({
req(input$num)
dfr$part_2
})
}
shinyApp(ui = ui, server = server)
When you use inputs, you need to do it in reactive environment, such as reactive(), renderDataTable(), etc.
Here, you need to run your function in a reactive() and then call it with dfr() in the outputs.
server <- function(input, output) {
dfr <- reactive({
convert(1.5, 1.1, as.numeric(input$num))
})
output$text1 <- renderText({
req(input$num)
dfr()$part_1
})
output$text2 <- renderText({
req(input$num)
dfr()$part_2
})
}
Since this is quite basic stuff with R Shiny, checking some tutorials might be very useful.
I am trying now since days to get my Shiny App working so that when I move my mouse to certain points in the plot they are displayed in a table but unfortunately it is not working.
I am not sure what I am doing wrong, can you help me?
border <- table$A < 0.03
ui <- fluidPage(
mainPanel(
plotOutput("Plot",click="plot_click"),
tableOutput("HitSpots")
)
)
server <- function(input, output){
output$Plot <- renderPlot({
ggplot(table,aes(x=table$A, y=table$B), colour=border)) +
geom_point()
})
hit <- reactive({
nearPoints(table, input$plot_click)
})
output$HitSpots <- renderTable({
hit()
}
}
shinyApp(ui = ui, server = server)
There are some problems with your parentheses. But the main problem is that you do ggplot(table, aes(x=table$A, y=table$B)), and then nearpoints is looking for columns named table$A and table$B. Do ggplot(table, aes(x=A, y=B)) instead.
library(shiny)
library(ggplot2)
table <- data.frame(
A = c(1,2,3),
B = c(3,2,1)
)
ui <- fluidPage(
mainPanel(
plotOutput("Plot", click="plot_click"),
tableOutput("HitSpots")
)
)
server <- function(input, output){
output$Plot <- renderPlot({
ggplot(table, aes(x=A, y=B)) + geom_point()
})
hit <- reactive({ nearPoints(table, input$plot_click) })
output$HitSpots <- renderTable({
hit()
})
}
shinyApp(ui = ui, server = server)
I am building an application in shiny R where in required tabs can be selected by the users and data relevant to those tabs will be displayed under it.
For example, in below sample application, mtcars data in .csv will be accepted as input parameter.User can select required column names in tabs field.Those colmns will be created as tabs.
Now, I want to show data pertaining to that column from .csv in the appropriate tab.Say, data from the column 'mpg' will be shown under 'mpg' tab.
But i am stuck here.Appreciate someone could tell me a way to display data from relevant column under appropriate tab ,dynamically.
Sample codes used is shown below:
write.csv(mtcars,'mtcars.csv')
#
library(shiny)
library(plyr)
library(dplyr)
ui <- pageWithSidebar(
headerPanel = headerPanel('data'),
sidebarPanel = sidebarPanel(fileInput(
'mtcars', h4('Uplaodmtcardata in csv format')
),
uiOutput('tabnamesui')),
mainPanel(uiOutput("tabsets"))
)
server <- function(input, output, session) {
mtcarsFile <- reactive({input$mtcars})
xxmtcars <-
reactive({
read.table(
file = mtcarsFile()$datapath,
sep = ',',
header = T,
stringsAsFactors = T
)
})
tabsnames <- reactive({
names(xxmtcars())
})
output$tabnamesui <- renderUI({
req(mtcarsFile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
multiple = T
)
})
tabnamesinput <- reactive({
input$tabnamesui
})
output$tabsets <- renderUI({
req(mtcarsFile())
tabs <-
reactive({
lapply(tabnamesinput(), function(x)
tabPanel(title = basename(x), dataTableOutput(x)))
})
do.call(tabsetPanel, c(tabs()))
})
output[['mpg']] <-
renderDataTable(as.data.frame(select(xxmtcars(), mpg)))#HOW TO AVOID THIS HARD CODING..?BASED ON THE TAB NAME DATA FROM RELEVANT COLUMN IN THE CSV TO BE RETURNED.
}
runApp(list(ui = ui, server = server))
#
Try this
library(shiny)
library(plyr)
library(dplyr)
library(rlang)
library(DT)
ui <- pageWithSidebar(
headerPanel = headerPanel('data'),
sidebarPanel = sidebarPanel(fileInput(
'mtcars', h4('Uplaodmtcardata in csv format')
),
uiOutput('tabnamesui')),
mainPanel(uiOutput("tabsets"))
)
server <- function(input, output, session) {
mtcarsFile <- reactive({input$mtcars})
xxmtcars <-
reactive({
read.table(
file = mtcarsFile()$datapath,
sep = ',',
header = T,
stringsAsFactors = FALSE
)
})
tabsnames <- reactive({
names(xxmtcars())
})
output$tabnamesui <- renderUI({
req(mtcarsFile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
multiple = T
)
})
tabnamesinput <- reactive({
input$tabnamesui
})
output$tabsets <- renderUI({
req(mtcarsFile())
tabs <-
reactive({
lapply(tabnamesinput(), function(x)
tabPanel(title = basename(x), dataTableOutput(x)))
})
do.call(tabsetPanel, c(tabs()))
})
observe(
lapply(tabnamesinput(), function(x) {
output[[x]] <- DT::renderDataTable({
t<-as.data.frame(dplyr::select(xxmtcars(), !! sym(x)) )
print(t)
datatable(t)
})
})
)
}
runApp(list(ui = ui, server = server))