I have been building a Shiny app that displays some information gathered from the web.
Im using shinydashboard to create the app.
I would like to have a startup box that is either a login page or a Name and Email input box that anyone that wants to use the app needs to fill before seeing the data.
Also I would like to gather that data and add a row to a googlesheet anytime someone uses the app, and to top it up, record the searches they make using the app.
I have tried all the tutorials available, and does not seem to work.
Here is UI:
library(shiny)
library(dplyr)
library(RISmed)
library(ggplot2)
library(DT)
library(shinydashboard)
shinyUI(dashboardPage(skin = "blue",
dashboardHeader(
dashboardSidebar(dashboardSidebar(
sidebarMenu(
menuItem("Homepage", tabName = "home", icon = icon("flask")),
menuItem("Search Product", tabName = "product", icon = icon("info")),
menuItem("Search Catalog", tabName = "catalog", icon = icon("map-pin")),
menuItem("Support", tabName = "support", icon = icon("support"))))),
dashboardBody(
tabItems(
tabItem("home",
fluidPage(##DETAILS
tabItem("product",
fluidPage(
sidebarLayout(
sidebarPanel(
textInput("name", "Protein name", value = "actin"),
selectInput("clonality", "Clonality", choices = c("Monoclonal", "Polyclonal")),
submitButton("Search")),
mainPanel(
tabsetPanel(
tabPanel("Products", DT::dataTableOutput("table1")),
tabPanel("More Info", dataTableOutput("table2")),
tabPanel("Titles", tableOutput("table3")),
tabPanel("Authors", tableOutput("table4")),
tabPanel("Searches", plotOutput("plot")))
)))),
tabItem("catalog",
fluidPage(
sidebarLayout(
sidebarPanel(
helpText("Search by Catalog Number"),
textInput("model", "Model Number"),
submitButton("Search")),
mainPanel(
tabsetPanel(
tabPanel("Product", dataTableOutput("table5")),
tabPanel("More Info", dataTableOutput("table6"))
))))),
tabItem("support",
fluidRow(
mainPanel(
tabsetPanel(
tabPanel("Contacts", ##DETAILS
tabPanel("Documents", ##DETAILS
))))
))))
Now for the server:
library(shiny)
library(shiny)
library(dplyr)
library(RISmed)
library(ggplot2)
library(DT)
##DATA LOADING
shinyServer(function(input, output, session) {
output$table1 <- DT::renderDataTable({
search <- input$name
df <- subset(products, grepl(search, products$Name, ignore.case = TRUE)==TRUE)
df$Model <- paste0("<a href=",df$URL1,"target='_blank>",df$Model,"</a>")
df2 <- subset(df, Clonality == input$clonality)
df3 <- df2[,tbl]
datatable(df3, escape = FALSE)%>%formatStyle("Reviews",backgroundColor=styleInterval(1.10, c("red", "green")))%>%formatStyle("Name","Price Dollars",backgroundColor=styleEqual("132 214.5 264", "orange"))
})
output$table2 <- DT::renderDataTable({
search <- input$name
df <- subset(products, grepl(search, products$Name, ignore.case = TRUE)==TRUE)
df$Pathways <- paste0("<a href='",df$Pathway.URL.1,"' target='_blank'>",df$Pathways.1,"</a>", "</br>","<a href='",df$Pathway.URL.2,"' target='_blank'>",df$Pathways.2,"</a>")
df2 <- subset(df, Clonality == input$clonality)
df3 <- df2[,tbl2]
return(df3)
}, escape = FALSE)
table3 <- reactive({
search_topic <- input$name
search_query <- EUtilsSummary(search_topic, mindate = 2017, maxdate=2018, retmax = 100)
records <- EUtilsGet(search_query)
Titles <- as.data.frame(((ArticleTitle(records))))
colnames(Titles) = "Articles Titles"
withProgress(session, min=1, max=15, {
setProgress(message = 'Calculation in progress',
detail = 'This may take a while...')
for (i in 1:15) {
setProgress(value = i)
Sys.sleep(0.1)
}
})
print(Titles)
})
table4 <- reactive({
search_topic <- input$name
search_query <- EUtilsSummary(search_topic, mindate = 2017, maxdate=2018, retmax = 100)
records <- EUtilsGet(search_query)
AuthorList<-Author(records)
LastFirst<-sapply(AuthorList, function(x)paste(x$LastName,x$ForeName))
auths<-as.data.frame(sort(table(unlist(LastFirst)), dec=TRUE))
colnames(auths)<- c("Author", "Count")
auths <- cbind(Author = rownames(auths), auths)
rownames(auths) <- NULL
withProgress(session, min=1, max=15, {
setProgress(message = 'Calculation in progress',
detail = 'This may take a while...')
for (i in 1:15) {
setProgress(value = i)
Sys.sleep(0.1)
}
})
print(auths)
})
plot1 <- reactive({
search_topic <- input$name
search_query <- EUtilsSummary(search_topic, mindate = 2017, maxdate=2018, retmax = 1000)
records <- EUtilsGet(search_query)
y <- data.frame(cbind("year"= YearPubmed(records), "month"= MonthPubmed(records)))
date()
count<-table(y)
y$date <- as.Date(strptime(paste(y$year, y$month, "01", sep="-"), "%Y-%m-%d", tz = "UTC"), origin="1970-01-01")
withProgress(session, min=1, max=15, {
setProgress(message = 'Calculation in progress',
detail = 'This may take a while...')
for (i in 1:15) {
setProgress(value = i)
Sys.sleep(0.1)
}
})
y %>% group_by(date) %>% summarise(n.citation = length(date)) %>%
ggplot(aes(x=date, y = n.citation)) + geom_point(color="black", shape=20, alpha = 0.6) +
geom_line(color="black") +
ggtitle(input$name) + xlab("Date") + ylab("Number of Citations") + theme_bw() +
theme(panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))
})
output$table5 <- DT::renderDataTable({
search <- input$model
df <- subset(products, products$Model==input$model)
df$Model <- paste0("<a href='",df$URL1,"' target='_blank'>",df$Model,"</a>")
df2 <- df[,tbl]
colnames(df2) <- c("Name", "Model", "Short Description", "Human Gene Symbol", "Sizes", "Price Pounds", "Price Dollars", "Price Euros", "Reviews" )
return(df2)
}, escape = FALSE)
output$table6 <- DT::renderDataTable({
search <- input$model
df <- subset(products, products$Model==input$model)
df$Pathways <- paste0("<a href='",df$Pathway.URL.1,"' target='_blank'>",df$Pathways.1,"</a>", "</br>","<a href='",df$Pathway.URL.2,"' target='_blank'>",df$Pathways.2,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.3,"' target='_blank'>",df$Pathways.2,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.4,"' target='_blank'>",df$Pathways.4,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.5,"' target='_blank'>",df$Pathways.5,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.6,"' target='_blank'>",df$Pathways.6,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.7,"' target='_blank'>",df$Pathways.7,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.8,"' target='_blank'>",df$Pathways.8,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.9,"' target='_blank'>",df$Pathways.9,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.10,"' target='_blank'>",df$Pathways.10,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.11,"' target='_blank'>",df$Pathways.11,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.12,"' target='_blank'>",df$Pathways.12,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.13,"' target='_blank'>",df$Pathways.13,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.14,"' target='_blank'>",df$Pathways.14,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.15,"' target='_blank'>",df$Pathways.15,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.16,"' target='_blank'>",df$Pathways.16,"</a>"
,"</a>", "</br>","<a href='",df$Pathway.URL.17,"' target='_blank'>",df$Pathways.17,"</a>")
df2 <- df[,tbl2]
return(df2)
}, escape = FALSE)
getPage<-function() {
search <- input$model
df <- subset(products, products$Model==input$model)
df$URL2 <- paste0("https://",df$URL1)
return(tags$iframe(src = df$URL2
, style="width:100%;", frameborder="0"
,id="iframe"
, height = "1000px", seamless = TRUE))
}
output$table3 <- renderTable(table3())
output$table4 <- renderTable(table4())
output$plot <- renderPlot(plot1(), width = 850, height = 425)
})
Sorry about the messy. This is a work in progress.
Im having now a new issue that is the Hyperlink in the df$Model come with my local 127.0.0.1 before the link, making it unusable.
Thank you in advance.
