绘图中x轴日期的混乱

Question

我有一个简单的 Shiny 应用程序，我想整理出 x 轴上的周序列。目前，图形按 1、10、11、12、2 的顺序连接点......如下图所示。如何更改 x 轴上数据的类型以使顺序正确升序？

我的代码：

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(readxl)
library(tidyr)
library(DT)

df1 <- data.frame(Week = as.factor(paste0('week ',rep(1:12,10,replace = TRUE))), Product = paste0('Product ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T), Amount = sample(c(1000:10000),120, replace = T),stringsAsFactors = F)

df2 <- data.frame(Week = as.factor(paste0('week ',rep(11:22,10,replace = TRUE))), Product = paste0('Product ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T),Amount = sample(c(1000:10000),120, replace = T), stringsAsFactors = F)

analyze <- c("Value", "Amount")

# UI
ui <- fluidPage(
  column(
    6,fluidRow(column(6, selectizeInput("All", "Year: 2018", multiple = T,choices = unique(df1$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectizeInput("All2", "Year: 2019", multiple = T,choices = unique(df2$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectInput("y_axis1", "What you want to analyze?", choices = analyze))
    )),
  column(
    12,fluidRow(column(12, plotlyOutput('plot'))
    )
  ) 
)

# Server code
server <- function(input, output) {
  
  tab_input1 <- reactive({
    switch(input$y_axis1,
           Value = "Value", 
           Amount = "Amount")
  })
  
  outVar <- reactive({
    df1 %>%
      filter(Product %in% input$All) %>%
      mutate(Product = paste(Product, "2018", sep = " ")) %>% 
      arrange(Week) %>%
      droplevels()
  })
  
  outVar2 <- reactive({
    df2 %>%
      filter(Product %in% input$All2) %>%
      mutate(Product = paste(Product, "2019", sep = " ")) %>% 
      arrange(Week) %>%
      droplevels()
  })
    
  ax <- list(
    type = "category",
    categoryorder = "array",
    categoryarray = unique(paste0('week ',rep(1:22,replace = TRUE))),
    showgrid = TRUE,
    showline = TRUE,
    autorange = TRUE,
    showticklabels = TRUE,
    ticks = "outside",
    tickangle = 0
  )
  
  output$plot <- renderPlotly({
    plot_ly(data=outVar(), x=~Week,  y = outVar()[,tab_input1()],
            type = 'scatter', mode = 'lines', legendgroup = "1",
            color = ~Product, colors = c('red','blue', 'yellow', 'green', "orange")) %>%
      add_trace(data=outVar2(), x=~Week,  y = outVar2()[,tab_input1()],
                type = 'scatter', mode = 'lines', legendgroup = "2",
                color = ~Product, colors = c('red','blue', 'yellow', 'green', "orange"))  %>%
      layout(legend = list(orientation = 'h')) %>% 
      layout(xaxis = ax)
    
  }) 
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

感谢您的 cmets :)

Answer 1

您可以试试这个（并注意变量的级别）：

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(readxl)
library(tidyr)
library(DT)

df1 <- data.frame(Week = factor(paste0('week ',rep(1:12,10,replace = TRUE)),
                                levels = unique(paste0('week ',rep(1:12,10,replace = TRUE))),
                                ordered = T), Product = paste0('Product ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T), Amount = sample(c(1000:10000),120, replace = T),stringsAsFactors = F)

df2 <- data.frame(Week = factor(paste0('week ',rep(11:22,10,replace = TRUE)),
                                levels = unique(paste0('week ',rep(11:22,10,replace = TRUE))),
                                ordered = T), Product = paste0('Product ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T),Amount = sample(c(1000:10000),120, replace = T), stringsAsFactors = F)

analyze <- c("Value", "Amount")

# UI
ui <- fluidPage(
  column(
    6,fluidRow(column(6, selectizeInput("All", "Year: 2018", multiple = T,choices = unique(df1$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectizeInput("All2", "Year: 2019", multiple = T,choices = unique(df2$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectInput("y_axis1", "What you want to analyze?", choices = analyze))
    )),
  column(
    12,fluidRow(column(12, plotlyOutput('plot'))
    )
  ) 
)

# Server code
server <- function(input, output) {
  
  tab_input1 <- reactive({
    switch(input$y_axis1,
           Value = "Value", 
           Amount = "Amount")
  })
  
  outVar <- reactive({
    df1 %>%
      filter(Product %in% input$All) %>%
      mutate(Product = paste(Product, "2018", sep = " ")) %>% 
      arrange(Week) %>%
      droplevels()
  })
  
  outVar2 <- reactive({
    df2 %>%
      filter(Product %in% input$All2) %>%
      mutate(Product = paste(Product, "2019", sep = " ")) %>% 
      arrange(Week) %>%
      droplevels()
  })
  
  ax <- list(
    type = "category",
    categoryorder = "array",
    categoryarray = unique(paste0('week ',rep(1:22,replace = TRUE))),
    showgrid = TRUE,
    showline = TRUE,
    autorange = TRUE,
    showticklabels = TRUE,
    ticks = "outside",
    tickangle = 0
  )
  
  output$plot <- renderPlotly({
    plot_ly(data=outVar(), x=~Week,  y = outVar()[,tab_input1()],
            type = 'scatter', mode = 'lines', legendgroup = "1",
            color = ~Product, colors = c('red','blue', 'yellow', 'green', "orange")) %>%
      add_trace(data=outVar2(), x=~Week,  y = outVar2()[,tab_input1()],
                type = 'scatter', mode = 'lines', legendgroup = "2",
                color = ~Product, colors = c('red','blue', 'yellow', 'green', "orange"))  %>%
      layout(legend = list(orientation = 'h')) %>% 
      layout(xaxis = ax)
    
  }) 
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

这将产生：