[英]Adjust Error when showing scatter plot in Shiny
你能帮我调整我的代码吗? 我试图让我的散点图看起来有光泽。 但是,它不起作用。 该功能还可以,但是我无法在 Shiny 上显示它。
欢迎任何帮助。
非常感谢!
rm(list=ls())
library(shiny)
library(shinythemes)
library(dplyr)
library(ggplot2)
library(tidyr)
library(lubridate)
function.cl<-function(dt){
df <- structure(
list(Id=c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
date1 = c("2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
"2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
"2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
"2021-07-20","2021-07-20","2021-07-20","2021-07-20"),
date2 = c("2021-07-01","2021-07-01","2021-07-01","2021-07-01","2021-04-02",
"2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-03",
"2021-04-03","2021-04-03","2021-04-03","2021-04-03","2021-04-08","2021-04-08",
"2021-04-09","2021-04-09","2021-04-10","2021-04-10"),
Week= c("Thursday","Thursday","Thursday","Thursday","Friday","Friday","Friday","Friday",
"Friday","Friday","Saturday","Saturday","Saturday","Saturday","Saturday","Thursday",
"Thursday","Friday","Friday","Saturday","Saturday"),
D = c("","","Ho","","","","","","Ho","","","","","","","","","","","",""),
D1 = c(8,1,9, 3,5,4,7,6,3,8,2,3,4,6,7,8,4,2,6,2,3), DR01 = c(4,1,4,3,3,4,3,6,3,7,2,3,4,6,7,8,4,2,6,7,3),
DR2 = c(2,1,4,3,3,4,1,6,3,7,2,3,4,6,7,8,4,2,6,2,3), DR03 = c(7,5,4,3,3,4,1,5,3,3,2,3,4,6,7,8,4,2,6,4,3)),
class = "data.frame", row.names = c(NA, -21L))
df<-subset(df,df$date2<df$date1)
dim_data<-dim(df)
day<-c(seq.Date(from = as.Date(df$date2[1]),
to = as.Date(df$date2[dim_data[1]]),
by = "1 day"))
df_grouped <- df %>%
mutate(across(starts_with("date"), as.Date)) %>%
group_by(date2) %>%
summarise(Id = first(Id),
date1 = first(date1),
Week = first(Week),
D = first(D),
D1 = sum(D1)) %>%
select(Id,date1,date2,Week,D,D1)
df_grouped <- df_grouped %>% mutate(date1=format(date1,"%d/%m/%Y"),
date2=format(date2,"%d/%m/%Y"))
df_grouped<-data.frame(df_grouped)
df_grouped
#create scatter plot
scatter_date <- function(dt, dta = df) {
# get the week day
my_day <- weekdays(as.Date(dt))
df_OC<-subset(df_grouped,is.na(D))
ds_OC<-subset(df_OC,df_OC$Week==my_day)
mean_Week<-mean(as.numeric(ds_OC[,"D1"]) )
sdeviation_Week<-sd(as.numeric(ds_OC[,"D1"]))
mean_Week_pos <- (mean_Week + sdeviation_Week)
mean_Week_neg <- (mean_Week - sdeviation_Week)
dta %>%
filter(date2 == ymd(dt)) %>%
summarize(across(starts_with("DR"), sum)) %>%
pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
mutate(name = as.numeric(name)) %>%
plot(xlab = "Days", ylab = "Types", xlim = c(0, 7),
ylim = c((min(.$val) %/% 10) * 10, (max(.$val) %/% 10 + 1) * 15))
abline(h=mean_Week, col='blue')
abline(h= mean_Week_pos, col='green',lty=2)
abline(h= mean_Week_neg, col='orange',lty=2)
}
#scatter_date("2021-07-01",df)
Plot1<-scatter_date(dt)
return(list(
"Plot1" = Plot1,
date = df$date
))
}
ui <- fluidPage(
ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("",
sidebarLayout(
sidebarPanel(
uiOutput("date"),
br(),
),
mainPanel(
tabsetPanel(
tabPanel("",plotOutput("Graph",width = "95%", height = "600"))),
))
)))
server <- function(input, output,session) {
data <- reactive(function.cl("2021-07-01"))
output$date <- renderUI({
all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
dateInput(input = "date",
label = "Select Date",
min = min(data()$date),
max = max(data()$date),
value = max(data()$date),
format = "dd-mm-yyyy",
datesdisabled = disabled)
})
output$Graph <- renderPlot({
req(input$date)
function.cl(input$date)[["Plot1"]]
})
}
shinyApp(ui = ui, server = server)
您的函数存在一些问题。 尝试这个
function.cl<-function(dt){
df <- structure(
list(Id=c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
date1 = c("2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
"2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
"2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
"2021-07-20","2021-07-20","2021-07-20","2021-07-20"),
date2 = c("2021-07-01","2021-07-01","2021-07-01","2021-07-01","2021-04-02",
"2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-03",
"2021-04-03","2021-04-03","2021-04-03","2021-04-03","2021-04-08","2021-04-08",
"2021-04-09","2021-04-09","2021-04-10","2021-04-10"),
Week= c("Thursday","Thursday","Thursday","Thursday","Friday","Friday","Friday","Friday",
"Friday","Friday","Saturday","Saturday","Saturday","Saturday","Saturday","Thursday",
"Thursday","Friday","Friday","Saturday","Saturday"),
D = c("","","Ho","","","","","","Ho","","","","","","","","","","","",""),
D1 = c(8,1,9, 3,5,4,7,6,3,8,2,3,4,6,7,8,4,2,6,2,3), DR01 = c(4,1,4,3,3,4,3,6,3,7,2,3,4,6,7,8,4,2,6,7,3),
DR2 = c(2,1,4,3,3,4,1,6,3,7,2,3,4,6,7,8,4,2,6,2,3), DR03 = c(7,5,4,3,3,4,1,5,3,3,2,3,4,6,7,8,4,2,6,4,3)),
class = "data.frame", row.names = c(NA, -21L))
df<-subset(df,df$date2<df$date1)
dim_data<-dim(df)
day<-c(seq.Date(from = as.Date(df$date2[1]), by = "days",
length = dim_data[1]
)) ###<--------- issue here
df_grouped <- df %>%
mutate(across(starts_with("date"), as.Date)) %>%
group_by(date2) %>%
summarise(Id = first(Id),
date1 = first(date1),
Week = first(Week),
D = first(D),
D1 = sum(D1)) %>%
select(Id,date1,date2,Week,D,D1)
df_grouped <- df_grouped %>% mutate(date1=format(date1,"%d/%m/%Y"),
date2=format(date2,"%d/%m/%Y"))
df_grouped<-data.frame(df_grouped)
df_grouped
#create scatter plot
scatter_date <- function(dt, dta = df) {
# get the week day
my_day <- weekdays(as.Date(dt))
df_OC<-subset(df_grouped,is.na(D) | D=="") ###<----------- issue here
ds_OC<-subset(df_OC,df_OC$Week==my_day)
mean_Week<-mean(as.numeric(ds_OC[,"D1"]) )
sdeviation_Week<-sd(as.numeric(ds_OC[,"D1"]))
mean_Week_pos <- (mean_Week + sdeviation_Week)
mean_Week_neg <- (mean_Week - sdeviation_Week)
dta %>%
filter(date2 == ymd(dt)) %>%
summarize(across(starts_with("DR"), sum)) %>%
pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
mutate(name = as.numeric(name)) %>%
plot(xlab = "Days", ylab = "Types", xlim = c(0, 7),
ylim = c((min(.$val) %/% 10) * 10, (max(.$val) %/% 10 + 1) * 15))
abline(h=mean_Week, col='blue')
abline(h= mean_Week_pos, col='green',lty=2)
abline(h= mean_Week_neg, col='orange',lty=2)
}
#scatter_date("2021-07-01",df)
Plot1<-scatter_date(dt)
return(list(
"Plot1" = Plot1,
date = df$date
))
}
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.