Цвет линии в зависимости от наклона линии - PullRequest
0 голосов
/ 05 июля 2018

Я хочу создать приложение для финансового анализа, у меня есть готовый код, но

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)

Но я хочу, чтобы что-то вроде цвета зависело от наклона линии. Например, если уклон положительный, он должен быть зеленым и красным, если отрицательный. Также что-то вроде жары, где цвет по значению наклона. как

-6 <- бордовый </p>

-1 <- красный </p>

0 <- белый </p>

1 <- красный </p>

6 <- темно-зеленый Есть ли способ сделать это? Мои данные как </p>

enter image description here

Так чем больше прибыль (доход - расход) тем плотнее цвет?

Полный код

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)

Пожалуйста, помогите. Спасибо.

1 Ответ

0 голосов
/ 06 июля 2018

Внесите изменения, основанные на @Henrik, но, тем не менее, создайте функцию для вычисления наклона и затем вызовите ее как

color = slope > 0

Ваш полный код: -

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)
...