我一直在构建一个闪亮的应用程序,它显示从网络收集的一些信息。
我使用 shinydashboard 创建应用程序。
我想要一个启动框,它可以是登录页面,也可以是名称和电子邮件输入框,任何想要使用该应用程序的人都需要在查看数据之前填写它。
此外,我想在有人使用该应用程序时收集该数据并在 googlesheet 中添加一行,并对其进行充值,记录他们使用该应用程序进行的搜索。
我已经尝试了所有可用的教程,但似乎不起作用。
这是用户界面:
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
))))
))))
现在对于服务器:
library(shiny)
library(shiny)
library(dplyr)
library(RISmed)
library(ggplot2)
library(DT)
##数据加载
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)
})
对不起,乱七八糟。这是一个进展中的工作。
我现在有一个新问题,即 df$Model 中的超链接在链接之前与我的本地 127.0.0.1 一起出现,使其无法使用。
先感谢您。