基于数据r的增加/减少的条形颜色变化ggplot

Question

I need to change the color of the bars in a ggplot bar graph based on if the data is increasing or decreasing.

I have looked to this question that helped a little, but the colors are continuing to default ggplot's colors, so the bar graphs come out weird when compared to what I wanted and to what the legend says they are.

b<- data.frame(day=c('05/22','05/23','05/24','05/25','05/26','05/27','05/28','05/29','05/30','05/31','06/01','06/02','06/03','06/04','06/05','06/06','06/07','06/08','06/09','06/10','06/11','06/12','06/13','06/14','06/15','06/16','06/17','06/18','06/19','06/20','06/21','06/22','06/23','06/24','06/25'),temp.diff=c(10.1,8.7,11.4,11.4,11.6,10.7,9.6,11.0,10.0,10.7,9.5,10.3,8.4,9.0,10.3,11.3,12.7,14.5,12.5,13.2,16.5,19.1,14.6,14.0,15.3,13.0,10.1,8.4,4.6,4.3,4.7,2.7,1.6,1.8,1.9))

delta<- (sign(diff(b$temp.diff)) == 1 ) + 0
delta<-as.data.table(delta)
delta<-rbind(delta,data.frame(delta=0))
b$delta<-delta

l <- max(b$temp.diff)
q<-  b[!is.na(b$delta) & b$delta == 1, 'color'] <- 'green'
w<-  b[!is.na(b$delta) & b$delta == 0, 'color'] <- 'red'
r <-   b[!is.na(b$temp.diff) & (b$temp.diff) == l, 'color'] <-'purple'


gg <- ggplot(b, aes(x=day, y=temp.diff, fill=color)) + geom_bar(stat='identity', position='identity')
gg1 <- gg + annotate ('line', ymin=-5)
gg2 <- gg + labs( x='Date', y='Mean Temp Diff')

gg

The graph looks like a normal distribution curve. The legend titles on the graph don't match up with the bar colors. I don't understand why it it doing this. The code posted above is a step towards my goal, but not meeting it fully. 'Delta' is used to determine if the temperature following the one being analyzed is of higher or lower temperature. If it is lower, 'delta' gives it a binary '0', while if it is higher, 'delta' gives it a binary '1'. I found this code here . In other words, if in the delta column, the rows are '0,1,0', I don't want the '1' to change colors because it is followed by a '0', meaning that the overall data is still decreasing, and vice versa for the '1'.

I need the code (ie delta rows '0' and '1') and the bar colors on the graph to only change if the the next two temperatures are higher ('0,1,1') or lower ('1,0,0') than the one it is analyzing, in order to keep random fluctuations of temperature from giving me different colors when they are not needed. On the graph, when it is increasing in temperature, there is a random colored bar because the preceding bar is technically lower than the one being analyzed because at the moment, it is only comparing it with a single temperature following it. This happens for the decreasing side of the graph as well--there is a random colored bar because the preceding temperature is higher than the one being analyzed.

I am fairly new to r, and I can't figure out what I need to do next in order to get the graphs to come out clean. If there is a way to override the '0,1,0', or to change the '1' to a '0' in order for the colors to remain the same. Thanks in advance.

Answer 1

Is this what you were trying to do:

library(dplyr)

# Add column marking decreases/increase/no change from previous day
b$diff = c(0, sign(diff(b$temp.diff)))

# Add column marking length of decrease/increase run
b$runGroups = rep(1:length(rle(b$diff)[[1]]), rle(b$diff)[[1]])

# Add column with length of current run for each run
b = b %>% group_by(runGroups) %>% mutate(runLength=1:n())

# Add group
b$group=0
b$group[b$runLength >1 & b$diff == -1] = -1
b$group[b$runLength >1 & b$diff == 1] = 1

# Highlight runs of 2 or more day-over-day decreases/increases
gg <- ggplot(b, aes(x=day, y=temp.diff, fill=factor(group))) + 
  geom_bar(stat='identity', position='identity') +
  scale_fill_manual(values=c("red","grey70","blue"), 
                    labels=c(">= 2-day run of decreases","No runs",
                             ">= 2-day run of increases"),
                    name="") +
  #annotate ('line', ymin=-5) +
  labs( x='Date', y='Mean Temp Diff') +
  theme_bw() +
  theme(axis.text.x=element_text(angle=-90, vjust=0.5))

If you just want to color bars based on whether there was an increase or decrease from the previous day, then you can just work directly with your original b data frame, without any modifications:

# Plot day-over-day increase/decrease
gg1 <- ggplot(b, aes(x=day, y=temp.diff, fill=factor(c(0,sign(diff(temp.diff)))))) + 
  geom_bar(stat='identity', position='identity') +
  scale_fill_manual(values=c("red","grey70","blue"), 
                    labels=c("Decrease","No Change","Increase"),
                    name="") +
  #annotate ('line', ymin=-5) +
  labs( x='Date', y='Mean Temp Diff') +
  theme_bw() +
  theme(axis.text.x=element_text(angle=-90, vjust=0.5))

UPDATE 1: I added a loop to remove a single trend reversal surrounded by at least two-days of the opposite trend and reset it to the opposite trend.

# Mark trend up, down, or same
b$sign.diff = c(0,sign(diff(b$temp.diff)))

# Reverse trend sign in case of single-day reversals of +/- 2-day runs of the opposite trend
for (i in 3:(nrow(b)-2)) {
  if (all(b[c(i-2,i-1,i+1,i+2), "sign.diff"] == -b[i, "sign.diff"])) {
    b[i,"sign.diff"] = -b[i, "sign.diff"]
  }
}

# Plot day-over-day increase/decrease
gg2 <- ggplot(b, aes(x=day, y=temp.diff, fill=factor(sign.diff))) + 
  geom_bar(stat='identity', position='identity') +
  scale_fill_manual(values=c("red","grey70","blue"), 
                    labels=c("Decrease","No Change","Increase"),
                    name="") +
  #annotate ('line', ymin=-5) +
  labs( x='Date', y='Mean Temp Diff') +
  theme_bw() +
  theme(axis.text.x=element_text(angle=-90, vjust=0.5))

Answer 2

I'm not sure that this is a good way to analyse the data, but the way you phrased it this would be a solution:

b<- data.frame(day=c('05/22','05/23','05/24','05/25','05/26','05/27','05/28','05/29','05/30','05/31','06/01','06/02','06/03','06/04','06/05','06/06','06/07','06/08','06/09','06/10','06/11','06/12','06/13','06/14','06/15','06/16','06/17','06/18','06/19','06/20','06/21','06/22','06/23','06/24','06/25'),temp.diff=c(10.1,8.7,11.4,11.4,11.6,10.7,9.6,11.0,10.0,10.7,9.5,10.3,8.4,9.0,10.3,11.3,12.7,14.5,12.5,13.2,16.5,19.1,14.6,14.0,15.3,13.0,10.1,8.4,4.6,4.3,4.7,2.7,1.6,1.8,1.9))

next.day <- c( b$temp.diff[-1] ,NA )
nn.day <- c(b$temp.diff[- c(1,2) ] ,NA  ,NA )

d.next <- b$temp.diff - next.day
d.nn <- b$temp.diff - nn.day

up <- d.next<0 & d.nn <0
down <- d.next>0 & d.nn >0
neutral <- !up & !down

b$diff <- NA

b$diff[ up ] <- "up"
b$diff[ down ] <- "down"
b$diff[ neutral ] <- "neutral"
b$diff[ is.na(b$diff) ] <- "neutral"


gg <- ggplot(b, aes(x=day, y=temp.diff, fill=diff)) + 
  geom_bar(stat='identity', position='identity')
gg1 <- gg + annotate ('line', ymin=-5)
gg2 <- gg + labs( x='Date', y='Mean Temp Diff')


gg