web-dev-qa-db-ja.com

ggplot2で色を塗りつぶすためにテクスチャを追加する方法

現在、塗りつぶしにscale_brewer()を使用していますが、これらは(画面上およびカラープリンターを介して)色がきれいに見えますが、白黒プリンターを使用すると比較的均一にグレーとして印刷されます。オンラインで検索したggplot2ドキュメント。ただし、塗りつぶし色にテクスチャを追加することについては何も見ませんでした。公式のggplot2これを行う方法、または誰かが使用するハックを持っていますか?テクスチャとは、黒と白で印刷したときに塗りつぶしの色を区別する、斜めのバー、逆の斜めのバー、ドットパターンなどのことです。

86
rhh

ggplotはcolorbrewerパレットを使用できます。これらの一部は「コピー」に適しています。だからこのような何かがあなたのために働くでしょうか?

ggplot(diamonds, aes(x=cut, y=price, group=cut))+
geom_boxplot(aes(fill=cut))+scale_fill_brewer(palette="OrRd")

この場合、OrRdはcolorbrewer Webページにあるパレットです。 http://colorbrewer2.org/

コピーフレンドリー:これは、特定の配色が白黒のコピーに耐えることを示します。分岐スキームは正常にコピーできません。順次方式では、明度の違いを保持する必要があります。

33
Andreas

ちょっと皆さん、これは非常に基本的な方法でテクスチャの問題に対処するちょっとしたハックです:

ggplot2:Rを使用して、あるバーの境界線を他のバーよりも暗くする

編集:私はついに、ggplot2で少なくとも3種類の基本パターンを可能にするこのハックの簡単な例を示す時間を見つけました。コード:

Example.Data<- data.frame(matrix(vector(), 0, 3, dimnames=list(c(), c("Value", "Variable", "Fill"))), stringsAsFactors=F)

Example.Data[1, ] <- c(45, 'Horizontal Pattern','Horizontal Pattern' )
Example.Data[2, ] <- c(65, 'Vertical Pattern','Vertical Pattern' )
Example.Data[3, ] <- c(89, 'Mesh Pattern','Mesh Pattern' )


HighlightDataVert<-Example.Data[2, ]
HighlightHorizontal<-Example.Data[1, ]
HighlightMesh<-Example.Data[3, ]
HighlightHorizontal$Value<-as.numeric(HighlightHorizontal$Value)
Example.Data$Value<-as.numeric(Example.Data$Value)

HighlightDataVert$Value<-as.numeric(HighlightDataVert$Value)
HighlightMesh$Value<-as.numeric(HighlightMesh$Value)
HighlightHorizontal$Value<-HighlightHorizontal$Value-5
HighlightHorizontal2<-HighlightHorizontal
HighlightHorizontal2$Value<-HighlightHorizontal$Value-5
HighlightHorizontal3<-HighlightHorizontal2
HighlightHorizontal3$Value<-HighlightHorizontal2$Value-5
HighlightHorizontal4<-HighlightHorizontal3
HighlightHorizontal4$Value<-HighlightHorizontal3$Value-5
HighlightHorizontal5<-HighlightHorizontal4
HighlightHorizontal5$Value<-HighlightHorizontal4$Value-5
HighlightHorizontal6<-HighlightHorizontal5
HighlightHorizontal6$Value<-HighlightHorizontal5$Value-5
HighlightHorizontal7<-HighlightHorizontal6
HighlightHorizontal7$Value<-HighlightHorizontal6$Value-5
HighlightHorizontal8<-HighlightHorizontal7
HighlightHorizontal8$Value<-HighlightHorizontal7$Value-5

HighlightMeshHoriz<-HighlightMesh
HighlightMeshHoriz$Value<-HighlightMeshHoriz$Value-5
HighlightMeshHoriz2<-HighlightMeshHoriz
HighlightMeshHoriz2$Value<-HighlightMeshHoriz2$Value-5
HighlightMeshHoriz3<-HighlightMeshHoriz2
HighlightMeshHoriz3$Value<-HighlightMeshHoriz3$Value-5
HighlightMeshHoriz4<-HighlightMeshHoriz3
HighlightMeshHoriz4$Value<-HighlightMeshHoriz4$Value-5
HighlightMeshHoriz5<-HighlightMeshHoriz4
HighlightMeshHoriz5$Value<-HighlightMeshHoriz5$Value-5
HighlightMeshHoriz6<-HighlightMeshHoriz5
HighlightMeshHoriz6$Value<-HighlightMeshHoriz6$Value-5
HighlightMeshHoriz7<-HighlightMeshHoriz6
HighlightMeshHoriz7$Value<-HighlightMeshHoriz7$Value-5
HighlightMeshHoriz8<-HighlightMeshHoriz7
HighlightMeshHoriz8$Value<-HighlightMeshHoriz8$Value-5
HighlightMeshHoriz9<-HighlightMeshHoriz8
HighlightMeshHoriz9$Value<-HighlightMeshHoriz9$Value-5
HighlightMeshHoriz10<-HighlightMeshHoriz9
HighlightMeshHoriz10$Value<-HighlightMeshHoriz10$Value-5
HighlightMeshHoriz11<-HighlightMeshHoriz10
HighlightMeshHoriz11$Value<-HighlightMeshHoriz11$Value-5
HighlightMeshHoriz12<-HighlightMeshHoriz11
HighlightMeshHoriz12$Value<-HighlightMeshHoriz12$Value-5
HighlightMeshHoriz13<-HighlightMeshHoriz12
HighlightMeshHoriz13$Value<-HighlightMeshHoriz13$Value-5
HighlightMeshHoriz14<-HighlightMeshHoriz13
HighlightMeshHoriz14$Value<-HighlightMeshHoriz14$Value-5
HighlightMeshHoriz15<-HighlightMeshHoriz14
HighlightMeshHoriz15$Value<-HighlightMeshHoriz15$Value-5
HighlightMeshHoriz16<-HighlightMeshHoriz15
HighlightMeshHoriz16$Value<-HighlightMeshHoriz16$Value-5
HighlightMeshHoriz17<-HighlightMeshHoriz16
HighlightMeshHoriz17$Value<-HighlightMeshHoriz17$Value-5

ggplot(Example.Data, aes(x=Variable, y=Value, fill=Fill)) + theme_bw() + #facet_wrap(~Product, nrow=1)+ #Ensure theme_bw are there to create borders
  theme(legend.position = "none")+
  scale_fill_grey(start=.4)+
  #scale_y_continuous(limits = c(0, 100), breaks = (seq(0,100,by = 10)))+
  geom_bar(position=position_dodge(.9), stat="identity", colour="black", legend = FALSE)+
  geom_bar(data=HighlightDataVert, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.80)+
geom_bar(data=HighlightDataVert, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.60)+  
  geom_bar(data=HighlightDataVert, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.40)+
  geom_bar(data=HighlightDataVert, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.20)+
  geom_bar(data=HighlightDataVert, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.0) +
  geom_bar(data=HighlightHorizontal, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal2, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal3, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal4, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal5, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal6, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal7, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightHorizontal8, position=position_dodge(.9), stat="identity", colour="black", size=.5)+
  geom_bar(data=HighlightMesh, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.80)+
 geom_bar(data=HighlightMesh, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.60)+
  geom_bar(data=HighlightMesh, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.40)+
  geom_bar(data=HighlightMesh, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.20)+
  geom_bar(data=HighlightMesh, position=position_dodge(.9), stat="identity", colour="black", size=.5, width=0.0)+
  geom_bar(data=HighlightMeshHoriz, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
geom_bar(data=HighlightMeshHoriz2, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz3, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz4, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz5, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz6, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz7, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz8, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz9, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz10, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz11, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz12, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz13, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz14, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz15, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz16, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")+
  geom_bar(data=HighlightMeshHoriz17, position=position_dodge(.9), stat="identity", colour="black", size=.5, fill = "transparent")

これを生成します:

enter image description here

それは非常にきれいではありませんが、私が考えることができる唯一の解決策です。

ご覧のとおり、非常に基本的なデータを作成しています。垂直線を取得するには、データフレームを作成して変数を格納します。垂直線を追加して、グラフの境界線を複数回再描画し、そのたびに幅を減らします。

水平線についても同様のことが行われますが、対象の変数に関連付けられた値から値(この例では「5」)を引いた再描画ごとに新しいデータフレームが必要です。バーの高さを効果的に下げる。これを達成するには不格好であり、より合理化されたアプローチがあるかもしれませんが、これはそれを達成する方法を示しています。

メッシュパターンは両方の組み合わせです。最初に垂直線を描画し、次にfillfill='transparent'として設定する水平線を追加して、垂直線が描画されないようにします。

パターンの更新が行われるまで、これが役立つことを願っています。

編集2:

さらに、斜めのパターンも追加できます。データフレームに追加の変数を追加しました。

Example.Data[4,] <- c(20, 'Diagonal Pattern','Diagonal Pattern' )

次に、対角線の座標を保持する新しいデータフレームを作成しました。

Diag <- data.frame(
  x = c(1,1,1.45,1.45), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y = c(0,0,20,20),
  x2 = c(1.2,1.2,1.45,1.45), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y2 = c(0,0,11.5,11.5),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  x3 = c(1.38,1.38,1.45,1.45), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y3 = c(0,0,3.5,3.5),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  x4 = c(.8,.8,1.26,1.26), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y4 = c(0,0,20,20),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  x5 = c(.6,.6,1.07,1.07), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y5 = c(0,0,20,20),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  x6 = c(.555,.555,.88,.88), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y6 = c(6,6,20,20),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  x7 = c(.555,.555,.72,.72), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y7 = c(13,13,20,20),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  x8 = c(.8,.8,1.26,1.26), # 1st 2 values dictate starting point of line. 2nd 2 dictate width. Each whole = one background grid
  y8 = c(0,0,20,20),# inner 2 values dictate height of horizontal line. Outer: vertical Edge lines.
  #Variable = "Diagonal Pattern",
  Fill = "Diagonal Pattern"
  )

そこから上記のggplotにgeom_pathsを追加し、それぞれが異なる座標を呼び出し、目的のバーの上に線を描画します。

+geom_path(data=Diag, aes(x=x, y=y),colour = "black")+  # calls co-or for sig. line & draws
  geom_path(data=Diag, aes(x=x2, y=y2),colour = "black")+  # calls co-or for sig. line & draws
  geom_path(data=Diag, aes(x=x3, y=y3),colour = "black")+
  geom_path(data=Diag, aes(x=x4, y=y4),colour = "black")+
  geom_path(data=Diag, aes(x=x5, y=y5),colour = "black")+
  geom_path(data=Diag, aes(x=x6, y=y6),colour = "black")+
  geom_path(data=Diag, aes(x=x7, y=y7),colour = "black")

これにより、次の結果が得られます。

enter image description here

線を完全に角度をつけて間隔を空けるのにあまり時間をかけなかったので、少しずさんですが、これは概念実証として役立つはずです。

明らかに、ラインは反対方向に傾く可能性があり、水平および垂直メッシュと同様に、斜めメッシュの余地もあります。

私はパターンの面で私が提供できるすべてについてだと思います。誰かがその用途を見つけられることを願っています。

編集3:有名な最後の言葉。別のパターンオプションを考えました。今回はgeom_jitterを使用します。

再度、データフレームに別の変数を追加しました。

Example.Data[5,] <- c(100, 'Bubble Pattern','Bubble Pattern' )

そして、各パターンの表示方法を注文しました。

Example.Data$Variable = Relevel(Example.Data$Variable, ref = c("Diagonal Pattern", "Bubble Pattern","Horizontal Pattern","Mesh Pattern","Vertical Pattern"))

次に、x軸上の目的のターゲットバーに関連付けられた番号を含む列を作成しました。

Example.Data$Bubbles <- 2

「バブル」のy軸上の位置を含む列が続きます。

Example.Data$Points <- c(5, 10, 15, 20, 25)
Example.Data$Points2 <- c(30, 35, 40, 45, 50)
Example.Data$Points3 <- c(55, 60, 65, 70, 75)
Example.Data$Points4 <- c(80, 85, 90, 95, 7)
Example.Data$Points5 <- c(14, 21, 28, 35, 42)
Example.Data$Points6 <- c(49, 56, 63, 71, 78)
Example.Data$Points7 <- c(84, 91, 98, 6, 12)

最後に、「ポイント」を配置して再利用して「バブル」のサイズを変更するための新しい列を使用して、上記のggplotにgeom_jittersを追加しました。

+geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points3, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points4, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points3, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points4, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points5, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points5, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points6, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points6, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points7, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points7, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points3, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points4, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points3, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points4, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points2, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points5, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points5, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points6, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points6, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points7, size=Points), alpha=.5)+
  geom_jitter(data=Example.Data,aes(x=Bubbles, y=Points7, size=Points), alpha=.5)

プロットを実行するたびに、ジッターは「バブル」を異なる位置に配置しますが、次のような優れた出力があります。

enter image description here

ときどき「バブル」が境界の外側で揺れます。これが発生した場合は、再実行するか、単により大きな次元でエクスポートしてください。必要に応じて、より多くのバブルをy軸の各増分にプロットして、より多くの空白スペースを埋めることができます。

これにより、ggplotでハッキングできる最大7つのパターンが作成されます(反対の斜線と両方の斜線メッシュを含める場合)。

誰かが何かについて考えることができるならば、もっと提案してください。

編集4:ggplot2のハッチング/パターンを自動化するラッパー関数に取り組んでいます。関数を拡張してfacet_gridプロットなどのパターンを許可したら、リンクを投稿します。例として、バーの単純なプロットの関数入力を使用した出力を示します。

enter image description here

関数を共有する準備ができたら、最後の編集を追加します。

編集5: リンクはこちら geom_barプロットにパターンを追加するプロセスを少し簡単にするために書いた関数EggHatchへ。

79
Docconcoct

グリッド(ggplot2が実際の描画を行うために使用するグラフィックシステム)はテクスチャをサポートしていないため、現在は不可能です。ごめんなさい!

66
hadley

- ggtexturesパッケージは @ claus wilke テクスチャ付きの長方形とバーをggplot2で描画します。

# Image/pattern randomly selected from README
path_image <- "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg"

library(ggplot2)
# devtools::install_github("clauswilke/ggtextures")
ggplot(mtcars, aes(cyl, mpg)) + 
  ggtextures::geom_textured_bar(stat = "identity", image = path_image)

enter image description here

他のgeomと組み合わせることもできます:

data_raw <- data.frame(x = round(rbinom(1000, 50, 0.1)))
ggplot(data_raw, aes(x)) +
  geom_textured_bar(
    aes(y = ..prop..), image = path_image
  ) +
  geom_density()

enter image description here

9
PoGibas

Docconcoct 仕事は素晴らしいと思いますが、今では突然特別なパッケージをグーグルで検索しました--- Patternplot 。内部コードは表示されませんでしたが、ビネットは便利なようです。

3
UlvHare

輪郭が「テクスチャ」に対応するダミーデータフレームを作成してから、geom_contourを使用すると便利です。これが私の例です:

library(ggplot2)

eg = expand.grid(R1 = seq(0,1,by=0.01), R2 = seq(0,1,by=0.01))
     eg$importance = (eg$R1+eg$R2)/2

  ggplot(eg , aes(x = R1, y = R2)) +
  geom_raster(aes(fill = importance), interpolate=TRUE) +
  scale_fill_gradient2(low="white", high="gray20", limits=c(0,1)) +
  theme_classic()+
  geom_contour(bins=5,aes(z=importance), color="black", size=0.6)+
  coord_fixed(ratio = 1, xlim=c(0,1),ylim=c(0,1))

結果は次のとおりです。 線付きの陰影付きプロット

(線を滑らかにする必要があります)

1
Ondrej Vencalek

これは、@ Docconcoct(5回編集されたもの)が残した投稿へのフォローアップの質問です。

以下の比較的小さい再現可能な例は、作成したいプロットへの2つのアプローチを示しています。最初はggplotを使用しますが、不完全です。以下で生成される2番目のプロットは、ベースRグラフィックスを使用し、完全です。 ggplotを使用して2番目のプロットに示されていることを達成する方法はありますか? Docconcoctのアプローチを追おうとするのはまったくもって失われました。

library(ggplot2)

dat <- read.table(textConnection("wrDec scen src       value
43  1850   1C  gw    39.34253
49  1850   2C  gw    87.24263
55  1850   3C  gw   133.36214
61  1850   4C  gw   189.87629
67  1850   5C  gw   234.49438
7   1850   1C  sw  -332.00033
13  1850   2C  sw  -705.26090
19  1850   3C  sw -1109.10350
25  1850   4C  sw -1538.89468
31  1850   5C  sw -1941.11464
44  1860   1C  gw   161.65695
50  1860   2C  gw   337.63655
56  1860   3C  gw   537.13948
62  1860   4C  gw   720.46927
68  1860   5C  gw   928.40398
8   1860   1C  sw  -483.56331
14  1860   2C  sw -1006.67141
20  1860   3C  sw -1584.47668
26  1860   4C  sw -2167.01980
32  1860   5C  sw -2775.84317
45  1870   1C  gw    93.09717
51  1870   2C  gw   190.74712
57  1870   3C  gw   295.68164
63  1870   4C  gw   391.21511
69  1870   5C  gw   495.22644
9   1870   1C  sw  -378.80846
15  1870   2C  sw  -785.45633
21  1870   3C  sw -1205.84678
27  1870   4C  sw -1644.12112
33  1870   5C  sw -2077.68337
46  1880   1C  gw    29.61092
52  1880   2C  gw    60.59267
58  1880   3C  gw    95.47988
64  1880   4C  gw   132.15479
70  1880   5C  gw   171.48976
10  1880   1C  sw  -210.97875
16  1880   2C  sw  -428.38672
22  1880   3C  sw  -682.01563
28  1880   4C  sw  -943.77363
34  1880   5C  sw -1213.56345
47  1890   1C  gw    12.29025
53  1890   2C  gw    24.11237
59  1890   3C  gw    36.90570
65  1890   4C  gw    50.74161
71  1890   5C  gw    66.29961
11  1890   1C  sw  -476.12546
17  1890   2C  sw  -885.65743
23  1890   3C  sw -1328.05086
29  1890   4C  sw -1782.29492
35  1890   5C  sw -2241.68459
48 1900+   1C  gw    19.06018
54 1900+   2C  gw    38.51153
60 1900+   3C  gw    60.85222
66 1900+   4C  gw    81.35425
72 1900+   5C  gw   105.22905
12 1900+   1C  sw  -264.40595
18 1900+   2C  sw  -504.66240
24 1900+   3C  sw  -808.04811
30 1900+   4C  sw -1136.96551
36 1900+   5C  sw -1539.09301"), header=TRUE)

ggplot(data=dat, aes(x=scen, y=value, fill=src)) + 
  geom_bar(stat="identity") + 
  facet_grid(~wrDec) + 
  ylab(expression(paste('Change in Average Annual Delivered Water,  ',ac%.%ft,sep='')))


# Base Graphics approach
# ----------------------
dev.new()
gwUse_chng <- matrix(subset(dat, dat$src=='gw')$value,
                       nrow = 5, ncol = 6, byrow = FALSE,
                       dimnames = list(c('1_deg', '2_deg', '3_deg', '4_deg', '5_deg'),
                                       c('1850','1860','1870','1880','1890','1900+')))

swUse_chng <- matrix(subset(dat, dat$src=='sw')$value,
                       nrow = 5, ncol = 6, byrow = FALSE,
                       dimnames = list(c('1_deg', '2_deg', '3_deg', '4_deg', '5_deg'),
                                       c('1850','1860','1870','1880','1890','1900+')))

net_chng <- swUse_chng + gwUse_chng


par(mar=c(3,6,1,0.5))
barplot(gwUse_chng, beside=TRUE, las=1, yaxt='n', yaxs='i', ylim=c(-3000, 1000), col='lightblue')
par(new=TRUE)
barplot(swUse_chng, beside=TRUE, las=1, yaxt='n', yaxs='i', ylim=c(-3000, 1000), col='mistyrose')
par(new=TRUE)
barplot(net_chng, beside=TRUE, las=1, yaxt='n', yaxs='i', ylim=c(-3000, 1000), col='black', ang=135, den=15)
legend("bottomleft", c('Groundwater','Surface-water','Net'), 
       fill=c('lightblue','mistyrose','black'), ang=c(NA,NA,135), den=c(NA,NA,25), bty='n', bg='white')
axis(side=2, at=seq(-3000,1000,by=500), labels=c('-3,000','-2,500','-2,000','-1,500','-1,000','-500','0','500','1,000'),las=1)
abline(h=0, lwd=1)
abline(v=seq(6.5, 30.5,by=6), col='grey90')
abline(h=-3000, col='black')
0
user2256085