-1

I want to create an app for financial analysis, i have a code ready but

proftrend = output$Plot <- renderPlot(ggplot()+
                                                   geom_line(data = as.data.frame(date[2:34]),
                                                             aes(x= Data[c(2:34),4] , y= proftrend,
                                                                 group = 1))+
                                                   xlab("Dates")+ ylab("Profit Trend")+
                                                   theme(axis.text.x = element_text(angle = 90)

But i want something like the color depends upon the slope of the line. Like if the slope is positive it should be green and red if negative. Also something like heat, where color on the value of slope. like

-6 <- maroon

-1 <- red

0 <- white

1 <- red

6 <- dark green Is there a way to do so? My data is like

enter image description here

So more the profit (income - expenditure) more dense the colour?

The complete code is

library(shiny)
library(ggplot2)
ui <- fluidPage(
  titlePanel("Creating a database"),
  sidebarLayout(
    sidebarPanel(
      textInput("name", "Company Name"),
      numericInput("income", "Income", value = 1),
      numericInput("expenditure", "Expenditure", value = 1),
      dateInput("date", h3("Date input"),value = Sys.Date() ,min = "0000-01-01",
                max = Sys.Date(), format = "dd/mm/yy"),
      actionButton("Action", "Submit"),#Submit Button
      actionButton("new", "New")),

    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Table", tableOutput("table")),
                  tabPanel("Download",
                           textInput("filename", "Enter Filename for download"),   #filename
                           helpText(strong("Warning: Append if want to update existing data.")),
                           downloadButton('downloadData', 'Download'), #Button to save the file
                           downloadButton('Appenddata', 'Append')),#Button to update a file )
                  tabPanel("Plot", 
                           actionButton("filechoose", "Choose File"),
                           br(),
                           selectInput("toplot", "To Plot", choices =c("Income" = "inc",
                                                                       "Expenditure" = "exp",
                                                                       "Compare Income And 
                                                                       Expenditure" = "cmp",
                                                                       "Gross Profit" = "gprofit",
                                                                       "Net Profit" = "nprofit",
                                                                       "Profit Lost" = "plost",
                                                                       "Profit Percent" = "pp",
                                                                       "Profit Trend" = "proftrend"

                           )),
                           actionButton("plotit", "PLOT"),
                           plotOutput("Plot")
                  )
      )

    )
  )
)
# Define server logic required to draw a histogram
server <- function(input, output){
  #Global variable to save the data
  Data <- data.frame()
  Results <- reactive(data.frame(input$name, input$income, input$expenditure,
                                 as.character(input$date),
                                 as.character(Sys.Date())))

  #To append the row and display in the table when the submit button is clicked
  observeEvent(input$Action,{
    Data <<- rbind(Data,Results()) #Append the row in the dataframe
    output$table <- renderTable(Data) #Display the output in the table
  })

  observeEvent(input$new, {
    Data <<- NULL
    output$table <- renderTable(Data)
  })

  observeEvent(input$filechoose, {
    Data <<- read.csv(file.choose()) #Choose file to plot
    output$table <- renderTable(Data) #Display the choosen file details
  })

  output$downloadData <- downloadHandler(
    filename = function() {
      paste(input$filename , ".csv", sep="")}, # Create the download file name
    content = function(file) {
      write.csv(Data, file,row.names = FALSE) # download data
    })

  output$Appenddata <- downloadHandler(
    filename = function() {
      paste(input$filename, ".csv", sep="")}, 
    content = function(file) {
      write.table( Data, file=file.choose(),append = T, sep=',',
                   row.names = FALSE, col.names = FALSE) # Append data in existing
    })

  observeEvent(input$plotit, {
    inc <- c(Data[ ,2]) 
    exp <- c(Data[ ,3]) 
    date <- c(Data[,4])
    gprofit <- c(Data[ ,3]- Data[ ,2])
    nprofit <- c(gprofit - (gprofit*0.06))
    plost <- gprofit - nprofit
    pp <- (gprofit/inc) * 100
    proftrend <- c(gprofit[2:34]-gprofit[1:33])
    y = input$toplot
    switch(EXPR = y ,
           inc = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= inc))+
                                             geom_bar(stat = "identity",
                                                      fill = "blue")+xlab("Dates")+
                                             ylab("Income")+
                                             theme(axis.text.x = element_text(angle = 90))),
           exp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= exp))+
                                             geom_bar(stat = "identity",
                                                      fill = "red")+xlab("Dates")+
                                             ylab("Expenditure")+
                                             theme(axis.text.x = element_text(angle = 90))),

           cmp = output$Plot <- renderPlot(ggplot()+
                                             geom_line(data = Data, aes(x= Data[,4], y= inc,
                                                                        group = 1), col = "green")
                                           + geom_line(data = Data, aes(x= Data[,4], y= exp, 
                                                                        group =1), col = "red")+
                                             xlab("Dates")+ ylab("Income (in lakhs)")+
                                             theme(axis.text.x = element_text(angle = 90))),

           gprofit = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= gprofit))+
                                                 geom_bar(stat = "identity",
                                                          fill = "blue")+xlab("Dates")+
                                                 ylab("Gross Profit (in lakhs)")+
                                                 theme(axis.text.x = element_text(angle = 90))),

           nprofit =  output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= nprofit))
                                                +geom_bar(stat = "identity",
                                                          fill = "blue")+xlab("Dates")+
                                                  ylab("Net Profit (in lakhs)")+
                                                  theme(axis.text.x = element_text(angle = 90))),

           plost =  output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= plost))
                                              +geom_bar(stat = "identity",
                                                        fill = "blue")+xlab("Dates")+
                                                ylab("Profit Lost (in lakhs)")+
                                                theme(axis.text.x = element_text(angle = 90))),

           pp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= pp))+
                                            geom_bar(stat = "identity",
                                                     fill = "blue")+xlab("Dates")+
                                            ylab("Profit Percentage")+
                                            theme(axis.text.x = element_text(angle = 90))),
           proftrend = output$Plot <- renderPlot(ggplot()+
                                                   geom_line(data = as.data.frame(date[2:34]),
                                                             aes(x= Data[c(2:34),4] , y= proftrend,
                                                                 group = 1))+
                                                   xlab("Dates")+ ylab("Profit Trend")+
                                                   theme(axis.text.x = element_text(angle = 90))
           )
    )
  }
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

Please help. Thank You.

rahul yadav
  • 432
  • 3
  • 20
  • 1
    In order to make it easier for others to help you, consider including a [minimal reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example). – Mikko Marttila Jul 05 '18 at 12:45
  • You can use `geom_segment()` after doing some manipulations like [this](https://stackoverflow.com/questions/35039846/change-line-color-depending-on-y-value-with-ggplot2) – Michael Bird Jul 05 '18 at 12:49
  • 5
    It seems like this question is not related to `shiny` per se - i.e. make a 'clean' `ggplot` example with just enough complexity to demonstrate your issue, not more, not less (5-10 data points?) – Henrik Jul 05 '18 at 12:50

1 Answers1

1

Make the changes based on @Henrik but however create a function to calculate slope and then call it as

color = slope > 0

Your complete code as :-

library(shiny)
library(ggplot2)
ui <- fluidPage(
  titlePanel("Creating a database"),
  sidebarLayout(
    sidebarPanel(
      textInput("name", "Company Name"),
      numericInput("income", "Income", value = 1),
      numericInput("expenditure", "Expenditure", value = 1),
      dateInput("date", h3("Date input"),value = Sys.Date() ,min = "0000-01-01",
                max = Sys.Date(), format = "dd/mm/yy"),
      actionButton("Action", "Submit"),#Submit Button
      actionButton("new", "New")),

    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Table", tableOutput("table")),
                  tabPanel("Download",
                           textInput("filename", "Enter Filename for download"),   #filename
                           helpText(strong("Warning: Append if want to update existing data.")),
                           downloadButton('downloadData', 'Download'), #Button to save the file
                           downloadButton('Appenddata', 'Append')),#Button to update a file )
                  tabPanel("Plot", 
                           actionButton("filechoose", "Choose File"),
                           br(),
                           selectInput("toplot", "To Plot", choices =c("Income" = "inc",
                                                                       "Expenditure" = "exp",
                                                                       "Compare Income And 
                                                                       Expenditure" = "cmp",
                                                                       "Gross Profit" = "gprofit",
                                                                       "Net Profit" = "nprofit",
                                                                       "Profit Lost" = "plost",
                                                                       "Profit Percent" = "pp",
                                                                       "Profit Trend" = "proftrend"

                           )),
                           actionButton("plotit", "PLOT"),
                           plotOutput("Plot")
                  )
      )

    )
  )
)
# Define server logic required to draw a histogram
server <- function(input, output){
  #Global variable to save the data
  Data <- data.frame()
  Results <- reactive(data.frame(input$name, input$income, input$expenditure,
                                 as.character(input$date),
                                 as.character(Sys.Date())))

  #To append the row and display in the table when the submit button is clicked
  observeEvent(input$Action,{
    Data <<- rbind(Data,Results()) #Append the row in the dataframe
    output$table <- renderTable(Data) #Display the output in the table
  })

  observeEvent(input$new, {
    Data <<- NULL
    output$table <- renderTable(Data)
  })

  observeEvent(input$filechoose, {
    Data <<- read.csv(file.choose()) #Choose file to plot
    output$table <- renderTable(Data) #Display the choosen file details
  })

  output$downloadData <- downloadHandler(
    filename = function() {
      paste(input$filename , ".csv", sep="")}, # Create the download file name
    content = function(file) {
      write.csv(Data, file,row.names = FALSE) # download data
    })

  output$Appenddata <- downloadHandler(
    filename = function() {
      paste(input$filename, ".csv", sep="")}, 
    content = function(file) {
      write.table( Data, file=file.choose(),append = T, sep=',',
                   row.names = FALSE, col.names = FALSE) # Append data in existing
    })

  observeEvent(input$plotit, {
    inc <- c(Data[ ,2]) 
    exp <- c(Data[ ,3]) 
    date <- c(Data[,4])
    gprofit <- c(Data[ ,3]- Data[ ,2])
    nprofit <- c(gprofit - (gprofit*0.06))
    plost <- gprofit - nprofit
    pp <- (gprofit/inc) * 100
    proftrend <- c(gprofit[2:34]-gprofit[1:33])
    slope = c(((proftrend[2:33]-proftrend[1:32])/1),0)
    y = input$toplot
    switch(EXPR = y ,
           inc = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= inc))+
                                             geom_bar(stat = "identity",
                                                      fill = "blue")+xlab("Dates")+
                                             ylab("Income")+
                                             theme(axis.text.x = element_text(angle = 90))),
           exp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= exp))+
                                             geom_bar(stat = "identity",
                                                      fill = "red")+xlab("Dates")+
                                             ylab("Expenditure")+
                                             theme(axis.text.x = element_text(angle = 90))),

           cmp = output$Plot <- renderPlot(ggplot()+
                                             geom_line(data = Data, aes(x= Data[,4], y= inc,
                                                                        group = 1), col = "green")
                                           + geom_line(data = Data, aes(x= Data[,4], y= exp, 
                                                                        group =1), col = "red")+
                                             xlab("Dates")+ ylab("Income (in lakhs)")+
                                             theme(axis.text.x = element_text(angle = 90))),

           gprofit = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= gprofit))+
                                                 geom_bar(stat = "identity",
                                                          fill = "blue")+xlab("Dates")+
                                                 ylab("Gross Profit (in lakhs)")+
                                                 theme(axis.text.x = element_text(angle = 90))),

           nprofit =  output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= nprofit))
                                                +geom_bar(stat = "identity",
                                                          fill = "blue")+xlab("Dates")+
                                                  ylab("Net Profit (in lakhs)")+
                                                  theme(axis.text.x = element_text(angle = 90))),

           plost =  output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= plost))
                                              +geom_bar(stat = "identity",
                                                        fill = "blue")+xlab("Dates")+
                                                ylab("Profit Lost (in lakhs)")+
                                                theme(axis.text.x = element_text(angle = 90))),

           pp = output$Plot <- renderPlot(ggplot(data = Data, aes(x= Data[,4], y= pp))+
                                            geom_bar(stat = "identity",
                                                     fill = "blue")+xlab("Dates")+
                                            ylab("Profit Percentage")+
                                            theme(axis.text.x = element_text(angle = 90))),
           proftrend = output$Plot <- renderPlot(ggplot()+
                                                   geom_line(data = as.data.frame(date[2:34]),
                                                             aes(x= Data[c(2:34),4] , y= proftrend,
                                                                 group = 1, color = slope > 0))+
                                                   xlab("Dates")+ ylab("Profit Trend")+
                                                   theme(axis.text.x = element_text(angle = 90))
           )
    )
  }
  )
}

# Run the application 
shinyApp(ui = ui, server = server)
mrigank shekhar
  • 544
  • 3
  • 15