基于线的斜率的线颜色
我想创建一个用于财务分析的应用程序，我已经准备好代码，但是
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 <-栗色
-1 <-红色
0 <-白色
1 <-红色
6 <-深绿色 有办法吗？我的数据就像
那么，利润（收入-支出）越多，颜色就越浓密？
完整的代码是
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 :(得分：1)
基于@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)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？