R dashboard plot issues - r

Question

For simplicity, assume the BTC, ETH, XRP data is an arbitrary list of numbers ie: 4000, 5000, 500 etc. The data from the web and my excel files is not implemented this version and I have added fake data for anyone to recreate my problem with the Plots. My problem is that everything works and the dashboard comes up, but the plots will not appear. It has something to do with my server function, and I know It needs to be reactive in some form. I have not found a solution that fixes my problem. let me know if I can help in any way or answer any questions. Thanks! (I also know not all library functions are being used at this moment)
Additionally, if anyone knows how to implement the selected dates as the used input for the plots that would be awesome as well! Right now I am using a slider input for simplicity. I will also change the plot to a line graph. For now, if someone could help me with the reactivity that would be great!
`
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)
`

Answer 1

The problem was the elements not enclosed in the box(). namely Function for Chart in all three tabItems.
I have commented out the two lines in each tabItem
# Final <- difftime(End ,Start , units = c("days")),
# textOutput(Final)
I am not sure what you are trying to do with the above two lines. Here are a few pointers:
If you are looking to use an input value in ui, you can use input.inputId (in the server you will use input$inputId)
Use box() around this textOutput()
Move fixed calculations (like Final) out of ui.
Also, check the warning messages you are getting in the console when you run the app.
Here is the working code:
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)