Zizou
Zizou

Reputation: 503

Disorder of x-axis dates in plotly

I have a simple application in shiny and I would like to sort out the sequence of weeks on the x-axis. Currently graph connects the dots in order 1,10,11,12,2 ... as you can see in the graph below. How do I change the type for the data on the x axis so that the order is ascending correctly?

enter image description here

My code:

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)

Thanks for your comments :)

Upvotes: 0

Views: 240

Answers (1)

Duck
Duck

Reputation: 39613

You can try this (and be careful with the levels of your variables):

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)

Which will produce:

enter image description here

Upvotes: 2

Related Questions