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

Question

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

我期待看到this question有一点帮助，但颜色继续默认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'。

我需要代码（即delta行'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)) 

UPDATE 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