Create a line chart with different type of linetypes based on one or more dropdown selections-CodePudding

In the shiny app below Im trying to create a point&line chart based on the dropdown selection in the sidebar. I have managed to create a line chart when one metric is selected but cannot with 2 metrics. For the x and y I wnat a solid line,for the x1 and y1 I want a dashed line and for x2 and y2 a dotted line. When I select 2 metrics though I still get only one of them with solid line.

library(shiny)
library(shinydashboard)
library(plotly)
library(tidyr)
library(dplyr)
library(DT)
BRAND<-c("CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","LARA CHOCO CHIPS","LARA CHOCO CHIPS","LARA CHOCO CHIPS")
BRAND_COLOR<-c("#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#f050c0","#f050c0","#f050c0")

SellOut.x<-c(23,34,56,77,78,34,34,64,76)
SellOut.y<-c(43,54,76,78,87,98,76,76,56)
GrossProfit.x1<-c(23,34,56,75,78,34,34,64,76)
GrossProfit.y1<-c(33,54,76,76,87,98,76,76,56)
GrossSales.x2<-c(53,34,56,77,78,34,34,84,76)
GrossSales.y2<-c(63,54,76,78,87,98,76,76,86)
r<-c(58,46,76,76,54,21,69,98,98)

graph1.data<-data.frame(BRAND,BRAND_COLOR,r)

# data frame containing columns to be added
df6 <- data.frame(SellOut.x, SellOut.y, GrossProfit.x1, GrossProfit.y1, GrossSales.x2, GrossSales.y2) 

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("metric","Metric",c('Gross Sales','Gross Profit','Sell Out'),multiple = T,selected = "Sell Out")
  ),
  dashboardBody(
    DTOutput("df"),
    plotlyOutput("plot")
  )
)

server <- function(input, output) {
  
  
  
  choices <- reactive({
    c3 <- gsub(" ", "", input$metric) # remove space
    
    return(c3)
  })
  
  reactiveDf <- reactive({
    if(length(choices()) > 0){
      # if choices match column names of df6
      g1 <- apply(sapply(X = choices(), FUN = grepl, colnames(df6)), MARGIN =  1, FUN = any)
      
      addedDf <- df6[, g1] # columns to be added
      # colnames(addedDf) <- c("x", "y", "x1", "y1", "x2", "y2")[1:ncol(addedDf)] # change column names <---- does not work as it always picks x & y as the first two vars
      
      ab <- colnames(addedDf)
      
      abc <- sapply(strsplit(ab,split="\\."),"[")[2,]    ### this works
      
      colnames(addedDf) <- abc
      
      combinedDf <- cbind(graph1.data, addedDf) # add columns
      #combinedDf$label<-paste(combinedDf$BRAND,"-",input$metric)
      return(combinedDf)
    }else{
      #graph1.data$label<-paste(graph1.data$BRAND,"-",input$metric)
      
      return(graph1.data) 
    }
    
  })
  
  
  
  output$df<-renderDT({
    reactiveDf()
  })
  
  
  output$plot<-renderPlotly({
    Df <- req(reactiveDf())
    metric<-input$metric
    brand.colors <- reactiveDf()$BRAND_COLOR
    names(brand.colors) <- reactiveDf()$BRAND
    data<-unique(reactiveDf()$BRAND)
    ind=which(names(brand.colors) %in% data)
    
    if(length(metric) == 1) {
      for ( i in 1:length(brand.colors))
      {
        Df$BRAND[i]=paste(reactiveDf()$BRAND[i],metric)
      }
     
      
      names(brand.colors) <- Df$BRAND
      
      p <- Df %>%
        ggplot2::ggplot(aes(x, y, color = BRAND))
      p <- p   
        ggplot2::geom_line(aes(x))   
        # warnings suppressed on text property
        suppressWarnings(ggplot2::geom_point(aes(x, y, size = r, 
                                                 #text = hovertext
        ), show.legend = TRUE))  
        ggplot2::scale_color_manual(values = brand.colors)
      
    }
    else if(length(metric) == 2) {
      
    }
    else{
      
    }
    
  })
  
}

shinyApp(ui, server)

CodePudding user response：

One of the first problem is in the following statement

colnames(addedDf) <- c("x", "y", "x1", "y1", "x2", "y2")[1:ncol(addedDf)]

As it only allows you to assign x and y as the names regardless of what you select; Sell Out, Gross Sales or Gross Profit. I have now updated the code for the remaining issues in a long form.

library(shiny)
library(shinydashboard)
library(plotly)
library(tidyr)
library(dplyr)
library(DT)
BRAND<-c("CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","LARA CHOCO CHIPS","LARA CHOCO CHIPS","LARA CHOCO CHIPS")
BRAND_COLOR<-c("#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#f050c0","#f050c0","#f050c0")

SellOut.x<-c(23,34,56,77,78,34,34,64,76)
SellOut.y<-c(43,54,76,78,87,98,76,76,56)
GrossProfit.x1<-c(23,34,56,75,78,34,34,64,76)
GrossProfit.y1<-c(33,54,76,76,87,98,76,76,56)
GrossSales.x2<-c(53,34,56,77,78,34,34,84,76)
GrossSales.y2<-c(63,54,76,78,87,98,76,76,86)
r<-c(58,46,76,76,54,21,69,98,98)
mt <- c('Sell Out','Gross Sales','Gross Profit')

graph1.data<-data.frame(BRAND,BRAND_COLOR,r)

dfc <- data.frame(series=c(0,1,2), lines=c("solid","dashed","dotted"))

# data frame containing columns to be added
df6 <- data.frame(SellOut.x, SellOut.y, GrossProfit.x1, GrossProfit.y1, GrossSales.x2, GrossSales.y2) 

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("metric","Metric",c('Gross Sales','Gross Profit','Sell Out'),multiple = T,selected = "Sell Out")
  ),
  dashboardBody(
    DTOutput("df"),
    plotlyOutput("plot")
  )
)

server <- function(input, output) {
  
  choices <- reactive({
    c3 <- gsub(" ", "", input$metric) # remove space
    
    return(c3)
  })
  
  mydata <- eventReactive(input$metric, {
    
    if(length(choices()) > 0){
      g1 <- apply(sapply(X = choices(), FUN = grepl, colnames(df6)), MARGIN =  1, FUN = any)
      
      addedDf <- df6[, g1] # columns to be added
      
      ab <- colnames(addedDf)
      
      colnames(addedDf) <- sapply(strsplit(ab,split="\\."),"[")[2,]   
      
      combinedDf <- cbind(graph1.data, addedDf)
      abc <- colnames(combinedDf)
      
      if (sum(as.character(abc) %in% c("x", "y"))>0) { df1 <- combinedDf %>% rename(x0=x,y0=y) 
      }else df1 <- combinedDf
      #mt <- c('Sell Out','Gross Sales','Gross Profit')
      mydf <- df1 %>% # rename(x0=x,y0=y) %>% 
        dplyr::mutate(row = 1:n(),r=r) %>% 
        pivot_longer(cols = -c(row,BRAND,BRAND_COLOR,r))   %>% 
        separate(col = name, into = c("var", "series"), sep = 1) %>%
        pivot_wider(id_cols = c(BRAND,BRAND_COLOR,r,row, series), names_from = "var", values_from = "value") %>% 
        dplyr::mutate(metric=ifelse(series==0,mt[1],ifelse(series==1,mt[3],mt[2]))) %>% 
        dplyr::mutate(label=ifelse(series==0,paste(BRAND,mt[1]),ifelse(series==1,paste(BRAND,mt[3]),paste(BRAND,mt[2])))) %>% print(n=Inf)
      
    }else {mydf <- graph1.data}
    mydf
  }, ignoreNULL = FALSE)
  
  output$df <- renderDT({
    mydata()
  })
  
  myplot <- reactive({
    req(mydata(),input$metric)
    brand.colors <- mydata()$BRAND_COLOR
    names(brand.colors) <- mydata()$label
    linetype <- dfc$lines[dfc$series %in% unique(mydata()$series)]
    print(linetype)
    if(length(input$metric) == 1) {
      p <- mydata() %>% ggplot2::ggplot(aes(x, y, color = label))
    }else {
      p <- mydata() %>% ggplot2::ggplot(aes(x, y, group=metric, color = label))
    }
    p <- p   ggplot2::geom_line(aes(x, linetype=series))   ## 
      # warnings suppressed on text property
      suppressWarnings(ggplot2::geom_point(aes(x, y, size = r), show.legend = TRUE))  
      ggplot2::scale_color_manual(values = brand.colors)  
      scale_linetype_manual(name="", breaks=mydata()$series, values = linetype)
    p
  })
  
  output$plot <- renderPlotly({
    req(myplot())
    ggplotly(myplot())
  })
}

shinyApp(ui, server)