基于 increase/decrease 数据 r 的条形颜色变化 ggplot

Bar color change ggplot based on increase/decrease of data r

我需要根据数据是增加还是减少来更改 ggplot 条形图中条形的颜色。

我看过 有点帮助,但颜色继续默认 ggplot 的颜色,所以与我想要的和图例所说的相比,条形图显得很奇怪.

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

该图看起来像一条正态分布曲线。图表上的图例标题与条形颜色不匹配。我不明白为什么要这样做。上面发布的代码是朝着我的目标迈出的一步,但并未完全实现。 'Delta' 用于判断被分析温度之后的温度是高还是低。如果它较低,'delta' 给它一个二进制“0”,而如果它较高,'delta' 给它一个二进制“1”。我找到了这段代码 here。换句话说,如果在 delta 列中,行是 '0,1,0',我不希望 '1' 改变颜色,因为它后面跟着一个 '0',这意味着整体数据仍然减少,反之亦然'1'。

我需要代码(即增量行“0”和“1”)和图表上的条形颜色仅在下一个 两个 温度更高( '0,1,1') 或比它正在分析的更低 ('1,0,0'),以防止温度的随机波动在不需要时给我不同的颜色。在图表上,当温度升高时,有一个随机的彩色条,因为从技术上讲,前面的条低于正在分析的条,因为目前,它只是将它与后面的一个温度进行比较。这也发生在图表的下降侧——有一个随机的彩色条,因为前面的温度高于被分析的温度。

我是 r 的新手,我不知道接下来需要做什么才能让图表变得干净。如果有办法覆盖“0,1,0”,或将“1”更改为“0”以使颜色保持不变。提前致谢。

这是你想要做的吗:

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

如果您只想根据与前一天相比是增加还是减少来为条形图着色,那么您可以直接使用原始 b 数据框,无需任何修改:

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

更新 1: 我添加了一个循环以移除被至少 two-days 个相反趋势包围的单个趋势反转并将其重置为相反趋势。

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

我不确定这是分析数据的好方法,但按照你的措辞,这将是一个解决方案:

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