I've tried the method of showing lists in a shiny app in the following link:
How to print lists of lists of uneven length in Shiny and nothing is displayed so far.
ui <- fluidPage(
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res<-renderPrint({
x=list(nam=('d','h','k','m'),num=(3,2,8,9))
a=tapply(x[,1],x[,2],summary)
})}
shinyApp(ui = ui, server = server)
Related
I installed and followed the guide from the git, but I hit a wall once I try to execute a send_message() call using the shell.
I rewrote the asgi.py:
application = ProtocolTypeRouter({
"http": URLRouter([
path("msgs/", AuthMiddlewareStack(URLRouter(django_eventstream.routing.urlpatterns)), { "format-channels": ["test"] }),
re_path(r"", get_asgi_application()),
]),
})
and I created the entries in urls.py:
urlpatterns = [path("msgs/", include(django_eventstream.urls), {'format-channels': ["test"]})]
I also added the static ressources to my static directory and I can access them on any page that includes my base.html. But when I open the local msgs channel at 127.0.0.1\msgs\ I only see:
When opening a shell in a second terminal and using send_event("test", "message", {"text": "hello"}) I see no indication whatsoever that anything is sent out to the frontend. Also the JS sample code from the repo fetches nothing on the main page when sending out data in a loop with starting django (using the fantastic scheduler huey here):
#periodic_task(crontab(minute = "*/1"))
def test():
send_event('test', 'message', {'text': 'hello world'})
print("hello world...")
I see the output of print() but not the result of send_message() on the frontend. Also, there is no implication that my scheduled or manually run send_message() actions result in anything on the \msgs\ channel - the timing does not fit, it looks more like this is just regularly printing keep-alive with no data in it.
The JS console output on the frontend:
var es = new ReconnectingEventSource('/msgs/');
es.addEventListener('message', function (e) {console.log(e.data);}, false);
es.addEventListener('stream-reset', function (e) {}, false);
output for es:
s {CONNECTING: 0, OPEN: 1, CLOSED: 2, _configuration: undefined, withCredentials: false, …}
I have a number of individuals who log into a shiny-server application where they all interact. After the app stops, I load another application, they each click ``reload'', and they all interact on the new application.
If someone clicks ``reload'' early, then everyone needs to re sign in. Is there any way to avoid this. I'd like to just regenerate shiny's default reload-page.
I'm not sure how your reaload works as you havent posted any code, however you can force F5 page refresh like so. parts of the code example are taken from here`
library(shiny)
library(shinyjs)
jscode <- "shinyjs.reload = function() { window.location.reload(true); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jscode),
textInput("text", "Text"),
actionButton("reload", "Refresh app")
)
server <- function(input, output, session) {
observeEvent(input$reload, {
js$reload();
})
}
shinyApp(ui = ui, server = server)
It is my understanding that the open source version of Shiny Server does not support authentication.
We have an environment that uses the WebSEAL proxy service for authenticating user and channelling their access through to web applications.
We wish to expose a Shinyapp to authenticated users with the content served up being dependent on user group membership. WebSEAL is able to set the iv_user and iv_group variables in the HTTP Headers to pass onto the shinyapp via the junction, but the Open Source Shiny Server seems to be unable to access them (I.E. via the session$clientData object).
I’m wondering if anyone has worked out a way for an Open Source Shiny Server app to access the HTTP Headers to determine the user and groups.
If you just want to access HTTP headers, the UI can be a function that accepts a single argument for a request object that implements the Rook specification.
library(shiny)
ui <- function(request) {
print(as.list(request))
# get HTTP headers like request$HTTP_HEADER_NAME (all caps)
fluidPage(
tags$pre(
paste(capture.output(as.list(request)), collapse = "\n")
)
)
}
server <- function(input, output) {
}
shinyApp(ui, server)
One way to serve different pages depending on an HTTP header could be like this -
unauthorizedPage <- function() {
"Unauthorized"
}
memberPage <- function() {
fluidPage(
"Member page"
)
}
ui <- function(request) {
# serve memberPage() if request contains header `iv_group: member`
# otherwise serve unauthorizedPage()
if (!identical(request$HTTP_IV_GROUP, "member"))
return(unauthorizedPage())
memberPage()
}
server <- function(input, output) {
}
shinyApp(ui, server)
When clicking on action button, I can see the google sheet downloading and date printed in console but the filetime in renderPrint is not updating?
library(httr)
set_config( config( ssl_verifypeer = 0L ) )
library(googlesheets)
suppressMessages(library(dplyr))
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
#One action button to download data from google spreadsheet
actionButton("refreshbutton", label = "Refresh"),
#two textoutput to show date of downloaded file
textOutput("refreshdate")
)
)
)
)
server <- function(input, output) {
observeEvent(input$refreshbutton, {
#On click download data from google spreadsheet
pulldata <- gs_key("19bPhlp7MjDZFNJcDUmHGJDxkh2h2U5j05S0c18HfBgE") %>%
gs_read_csv(ws="vs working", col_names=TRUE)
#Write data in csv
write.csv(pulldata, file = "attrition.csv")
data <- read.csv(file="attrition.csv", header = TRUE)
#capture modified time from csv
filetime <- file.mtime("attrition.csv")
print(filetime)
#inform on completion after refresh
})
#print filetime in refreshdate1
output$refreshdate <- renderPrint({
filetime # <- This is not updating???
})
}
shinyApp(ui, server)
Along with the above code, when Google spreadsheet is downloading, I assume the site should go to grey mode indicating refresh - this also is not happening? I mean it should show somehow that new data is in process till complete?
The reason why it is not working is because the scope of the filetime variable is within the observeEvent. You cannot assign a variable outside its scope using observeEvent, instead use eventReactive.
Just checked it, gs_key is throwing an error for me even in R console, otherwise this is the solution you were looking for regarding reactivity.
server <- function(input, output) {
observeEvent(input$refreshbutton, {
#On click download data from google spreadsheet
pulldata <- gs_key("19bPhlp7MjDZFNJcDUmHGJDxkh2h2U5j05S0c18HfBgE") %>%
gs_read_csv(ws="vs working", col_names=TRUE)
#Write data in csv
write.csv(pulldata, file = "attrition.csv")
#read.csv(file="attrition.csv", header = TRUE)
})
filetime <- eventReactive(input$refreshbutton, {
file.mtime("attrition.csv")
})
#print filetime in refreshdate1
output$refreshdate <- renderPrint({
filetime()
})
}
Error message:
Expected content-type:
application/atom+xml; charset=UTF-8
Actual content-type:
text/html; charset=UTF-8
I am using the below query in sever.R and it works fine when run locally. However, when the app is deployed over shinyapps.io or on a web hosting server, I get the following error
Error: Requires an interactive environment
Code deployed over shinyapp:
updateStatus <- function(text, token, link=NULL) {
## text prepocessing
text <- enc2utf8(text)
text <- gsub(" ", "+",text)
## query including text
query <- paste('https://graph.facebook.com/me/feed?message=', text, sep="")
## adding URL
if (!is.null(link)){
query <- paste(query, "&link=", link, sep="")
}
## making query
if (class(token)[1]=="config"){
url.data <- POST(query, config=token)
}
if (class(token)[1]=="Token2.0"){
url.data <- POST(query, config(token=token))
}
if (class(token)[1]=="character"){
url <- paste0(query, "&access_token=", token)
url.data <- POST(url)
}
if (class(token)[1]!="character" & class(token)[1]!="config" & class(token)[1]!="Token2.0") {
stop("Error in access token. See help for details.")
}
## output
if (url.data$status_code==200){
id <- fromJSON(rawToChar(url.data$content))$id
if (is.null(id)){
message("Failed update. OAuth token does not have permission to update status. ",
"See ?fbOAuth for more details.")
}
message("Success! Link to status update: ", paste("http://www.facebook.com/", id, sep=""))
}
if (url.data$status_code==400){
error <- fromJSON(rawToChar(url.data$content))$error$code
message <- fromJSON(rawToChar(url.data$content))$error$message
if (error==2500){
message("Failed update. OAuth token does not have permission to update status. ",
"See ?fbOAuth for more details.")
}
if (error!=2500){
message("Failed update.", message)
}
}
}
observeEvent(input$FBButton,{
Sys.setenv("HTTR_SERVER_PORT" = "1410/")
updateStatus(paste("Analysis by using www.abc.com",sep=""),
token=oauth2.0_token(oauth_endpoints('facebook'),
oauth_app('facebook', 'app', 'key'),
scope = 'ads_management',
type = 'application/x-www-form-urlencoded',
cache = FALSE)$credentials$access_token,
link = "www.rstudio.com")
})