为简单起见，假设BTC，ETH，XRP数据是数字的任意列表，即：4000、5000、500等。此版本未实现来自网络和我的excel文件的数据，并且我为任何人都可以用图来重现我的问题。我的问题是，一切正常，并且仪表板启动，但是绘图不会出现。它与我的服务器功能有关，我知道它需要以某种形式进行响应。我没有找到解决我的问题的解决方案。让我知道我是否可以提供任何帮助或回答任何问题。谢谢！ （我还知道目前还没有使用所有库函数）
此外，如果有人知道如何将选择的日期作为绘图的常用输入来实现，那就太棒了！现在，为了简单起见，我使用滑块输入。我还将把图更改为折线图。现在，如果有人可以帮助我提高反应性，那就好了！ `
library(shiny)
library(shinydashboard)
library(ggplot2)
library(gdata)
library(rvest)
# setwd("C:/Users/Zach/Documents/app.R/fuckk you")
# url <- "https://coinmarketcap.com/currencies/bitcoin/historical-data/?start=20130428&end=20180811"
# BTCALL <- url %>%
# html() %>%
# html_nodes(xpath='//*[@id="historical-data"]/div/div[2]/table') %>%
# html_table()
# BTCALL <- BTCALL[[1]]
#
# url <- "https://coinmarketcap.com/currencies/ethereum/historical-data/?start=20130428&end=20180811"
# ETHALL <- url %>%
# html() %>%
# html_nodes(xpath='//*[@id="historical-data"]/div/div[2]/table') %>%
# html_table()
# ETHALL <- ETHALL[[1]]
#
# url <- "https://coinmarketcap.com/currencies/ripple/historical-data/?start=20130428&end=20180811"
# XRPALL <- url %>%
# html() %>%
# html_nodes(xpath='//*[@id="historical-data"]/div/div[2]/table') %>%
# html_table()
# XRPALL <- XRPALL[[1]]
# df <- read.xls("Rdata.xlsx",
# sheet = 1,
# perl="c:/Perl64/bin/perl")
#
# BTC <- df[,2]
# ETH <- df[,3]
# XRP <- df[,4]
# DataDate <- df[,1]
Date <- Sys.Date()
class(as.Date(Date))
Start <- Date
End <- Date+8
BTC = c(5000,6000,7000,8000,9000,10000,11000,12000)
ETH = c(300,400,500,600,700,800,900,1000,1100,1200)
XRP = c(.2,.3,.4,.5,.6,.7,.8,.9,1,1.1,1.2,1.3,1.4)
ui <- fluidPage(
dashboardPage( skin = "black",
dashboardHeader(title = tags$a(tags$img(src="Apollo.png", height ='58', width ='220'),
'Apollo Projections'),
dropdownMenu(type = "message",
messageItem(from = "btc Updates", message = "BTC ETF to be launched soon", time = "12:00")
),
dropdownMenu(type = "notifications",
notificationItem(
text = "2 new tabs added!",
icon = icon("dashboard"),
status = "success"
)
),
dropdownMenu(type = "tasks",
taskItem(
value = 62,
color = "red",
text = "Read BTC manuel"
),
taskItem(
value = 22,
color = "aqua",
text = "Read ETH manuel"
))
),
dashboardSidebar(
sidebarMenu(
menuItem("BTC", tabName = "BTC",icon = icon("bitcoin")),
menuSubItem("Volume", tabName = "BTCV"),
menuSubItem("MarketCap", tabName = "BTCM"),
menuItem("ETH", tabName = "Eth"),
menuItem("XRP", tabName = "Xrp", badgeLabel = "New", badgeColor = "aqua")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "BTC",
fluidRow(
infoBox("Current BTC Price Change",paste("%",round(BTC/BTC,digits = 4)), icon = icon("bitcoin")),
infoBox("Tomorrow BTC Price Change",paste("%",round(BTC[2]/BTC,digits = 4)), icon = icon("warning"), color = "blue"),
infoBox("Weekly BTC Price Change",paste("%",round(BTC[7]/BTC,digits = 4)), icon = icon("bar-chart-o"), color = "red")
),
fluidRow(
valueBox(paste("$",round(BTC,digits = 2)), "BTC Price Today", icon = icon("hourglass-3")),
valueBox(paste("$",round(BTC[2],digits = 2)), "BTC Price Tomorrow", icon = icon("diamond"), color = "blue"),
valueBox(paste("$",round(BTC[7],digits = 2)), "BTC Price in 1 Week", icon = icon("globe"),color ="red")
),
fluidRow(
box(title = "BTC Projections", status = "primary", solidHeader = T, plotOutput("Bhisto", height = "500px")),
box (title = "Controls for BTC", status = "primary", solidHeader = T,
sliderInput("NUM","Days for BTC",1,100,50),
dateInput("BTCdate1", "Starting Date", value = Date), dateInput("BTCdate2", "Ending Date", value = Date+6)),
##function for Chart
Final <- difftime(End ,Start , units = c("days")),
textOutput(Final)
)),
tabItem(tabName = "BTCV",
h1("BTC Volume Projections")
),
tabItem(tabName = "BTCM",
h1("BTC MarketCap Projections")
),
tabItem(tabName = "Eth",
fluidRow(
infoBox("Current ETH Price Change",paste("%",round(ETH/ETH,digits = 4)), icon = icon("bitcoin")),
infoBox("Tomorrow ETH Price Change",paste("%",round(ETH[2]/ETH,digits = 4)), icon = icon("warning"), color = "blue"),
infoBox("Weekly ETH Price Change",paste("%",round(ETH[7]/ETH,digits = 4)), icon = icon("bar-chart-o"), color = "red")
),
fluidRow(
valueBox(paste("$",round(ETH,digits = 2)), "ETH Price Today", icon = icon("hourglass-3")),
valueBox(paste("$",round(ETH[2],digits = 2)), "ETH Price Tomorrow", icon = icon("diamond"), color = "blue"),
valueBox(paste("$",round(ETH[7],digits = 2)), "ETH Price in 1 Week", icon = icon("globe"),color ="red")
),
fluidRow(
box(title = "ETH Projections", status = "primary", solidHeader = T, plotOutput("Ehisto", height = "500px")),
box (title = "Controls for ETH", status = "primary", solidHeader = T,
sliderInput("NUM2","Days for ETH",1,100,50),
dateInput("ETHdate1", "Starting Date", value = Date), dateInput("ETHdate2", "Ending Date", value = Date+6)),
##function for Chart
Final <- difftime(End ,Start , units = c("days")),
textOutput(Final)
)),
tabItem(tabName = "Xrp",
fluidRow(
infoBox("Current XRP Price Change",paste("%",round(XRP/XRP,digits = 4)), icon = icon("bitcoin")),
infoBox("Tomorrow XRP Price Change",paste("%",round(XRP[2]/XRP,digits = 4)), icon = icon("warning"), color = "blue"),
infoBox("Weekly XRP Price Change",paste("%",round(XRP[7]/XRP,digits = 4)), icon = icon("bar-chart-o"), color = "red")
),
fluidRow(
valueBox(paste("$",round(XRP,digits = 2)), "XRP Price Today", icon = icon("hourglass-3")),
valueBox(paste("$",round(XRP[2],digits = 2)), "XRP Price Tomorrow", icon = icon("diamond"), color = "blue"),
valueBox(paste("$",round(XRP[7],digits = 2)), "XRP Price in 1 Week", icon = icon("globe"),color ="red")
),
fluidRow(
box(title = "XRP Projections", status = "primary", solidHeader = T, plotOutput("Xhisto", height = "500px")),
box (title = "Controls for XRP", status = "primary", solidHeader = T,
sliderInput("NUM3","Days for XRP",1,100,50),
dateInput("XRPdate1", "Starting Date", value = Date), dateInput("XRPdate2", "Ending Date", value = Date+6)),
##function for Chart
Final <- difftime(End ,Start , units = c("days")),
textOutput(Final)
))
)
)
)
)
server = function(input, output){
output$Bhisto <- renderPlot({
plot(BTC,breaks = input$NUM)
})
output$Ehisto <- renderPlot({
plot(ETH,breaks = input$NUM2)
})
output$Xhisto <- renderPlot({
plot(XRP,breaks = input$NUM3)
})
}
shinyApp(ui = ui, server = server)
`
答案 0 :(得分：1)
问题是box()中没有包含的元素。即所有三个tabItem中的图表功能。
我已经注释掉了每个tabItem中的两行
# Final <- difftime(End ,Start , units = c("days")),
# textOutput(Final)
我不确定您要对上述两行做什么。这里有一些指针：
input.inputId（在服务器中，您将使用input$inputId）box()周围使用textOutput() 这是工作代码：
library(shiny)
library(shinydashboard)
library(ggplot2)
library(gdata)
library(rvest)
# setwd("C:/Users/Zach/Documents/app.R/fuckk you")
# url <- "https://coinmarketcap.com/currencies/bitcoin/historical-data/?start=20130428&end=20180811"
# BTCALL <- url %>%
# html() %>%
# html_nodes(xpath='//*[@id="historical-data"]/div/div[2]/table') %>%
# html_table()
# BTCALL <- BTCALL[[1]]
#
# url <- "https://coinmarketcap.com/currencies/ethereum/historical-data/?start=20130428&end=20180811"
# ETHALL <- url %>%
# html() %>%
# html_nodes(xpath='//*[@id="historical-data"]/div/div[2]/table') %>%
# html_table()
# ETHALL <- ETHALL[[1]]
#
# url <- "https://coinmarketcap.com/currencies/ripple/historical-data/?start=20130428&end=20180811"
# XRPALL <- url %>%
# html() %>%
# html_nodes(xpath='//*[@id="historical-data"]/div/div[2]/table') %>%
# html_table()
# XRPALL <- XRPALL[[1]]
# df <- read.xls("Rdata.xlsx",
# sheet = 1,
# perl="c:/Perl64/bin/perl")
#
# BTC <- df[,2]
# ETH <- df[,3]
# XRP <- df[,4]
# DataDate <- df[,1]
Date <- Sys.Date()
class(as.Date(Date))
Start <- Date
End <- Date+8
BTC = c(5000,6000,7000,8000,9000,10000,11000,12000)
ETH = c(300,400,500,600,700,800,900,1000,1100,1200)
XRP = c(.2,.3,.4,.5,.6,.7,.8,.9,1,1.1,1.2,1.3,1.4)
ui <- fluidPage(
dashboardPage( skin = "black",
dashboardHeader(title = tags$a(tags$img(src="Apollo.png", height ='58', width ='220'),
'Apollo Projections'),
dropdownMenu(type = "message",
messageItem(from = "btc Updates", message = "BTC ETF to be launched soon", time = "12:00")
),
dropdownMenu(type = "notifications",
notificationItem(
text = "2 new tabs added!",
icon = icon("dashboard"),
status = "success"
)
),
dropdownMenu(type = "tasks",
taskItem(
value = 62,
color = "red",
text = "Read BTC manuel"
),
taskItem(
value = 22,
color = "aqua",
text = "Read ETH manuel"
))
),
dashboardSidebar(
sidebarMenu(
menuItem("BTC", tabName = "BTC",icon = icon("bitcoin")),
menuSubItem("Volume", tabName = "BTCV"),
menuSubItem("MarketCap", tabName = "BTCM"),
menuItem("ETH", tabName = "Eth"),
menuItem("XRP", tabName = "Xrp", badgeLabel = "New", badgeColor = "aqua")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "BTC",
fluidRow(
infoBox("Current BTC Price Change",paste("%",round(BTC/BTC,digits = 4)), icon = icon("bitcoin")),
infoBox("Tomorrow BTC Price Change",paste("%",round(BTC[2]/BTC,digits = 4)), icon = icon("warning"), color = "blue"),
infoBox("Weekly BTC Price Change",paste("%",round(BTC[7]/BTC,digits = 4)), icon = icon("bar-chart-o"), color = "red")
),
fluidRow(
valueBox(paste("$",round(BTC,digits = 2)), "BTC Price Today", icon = icon("hourglass-3")),
valueBox(paste("$",round(BTC[2],digits = 2)), "BTC Price Tomorrow", icon = icon("diamond"), color = "blue"),
valueBox(paste("$",round(BTC[7],digits = 2)), "BTC Price in 1 Week", icon = icon("globe"),color ="red")
),
fluidRow(
box(title = "BTC Projections", status = "primary", solidHeader = T, plotOutput("Bhisto")),
box (title = "Controls for BTC", status = "primary", solidHeader = T,
sliderInput("NUM","Days for BTC",1,100,50),
dateInput("BTCdate1", "Starting Date", value = Date), dateInput("BTCdate2", "Ending Date", value = Date+6))
##function for Chart
# Final <- difftime(End ,Start , units = c("days")),
# textOutput(Final)
)),
tabItem(tabName = "BTCV",
h1("BTC Volume Projections")
),
tabItem(tabName = "BTCM",
h1("BTC MarketCap Projections")
),
tabItem(tabName = "Eth",
fluidRow(
infoBox("Current ETH Price Change",paste("%",round(ETH/ETH,digits = 4)), icon = icon("bitcoin")),
infoBox("Tomorrow ETH Price Change",paste("%",round(ETH[2]/ETH,digits = 4)), icon = icon("warning"), color = "blue"),
infoBox("Weekly ETH Price Change",paste("%",round(ETH[7]/ETH,digits = 4)), icon = icon("bar-chart-o"), color = "red")
),
fluidRow(
valueBox(paste("$",round(ETH,digits = 2)), "ETH Price Today", icon = icon("hourglass-3")),
valueBox(paste("$",round(ETH[2],digits = 2)), "ETH Price Tomorrow", icon = icon("diamond"), color = "blue"),
valueBox(paste("$",round(ETH[7],digits = 2)), "ETH Price in 1 Week", icon = icon("globe"),color ="red")
),
fluidRow(
box(title = "ETH Projections", status = "primary", solidHeader = T, plotOutput("Ehisto", height = "500px")),
box (title = "Controls for ETH", status = "primary", solidHeader = T,
sliderInput("NUM2","Days for ETH",1,100,50),
dateInput("ETHdate1", "Starting Date", value = Date), dateInput("ETHdate2", "Ending Date", value = Date+6))
##function for Chart
# Final <- difftime(End ,Start , units = c("days")),
# textOutput(Final)
)),
tabItem(tabName = "Xrp",
fluidRow(
infoBox("Current XRP Price Change",paste("%",round(XRP/XRP,digits = 4)), icon = icon("bitcoin")),
infoBox("Tomorrow XRP Price Change",paste("%",round(XRP[2]/XRP,digits = 4)), icon = icon("warning"), color = "blue"),
infoBox("Weekly XRP Price Change",paste("%",round(XRP[7]/XRP,digits = 4)), icon = icon("bar-chart-o"), color = "red")
),
fluidRow(
valueBox(paste("$",round(XRP,digits = 2)), "XRP Price Today", icon = icon("hourglass-3")),
valueBox(paste("$",round(XRP[2],digits = 2)), "XRP Price Tomorrow", icon = icon("diamond"), color = "blue"),
valueBox(paste("$",round(XRP[7],digits = 2)), "XRP Price in 1 Week", icon = icon("globe"),color ="red")
),
fluidRow(
box(title = "XRP Projections", status = "primary", solidHeader = T, plotOutput("Xhisto", height = "500px")),
box (title = "Controls for XRP", status = "primary", solidHeader = T,
sliderInput("NUM3","Days for XRP",1,100,50),
dateInput("XRPdate1", "Starting Date", value = Date), dateInput("XRPdate2", "Ending Date", value = Date+6))
##function for Chart
# Final <- difftime(End ,Start , units = c("days")),
# textOutput(Final)
))
)
)
)
)
server = function(input, output){
output$Bhisto <- renderPlot({
plot(BTC)
})
output$Ehisto <- renderPlot({
plot(ETH,breaks = input$NUM2)
})
output$Xhisto <- renderPlot({
plot(XRP,breaks = input$NUM3)
})
}
shinyApp(ui, server)