基於數據增加/減少的條形顏色變化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