![[PukiWiki]](image/tomarufront.png "[PukiWiki]")
#author("2019-07-21T10:29:40+09:00","","") #contents * グラフ [#hb078894] ** 散布図を描く：plot() [#dbdabe75] RIGHT:21 March 2018 まずは plot というのが R のグラフ作成のキモらしい~ dataframe が複数のデータセットになっていると、ペアワイズの複数のグラフがプロットされる plot(mydf) # plot(mydf$Data1, mydf$Data2, cex = 0.5, # ドットサイズ 0.5倍 cex.lab = 0.8, # ラベル文字サイズ 0.8倍 cex.axis = 0.7, # 軸数値文字サイズ 0.7倍 xaxp = c(0.3,1,7), # X軸目盛を 0.3 から 1 まで、７分割＝目盛を8つ yaxp = c(0,60*60,6), # Y軸目盛を 0 から 3600 まで、6分割＝目盛を7つ xlim = c(0.3,1), # X軸を 0.3 から 1 まで ylim = c(0,60*60), # Y軸を 0 から 3600 まで xlab="Courtship Frequency", ylab="Courtship Latency (s)" ) ** 棒グラフ [#h194665b] *** 棒グラフ：barplot() [#w9d4b218] RIGHT:21 March 2018 barplot(copulationdata, cex.main=1.5, cex.lab=1.5, cex.axis=1.2, main="D. Copulation frequency (1 h)", ylim=c(0,100), ylab="Copulation (%)", las=2 ) *** 棒グラフに95%信頼限界の線分を加える：barplot() arrows() [#i312077f] RIGHT:21 March 2018 mybar <- barplot(mydf$CourtshipFreq, names=mydf$Factor1, main="Courtship", cex.main=2.5, cex.lab=1.6, las=2, ylab="Frequency (%)", ylim=c(0,100), axis.lty=1, xaxt="n" ) # xaxt="n"：X軸ラベルは barplot 関数で書かず #グラフに囲みを付ける box(lty=1) # 信頼限界（上）を描く arrows(mybar, mydf$CourtshipFreq, mybar, mydf$CourtCIH,angle=90,length=0,lwd=1) # 信頼限界（下）を描く arrows(mybar, mydf$CourtshipFreq, mybar, mydf$CourtCIL,angle=90,length=0,lwd=1) #length = 0.1 などとするとヒゲも付けられる # mybar <- barplot(mydf$CopulationFreq, names=mydf$Factor1, main="Copulation", cex.main=2.5, cex.lab=1.6, cex.names=0.8, las=2, ylab="Frequency (%)", ylim=c(0,100), axis.lty=1) # X軸ラベルを barplot 関数で書く # cex.names=0.8：X軸のフォントサイズの指定 0.8倍 # axis() で操作するときは、cex.axis=0.8 とするので違いに注意（わかりづらい……） # box(lty=1) arrows(mybar, mydf$CopulationFreq, mybar, mydf$CoplCIH,angle=90,length=0,lwd=1) arrows(mybar, mydf$CopulationFreq, mybar, mydf$CoplCIL,angle=90,length=0,lwd=1) ** 箱ヒゲ図（ボックスプロット）：boxplot() [#q689e1d4] RIGHT:21 March 2018 boxplot(mydf$data ~ mydf$cat, las=2, outline=F, main="Copulation Duration", cex.main=2.5, cex.lab=1.6, ylab="Copulation Duration (s)", xaxt="n") # las=2：軸ラベルの向き 2はそれぞれX、Y軸に対して垂直に（Xは↑、Yは→） # outline=F：外れ値を表示しない # xaxt="n"：X軸ラベルは boxplot 関数で書かず別途書き込み axis(side=1, at=c(1:mynumxaxis), label=mydf2$name, las=2, cex.axis=0.8) # label=mydf2$name 別な dataframe の文字列を X軸ラベルに利用 # label=F でラベル文字列を書かない ** boxplot に蜂群を重ねる：boxplot() beeswarm() [#h7d76c00] RIGHT:21 March 2018 par(oma=c(9,3,0,0)) # 余白を作る 下左上右 boxplot(mydf2$time~mydf2$cross, outline=FALSE, las=2, cex.main=1.5, cex.lab=1.5, cex.axis=1.2, main="C. Copulation latency", ylab="Copulation latency (min)", ylim=c(0,60), names=c("DATA1", "DATA2", "DATA2", "DATA3", "", "DATA4", "DATA5", "DATA6", "DATA7", "DATA8"), bty ="n ) # outline=F 外れ値を表示させない ← beeswarm と重ねるときは外れ値はまずい # las=2 軸の表示文字の向き X下から上へ、Yは横 # names = X軸の表示文字列を指定 # bty ="n" 枠線なし library(beeswarm) beeswarm(mydf2$time~mydf2$cross, method="center", pch = 16, corral="gutter", add = TRUE) *** 百分率表示する累積折れ線グラフ [#g2949dde] RIGHT:20 July 2019 参考：http://www.singularpoint.org/blog/r/r-plot-step-function/ パラメータは「...」としているので、 普通の plot()関数で指定できるものは（多分全て）使える # http://www.singularpoint.org/blog/r/r-plot-step-function/ # cumplot <- function(x,...){ # plot(sort(x),(1:length(x))/length(x),type="s",...) # } # mycumplot2 <- function(x, mymaxx, ...){ mynobs <- length(x) nona <- x[!is.na(x)] # NA があるときに対応する plot(c(0,sort(nona),mymaxx),(c(0,(1:length(nona))/mynobs,length(nona)/mynobs)*100),...) # type 指定は関数の外で行うために type="s" を除く＝デフォルト type="p" # 一番右をX軸の最大値（mymaxx）まで延ばす # (0,0) を追加し、原点と一番左のデータ点を繋ぐ } ** 複数の折れ線グラフ：matplot() [#l6bd89b8] RIGHT:21 March 2018 matplot( cbind( mydf$DATA1, mydf$DATA2, mydf$DATA3, mydf$DATA4, mydf$DATA5 ), cex.main=1.5, cex.lab=1.5, cex.axis=1.2, type="l",lwd=1, lty=1:5, ylim=range(0,100), col="black", las=1, bty ="n", # 枠線なし # bty ="l", # 枠線が左と下 ylab="Cumulated number of copulated pairs", xlab="Time (s)") ** 表示順指定：factor() [#k8d49c6d] RIGHT:21 March 2018 factor属性に levels引数を渡す~ c() はリストなので、順序の情報が含まれている~ → リストの順序が利用される仕組みになっている mydf2$cross <- factor(mydf2$cross, levels=c( "Data7", "Data2", "Data5", "Data3", ..., "Data1")) mydf2$cross <- factor(mydf2$cross, levels=Mylist) # Mylist が別にあるとき ** ダミーデータ追加 [#ce04aff0] RIGHT:21 March 2018 図を描くとき「空き」を作るためなどに~ 場合によっていは、名前の文字列は空白がいいのかもしれない （でもひとつしか空きは作れないはず） mydf2 <- rbind( mydf2, data.frame(cross="Dummy", time=NA)) ** グラフ領域の操作 [#bbb7d501] *** グラフの軸ラベルの向き：las= [#m37ac0b4] RIGHT:25 March 2018 las=0：それぞれX、Y軸に対して平行に（Xは→、Yは↑） las=1：X、Y軸とも全て水平に（Xは→、Yは→） las=2：それぞれX、Y軸に対して垂直に（Xは↑、Yは→） las=3：X、Y軸とも全て垂直に（Xは↑、Yは↑） *** グラフのラベルの文字サイズ：cex.***s= [#w212fd35] RIGHT:25 March 2018 デフォルトの○倍と指定 cex.main=2.5 # グラフタイトル cex.lab=1.6 # 軸ラベル（X軸、Y軸とも） cex.axis=1.2 # 軸目盛（X軸、Y軸とも） cex.names=0.8 # 棒グラフの横軸目盛（項目名）（Y軸目盛は cex.axis で指定） *** 太字、斜体の対応：substitute(paste()) italic() bold() bolditalic() [#c339acb2] RIGHT:21 March 2018 substitute と paste のコンビネーション なので、適用できない場面も多々ある~ グラフタイトルはおっけい title(main= substitute(paste( bold('A. '), bolditalic('D. melanogaster'), bold(' males')) ), cex.main=1.5, cex=1.5, ) *** ギリシャ文字などの対応：expression(paste()) [#v827f66a] RIGHT:20 July 2019 ギリシャ文字などの指定は、latex の数式モードでの指定と同じ綴りだけど、 「\（バックスラッシュ）」は不要~ 「^」 で上付き~ 「[]」 で下付き text(x=2, y=103, labels=expression(paste(chi[3]^2, "=7.129 ", italic('P'), "=0.067 NS")), cex=1.1, pos=3) *** グラフタイトルに変数を入れる：paste() [#ye194b75] RIGHT:21 March 2018 paste を使って文字列を結合すれば、変数がきちんと展開される~ italic などが使いたい場合は substitute() paste() list() を利用する title(main=paste("r", " = ", coefficient, ", ", "P", " = ", pvalue)) *** グラフタイトルに変数を入れる：太字、斜体の対応も必要な場合 substitute() paste() list() [#i92108fb] RIGHT:21 March 2018 substitute と paste のコンビネーション~ 関数 substitute(expr, env) は exprに変数が入っているだけでは展開しない~ そこで、env に適当な関数を入れて展開させる（計算もできる）~ 今回は単に数字に置き換えるだけなので、list() で対応した title( main=substitute( paste(italic("r"), " = ", mycoefficient, ", ", italic("P"), " = ", mypvalue), list(mycoefficient=coefficient, mypvalue=pvalue) ), cex=0.7 ) *** 軸ラベルの調整： [#y9d42d0a] RIGHT:24 March 2018 参考：http://uncorrelated.hatenablog.com/entry/20130708/1373256551 par(mgp=c(2.5, 1, 0)) # デフォルト par(mgp=c(3, 1, 0)) *** グラフ内に線分を描く：lines() [#j0f4e1df] RIGHT:21 March 2018 lines(X座標のベクトル, Y座標のベクトル)~ lines(点１,点２,点３)の形式ではないので注意 lines(c(3.5,5.4),c(95,95)) *** グラフ描画領域内に文字を書く：text() [#b5009860] RIGHT:21 March 2018 adj=c(0.5,0) # テキストをxy座標中央揃え、下揃え~ x 座標については、0 左揃え、0.5 中央揃え、1 右揃え らしい~ y 座標については、0 下揃え、0.5 中央揃え、1 上揃え らしい~ y 座標はデフォルトで上揃えなので、高さの異なるアルファベットが並ぶと、 ガタガタにならないよう下揃えにする text(x=1, y=61, labels="a", cex=1.1) text(x=2, y=61, labels="a", cex=1.1) text(x=3, y=61, labels="a", cex=1.1) text(x=4, y=61, labels="a", cex=1.1) # text(x=6, y=59.6, labels="ab", cex=1.1, adj=c(0.5,0)) text(x=7, y=59.6, labels="ab", cex=1.1, adj=c(0.5,0)) text(x=8, y=59.6, labels="a", cex=1.1, adj=c(0.5,0)) text(x=9, y=59.6, labels="b", cex=1.1, adj=c(0.5,0)) text(x=10, y=59.6, labels="b", cex=1.1, adj=c(0.5,0)) *** 軸ラベルの下に文字を書く：mtext() [#sd660c69] RIGHT:21 March 2018 描画領域のサイズが変わると位置が変わるので注意~ substitute(paste()) で、斜体、太字もできる mtext(text="Female", at=-1, padj=37, cex=1.2) mtext(text="Male", at=-1, padj=43, cex=1.2) mtext(text=substitute(paste(italic('D. melanogaster'))), at=3, padj=34, cex=1.2) mtext(text=substitute(paste(italic('D. sechellia'))), at=8, padj=42, cex=1.2) しかし~ これを使うより、領域外への描画を許可しておき （par(xpd=NA) や par(xpd=T) として）、 text() や lines() を使うほうが使いやすいと思う *** legend の操作 [#b69f1af5] RIGHT:21 March 2018 legend に title を付けることができる~ ほかにも色々できます~ https://stats.biopapyrus.jp/r/graph/legend.html~ https://symfoware.blog.fc2.com/blog-entry-1503.html~ legend("topleft", # 位置：座標指定もできる lty=1:5, # legendの中の線種 title="Female", # コレ bty ="n", # 枠線なし # cex = 0.8, # 文字サイズ 0.8倍 bg = "transparent", # 背景を透明に：色の指定ができる legend=c( "DATA1", "DATA2", "DATA3", "DATA4", "DATA5" ) ) *** 矩形の描画: rect() [#k57675b5] RIGHT:20 July 2019 rect(-95, 53.2, 60, 48.2) # 色：透過 rect(0, 0, 60, 48.2, col="gray") # 色：グレー # rect(x1,y1,x2,y2) *** 線分の描画: line() [#v90e69f1] RIGHT:20 July 2019 lines(c(0,1), c(4,3)) # lines(x,y) # x, y はベクトル *** グラデーションの灰色を算出: gray.colors() [#qea3ceeb] RIGHT:20 July 2019 gray.colors(4, start =0, end = 1) # [1] "#000000" "#9B9B9B" "#D4D4D4" "#FFFFFF" *** 色の指定 [#l9c66fa3] RIGHT:20 July 2019 色々な場面で、色の指定をするときに col="#000000" # 黒 col="#9B9B9B" col="#D4D4D4" col="#FFFFFF" # 白 col="yellow" # 黄色 ** 描画領域の操作 [#ff761483] *** 描画前のおまじない [#tbf2ca69] RIGHT:24 March 2018 ファイルへの書き込みのときはなくてもよい plot.new() *** 描画領域の分割 split.screen(c()) [#l7cfd9c7] RIGHT:24 March 2018 c(横, 縦) split.screen(c(3,2)) # ３列２行 *** 描画領域を更に分割 split.screen(c(*, *), screen = *) [#ybd9b064] RIGHT:24 March 2018 分割する画面を指定する split.screen(c(1,2), screen = 1) split.screen(c(2,2), screen = 2) *** 描画面の指定 screen() [#hff7e76f] RIGHT:24 March 2018 横向きに数が振られていく~ 再分割した場合は、更に数字が増える screen(1) # ココに 1 の描画内容を screen(6) # ココに 6 の描画内容を *** 描画画面の余白 par(oma=c(9,3,0,0)) [#u9cc9c99] RIGHT:24 March 2018 split.screen() と screen() の間に指定することで、外側に余白を作れる split.screen(c(3,5)) par(oma=c(9,3,0,0)) # 余白を作る 下左上右 screen(1) *** 描画領域内のマージンの指定：下左上右 par(mar=c()) [#ybc34c60] RIGHT:24 March 2018 参考：http://uncorrelated.hatenablog.com/entry/20130708/1373256551 par(mar=c(4, 4, 1.5, 0.5) + 0.1) # デフォルト par(mar=c(5, 4, 4, 2) + 0.1) *** 描画領域内のパラメータの取得 [#h1fb88d5] RIGHT:20 July 2019 デフォルトのグラフィックパラメタ（沢山！）を保存~ 本当はその時のパラメタだけど、R を起動して直ぐならデフォルトパラメタ~ デフォルトの値を使って描画領域内のマージンを指定できる defaultpar <- par(no.readonly=TRUE) par(mar=defaultpar$mar + c(4,0,1.28,0)) # マージンの追加 下左上右 *** 分割画面の外側の操作 [#i5146bc2] RIGHT:24 March 2018 split.screen(c(3,5)) par(oma=c(0,0,3,0)) # 総合表題のための余白を作る 下左上右 # par(cex.main = 2) # title(main = "My Big Title", outer=TRUE, line=1) title(main = "My Small Title", outer=TRUE, line=2) # line= は位置の指定、文字が大きくなると重なることがあるので調整が必要 # par(cex.main = 1) # 念のためサイズを戻す *** 領域外への描画・文字の書き込み par(xpd= ) [#s3969991] RIGHT:25 March 2018 par(xpd=NA) # 領域外への描画を許可 split.screen()の外側まで par(xpd=T) # グラフ描画領域外への描画を許可 screen()の内側まで # lines(c(0.8,7.2),c(-6,-6)) text(x=-4, y=-5, labels="Control", cex=1.2, pos=1) *** 分割後に描画が終わったときのおまじない close.screen() [#c84f0cb7] RIGHT:24 March 2018 split.screen(c(3,5)) # 画面分割後の操作をここに close.screen(all.screens=TRUE) *** グラフのプロットのマーカーの変更 [#l916dbf2] RIGHT:20 July 2019 # pch=0 四角□ # pch=1 丸○ # pch=2 三角△ # pch=3 十字＋ # pch=4 バツ× # pch=5 ダイヤ◇ # pch=6 逆三角▽ # pch=7 □に× # pch=8 ＋に× # pch=9 ◇に＋ # pch=10 ○に＋ # まだあるが…… ** 『「蜂群＋平均値」に折れ線グラフを重ねる』をふたつ重ねる [#l3f48207] RIGHT:2017年8月7日 - 横軸はカテゴリ - 一番左のカテゴリは少し性質が違うので、左からひとつめと左からふたつめをつなぐ折れ線は他と別の破線で - 『「蜂群＋平均値」に折れ線グラフを重ねる』をずらしてふたつ重ねる - 平均値はグラフ作成の途中で計算させる - 「ずらし」を沢山使うので、カテゴリを factor と score を使って振り分け &ref(beeswarmmeanplot.png); # DATA HERE # cat0 control0 <- c(3986, 4246, 5102, 4920, 6102) test0 <- c(3055, 2203, 2948, 3108, 5261) # # cat1 control1 <- c(1848, 434, 2072, 1786, 2642) test1 <- c(1220, 1185, 1702, 1212, 1515) # # cat2 control2 <- c(2981, 2217, 2880, 2962, 3764) test2 <- c(1138, 672, 3669, 472, 512) # # cat3 control3 <- c(1453, 2846, 2652, 1447, 2261) test3 <- c(1520, 2082, 1006, 1566, 1224) # # End of DATA HERE ################################################### # # Draw graphs # library(beeswarm) # ## 軸の余裕分 myxlimadd myxlimadd <- 1 # ################################################### # postscript("out.eps", horizontal=FALSE, height=6, width=5, pointsize=15) # ################################################### # mytitle <- "My Title" # # 縦軸の範囲を決めておく：繰り返し使えるように yminmax <- c(0,7000) # # 縦軸の目盛刻み（ラベルにもなる） ytick <- c(0,1000,2000,3000,4000,5000,6000,7000) # # 横軸のカテゴリ ＋ beewarm用隙間（5） myxlim <- 11 + myxlimadd # ## 横軸の目盛刻み xtick <- c(1.5,4.5,7.5,10.5) # # 左：control # # データを描く横軸の目盛上の位置：左 myx <- c(1,4,7,10) # data data0 <- control0 data1 <- control1 data2 <- control2 data3 <- control3 # # 「1-3」データのみ：「0」データは NA とする meanright <- c(NA,mean(data1), mean(data2), mean(data3)) # # 「1-3」データ左端と「0」データ。ほかのデータは NA とする meanleft <- c(mean(data0),mean(data1),NA,NA) # # # 「1-3」データ折れ線 # # cex=3, col="gray" サイズ10倍、色グレー plot(meanright~myx,type="b",pch="-", cex=3, col="gray", ylim=yminmax, xlim=c(1,myxlim),xlab="",ylab="",axes=FALSE, main=mytitle) # # 「1-3」データ左端と「0」データ折れ線 # par(new=T) # # cex=3, col="gray" サイズ10倍、色グレー plot(meanleft~myx,type="b",pch="-", cex=3, col="gray", ylim=yminmax, xlim=c(1,myxlim),xlab="",ylab="", lty=2, axes=FALSE) # # beeswarm で同じ点を打つために繰り返し数を入れておく condition <- factor(c( rep(1, length(data0)), # 「0」 # dummy 2,3, # dummy rep(4, length(data1)), # 「1」 # dummy 5,6, # dummy rep(7, length(data2)), # 「2」 # dummy 8,9, # dummy rep(10, length(data3)), # 「3」 11 # dummy )) # score <- c( data0, NA,NA, data1, NA,NA, data2, NA,NA, data3, NA ) # # 蜂群プロット # pch=5：ダイヤモンド◇ beeswarm( score~condition, pch=5, xlim=c(1,myxlim),ylim=yminmax, axes=FALSE, add=TRUE, correl="wrap") # ################################################### #右にずらして重ねる # par(new=T) # # data data0 <- test0 data1 <- test1 data2 <- test2 data3 <- test3 # # データを描く横軸の目盛上の位置：右 myx <- c(2,5,8,11) # # 「1-3」データのみ：「0」データは NA とする meanright <- c(NA,mean(data1), mean(data2), mean(data3)) # # 「1-3」データ左端と「0」データ。ほかのデータは NA とする meanleft <- c(mean(data0),mean(data1),NA,NA) # # 「1-3」データ折れ線 # cex=3, col="gray" サイズ10倍、色グレー plot(meanright~myx,type="b",pch="-", cex=3, col="gray", ylim=yminmax,xlim=c(1,myxlim),xlab="",ylab="",axes=F) # # 「1-3」データ左端と「0」データ折れ線 # par(new=T) # # cex=3, col="gray" サイズ10倍、色グレー plot(meanleft~myx,type="b",pch="-", cex=3, col="gray", ylim=yminmax,xlim=c(1,myxlim),xlab="",ylab="", lty=2, axes=F) # # beeswarm で同じ点を打つために繰り返し数を入れておく condition <- factor(c( 1, # dummy rep(2, length(data0)), # 「0」 # dummy 3,4, # dummy rep(5, length(data1)), # 「1」 # dummy 6,7, # dummy rep(8, length(data2)), # 「2」 # dummy 9,10, # dummy rep(11, length(data3)) # 「3」 )) # score <- c( NA, data0, NA,NA, data1, NA,NA, data2, NA,NA, data3 ) # #pch=1：白抜き丸○ beeswarm( score~condition, pch=1, xlim=c(1,myxlim),ylim=yminmax, axes=FALSE, add=TRUE, correl="wrap") # # 縦軸：side=2 # las = 1：X軸、Y軸ともに数値ラベルを水平に書く # line=2：縦軸を左にずらす axis(2,ytick,las=1,line=1) # # 横軸：side=1 axis(1,xtick,labels=FALSE) ################################################### # # postscript (eps) 出力終了 dev.off() |Today:&counter(today); |Yesterday:&counter(yesterday); |Total:&counter(); since 21 July 2019|
