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

Question

我需要根据数据是增加还是减少来更改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'。 我在这里找到了这段代码。 换句话说，如果在增量列中行为“ 0,1,0”，我不希望“ 1”更改颜色，因为它后面是“ 0”，这意味着总体数据仍然减少，反之亦然。

我需要代码（即增量行“ 0”和“ 1”）和图形上的条形颜色仅在接下来的两个温度更高（“ 0,1,1”）或更低（“ 1,0”）时才更改，0'），而不是正在分析的温度，以防止温度的随机波动在不需要它们时为我提供不同的颜色。 在图上，当温度升高时，会有一个随机的彩色条，因为前面的条在技术上低于被分析的条，因为此刻，它仅与单个温度进行比较。 这也发生在图表的递减侧-由于前一温度高于被分析的温度，因此存在随机的彩色条。

我对r相当陌生，我无法弄清楚下一步需要做什么才能使图表清晰。 如果有一种方法可以覆盖“ 0,1,0”，或将“ 1”更改为“ 0”，以使颜色保持不变。 提前致谢。

Answer 1

这是您要尝试执行的操作：

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：我添加了一个循环，以删除由至少两天的相反趋势围绕的单个趋势反转，并将其重置为相反趋势。

# 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

我不确定这是否是分析数据的好方法，但是您用这句话表达的方式将是一种解决方案：

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