I use the googleAuthR package in shiny, I want to alert users if they are not log in and I also want to save user's google id if they have successfully logged in. But sign_ins() is reactive consumer that I cannot do this. Any suggestions?
library(shiny)
library(googleAuthR)
library(shinyWidgets)
options(googleAuthR.webapp.client_id = "**********************")
ui <- fluidPage(
titlePanel("Sample Google Sign-In"),
sidebarLayout(
sidebarPanel(
googleSignInUI("demo")
),
mainPanel(
with(tags, dl(dt("Name"), dd(textOutput("g_name")),
dt("Email"), dd(textOutput("g_email")),
dt("Image"), dd(uiOutput("g_image")) ))
)
)
)
server <- function(input, output, session) {
sign_ins <- shiny::callModule(googleSignIn, "demo")
output$g_name = renderText({ sign_ins()$name })
output$g_email = renderText({ sign_ins()$email })
output$g_image = renderUI({ img(src=sign_ins()$image) })
if(is.null(sign_ins())){
shinyWidgets::show_alert(title = "not log in",
type = NULL,
btn_labels = "Ok")
else{
write.csv(sign_ins(),"file.csv")
}
}
}
# Run the application
shinyApp(ui = ui, server = server)
I'm not familiar with googleAuthR but every google-api product in R is most likely has "*_has_token" feature to validate if there is an active credential logged in the session. I've checked the googleAuthR package and i think you can use googleAuthR::gar_has_token(). So instead of
if(is.null(sign_ins())) {...}
you can use
if(googleAuthR::gar_has_token() == FALSE){...}
to check if there is an active credentials and do your things.
Hope this helpful
Related
I would like to add a warning message, in my shiny dashboard sidebar, if user enters something that is not recognized. I found something very informative: Check Shiny inputs and generate warning on sidebar layout
But it is not exactly what I need, and would like to hear what you think. Below is my code
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput('email', 'Email', c("NYC#gmail.com", "LA#gmail.com","SF#gmail.com"), multiple = FALSE,
options = list(
placeholder = 'Email addresss',
onInitialize = I('function() { this.setValue(""); }')
)),
uiOutput('email_text')
),
dashboardBody()
)
server <- function(input, output) {
output$email_text <-
renderUI({
if(input$email == ""){
return(p("Please add your gmail e-mail address."))
}
#Update: Below checks for "gmail" - I would something to search list and return.
if(!grepl("gmail", input$email)){
return(p("Your email is not a gmail e-mail address!"))
}
})
}
shinyApp(ui = ui, server = server)
Current sidebar selection performs well to recognize email format, as long as I select from the dropdown list
However, what I also want to add in is, if I enter something that is not expected (not in the list given), the system can capture that and warn me (E.g. "Your email is not an expected email address!"). Currently, if I just enter some something not in the list, the system does not do anything:
I feel that comparing with post I mentioned above, my version has issue with "selectizeInput" function. It is designed to intake elements from the list, not everything user enters. Is there a way to work around it? I try to use validate() but had no luck.
Thanks so much in advance for your help!
By default selecticizeInput does not allow the user to enter new values. You have to enable this with options = list(create = TRUE). Once you have this option, you can check whether the newly created email is in the pre-defined list of emails using %in% and report a custom error message in the sidebar.
Here is the updated code:
library(shiny)
library(shinydashboard)
list_of_emails <- c("NYC#gmail.com", "LA#gmail.com", "SF#gmail.com")
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(
selectizeInput(
'email',
'Email',
c("NYC#gmail.com", "LA#gmail.com", "SF#gmail.com"),
multiple = FALSE,
options = list(
create=TRUE,
placeholder = 'Email addresss',
onInitialize = I('function() { this.setValue(""); }')
)
),
uiOutput('email_text')
),
dashboardBody())
server <- function(input, output) {
output$email_text <-
renderUI({
# print the input email to the console to help with debugging
message(input$email)
if (input$email == "") {
return(p("Please add your gmail e-mail address."))
}
#Update: Below checks for "gmail" - I would something to search list and return.
if (!input$email %in% list_of_emails) {
return(p("Your email is not in the list of emails!"))
}
})
}
runApp(list(ui = ui, server = server))
I have this app:
library(shiny)
ui <- fluidPage(
textInput("query_text","Type something:"),
actionButton(inputId='query_button',
label="Search",
icon = icon("th"),
onclick = paste("location.href='http://www.example.com?lookfor=",
input$query_text, "'", sep=""))
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I'd like to update the url with the action button, so when the user types something (for example: paper), it updates the url like this:
http://www.example.com/?lookfor=paper
Any ideias how to do it? Maybe wrapping it on a observeEvent?
Based on your replies to my comment, what you're looking for is the updateQueryString function.
library(shiny)
ui <- fluidPage(
textInput("query_text", "Type something:"),
actionButton(inputId = 'query_button', label = "Search")
)
server <- function(input, output, session) {
observeEvent(input$query_button, {
updateQueryString(paste0("?lookfor=", input$query_text))
})
}
shinyApp(ui, server)
Hi I am trying to build a login page that contacts an API service and validates user credentials. If the credentials are correct then a new user interface appears and simply makes a plot. If it is not correct a message at the login screen should say "incorrect login". Currently, when I try to type in either of the fields at the login page (ui1.r) the field refreshes/wipes itself after a second or so, thus preventing me from passing on user input to the API. I have the following files
server.r:
rm(list = ls())
library(shiny)
library(dplyr)
library(shinyjs)
umls <- dbConnect(drv=RSQLite::SQLite(),
dbname="/media/sf_umls-2018AA-full/2018AA-full/2018AA/META/umls_browser.sqlite3")
licenseCode <- "mylicense"
shinyServer(function(input, output) {
source('ui1.R') #login page
output$page <- renderUI({ ui1 })
observe({
z<-system(paste("perl", "/media/sf_umls-2018AA-full/2018AA-full/2018AA/META/umls_auth.pl",
input$user, input$password),intern=TRUE)
if (grepl("false",z[22])) {
renderText("incorrect login")
}
if (grepl("true",z[22]))
{
output$page <- renderUI({ ui2 })
output$table <- renderTable({mtcars()})
}
})
})
ui1.r
ui1 <- shinyUI(fluidPage(
# Application title
titlePanel("UMLS Constraint Browser"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("user", "User",""),
textInput("password", "Password",""),
actionButton("login", "Login")
),
mainPanel(
tableOutput("table")
)
)
))
What appears to be the problem?
I think the problem comes from the observe function. Each time you write a letter, it sends a request to your credential database. You should try to use
ObserveEvent instead :
shinyServer(function(input, output) {
observeEvent(input$login, {
z<-system(paste("perl", "/media/sf_umls-2018AA-full/2018AA-full/2018AA/META/umls_auth.pl",
input$user, input$password),intern=TRUE)
if (grepl("false",z[22])) {
renderText("incorrect login")
}
if (grepl("true",z[22]))
{
output$page <- renderUI({ ui2 })
output$table <- renderTable({mtcars()})
} })
})
Here, a request is made only when the user clicks on the login button. Tell me if it works for you.
I'm trying to use the relatively new shinyAlert package to see if it offers better results than the sweetalert package but I'm unable to figure out how to get this:
Myvar <- shinyalert input text
from this minimal example.
library(shiny)
library(shinyjs)
library(shinyalert)
ui <- fluidPage(
shinyjs::useShinyjs(),
useShinyalert(),
actionButton("run", "Run", class = "btn-success")
)
server <- function(input, output, session) {
shinyEnv <- environment()
observeEvent(input$run, {
shinyalert('hello', type='input')
})
}
shinyApp(ui = ui, server = server)
My thanks for any help from you geniouses out there.
Here is how you do it:
library(shiny)
library(shinyalert)
ui <- fluidPage(
useShinyalert(),
actionButton("run", "Run", class = "btn-success")
)
server <- function(input, output, session) {
observeEvent(input$run, {
shinyalert('hello', type='input', callbackR = mycallback)
})
mycallback <- function(value) {
cat(value)
}
}
shinyApp(ui = ui, server = server)
It's done using callbacks. You can assign the value to a reactive variable if you'd like.
I had fully documented the package last month and was about to release it, and then my computer crashed before I had a chance to push to github, and lost all progress. I haven't had a chance to work on it again. So sorry that the documentation isn't great yet, the package is still un-released so use at your own risk for now :)
(Notice that you don't need shinyjs for this)
I have no experience with the package shinyalert, but you can achieve what you want with the widely used and well documented modal dialogs from shiny. Maybe you there is a reason for you to stick with shinyalert that I am unaware off, but if not, example code for achieving what you want with modal dialogs:
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("run", "Run", class = "btn-success"),
textOutput("output1")
)
server <- function(input, output, session) {
dataModal <- function(failed = FALSE) {
modalDialog(
textInput("input1", "Enter text:",
placeholder = 'Enter text here'
)
)
}
# Show modal when button is clicked.
observeEvent(input$run, {
showModal(dataModal())
})
output$output1 <- renderText({
input$input1
})
}
shinyApp(ui = ui, server = server)
Let me know if this helps!
I need to deal with a huge file (>500mb) in R. So instead of loading such heavy file in R environment, I process the file in chunks of specific number of rows and finally get the aggregate values.
I need user to specify the file (using some kind of browse functionality) so that I can feed the file path to my algorithm
fileConnection <-file( "../output/name.txt", open="w")
Is there any way to get only file path from Shiny UI based on the address specified by user? I tried ShinyFiles package, but it gives only directory to choose, not file.
This functionality is available in the shinyFiles package. Have a look at this minimal example:
library(shiny)
library(shinyFiles)
ui <- fluidPage(
shinyFilesButton("Btn_GetFile", "Choose a file" ,
title = "Please select a file:", multiple = FALSE,
buttonType = "default", class = NULL),
textOutput("txt_file")
)
server <- function(input,output,session){
volumes = getVolumes()
observe({
shinyFileChoose(input, "Btn_GetFile", roots = volumes, session = session)
if(!is.null(input$Btn_GetFile)){
# browser()
file_selected<-parseFilePaths(volumes, input$Btn_GetFile)
output$txt_file <- renderText(as.character(file_selected$datapath))
}
})
}
shinyApp(ui = ui, server = server)
EDIT: This approach worked when running on RStudio desktop on Windows. But it fails on RStudio Server on Unix, as the file.choose dialog appears in the RStudio window instead of in the app.
Rather than uploading the file, we can instead just send a text string that is the file path to the app.
Consider the following minimal example:
library(shiny)
ui <- fluidPage(
actionButton("get", "Send file path"),
textOutput("txt")
)
server <- function(input,output,session){
val = reactiveVal()
observeEvent(input$get, {
val(file.choose())
})
output$txt <- renderText(val())
}
shinyApp(ui = ui, server = server)
The file.choose dialog returns the file path of a local file. This value is passed to the app where it is stored in a reactiveVal. The app can now display this text string.
Note that the file chosen is local to the browser, not the server. This means that in most cases your server will not be able to access the file.
Also, important to be clear to the user that they are providing a file path, not the file. Some users will not want to share the file path for privacy or security reasons.
Inspired by shinyFiles, I developed the following file-selection modal. This removes a package dependency, allows me to control the root folder users can access, and gives me control of the file-access source code. All of which will help when discussing the app with IT/security.
The file-access modal as a shiny module
## user interface
module_UI = function(id){
ns = NS(id)
tagList(
actionButton(ns("button_open"), "Select file")
)
}
## server
module_Server = function(id){
moduleServer(id, function(input, output, session){
ns = NS(id)
# path setup
root_path = "/set/this/path/so/users/will/only/have/access/to/subfolders"
current_path = reactiveVal()
current_path(root_path)
return_path = reactiveVal()
return_path(root_path)
# Selection modal
observeEvent(input$button_open, {
showModal(
modalDialog(
title = "Select a file",
p(strong("Current path: "), textOutput(ns("current_path"), inline = TRUE)),
fluidRow(
column(2, actionButton(ns("button_back"), "Back")),
column(4, selectInput(ns("dir"), label = NULL, choices = "Please select"))
),
footer = tagList(
modalButton("Cancel"),
actionButton(ns("ok"), "OK")
)
)
)
new_choices = c("Please select", dir(current_path()))
updateSelectInput(inputId = "dir", choices = new_choices)
})
# back button
observeEvent(input$button_back, {
if(current_path() != root_path){
current_path(dirname(current_path()))
new_choices = c("Please select", dir(current_path()))
updateSelectInput(inputId = "dir", choices = new_choices)
}
})
# OK button
observeEvent(input$ok, {
return_path(current_path())
removeModal()
})
# update directory
observeEvent(input$dir, {
if(input$dir != "Please select"){
current_path(file.path(current_path(), input$dir))
}
new_choices = c("Please select", dir(current_path()))
updateSelectInput(inputId = "dir", choices = new_choices)
})
# display directory
output$current_path = renderText({ current_path() })
return(reactive(return_path()))
})
}
A basic app for testing
testApp = function(...){
ui = fluidPage(
module_UI("id"),
textOutput("display")
)
server = function(input, output, session){
selected_path = module_Server("id")
output$display = renderText({ selected_path() })
}
shinyApp(ui, server, ...)
}
# run app
print(testApp())
Note that testing of the root_path is recommended, because some locations can be referred to in multiple ways. For example: dirname("~/Network-Shares/folder/subfolder") = "/home/ORG/username/Network-Shares/folder"