Mathematicaの色をRで使いたい。

現在ぼくは大学院でMathematicaを使っているのですが、 学生エディションなので卒業したら使えなくなります。

そこで、せめて色設定だけはRでも使いたいので、 MathematicaからRGBを発掘してきました。

↓これがMathematicaのデフォルトカラーであり、その下はRで使うためのリストです。 カラーリスト

mmcolors<-c(
"#5E81B5",
"#E19C24",
"#8FB032",
"#EB6235",
"#8778B3",
"#C56E1A",
"#5D9EC7",
"#FFBF00",
"#A5609D",
"#929600",
"#E95536",
"#6685D9",
"#F89F13",
"#BC5B80",
"#47B66D"
)

Mathematicaの色でプロットしてみる。

これを使って色指定すれば、Mathematicaのデフォルトカラーでプロットできます。 いろいろなベータ分布をプロットしてみましょう。

Mathematicaで書いた図

上は、Mathematicaで書いたベータ分布について書いた図です。

そして、下が同じものを ggplot2 で書いた図です。

ggplot2で書いた図

いかがでしょう。ほとんど同じですね。

プレゼンで統計グラフを使うとき、個人的な印象ですが ggplot2のデフォルトカラーはちょっと薄く、 あまり他に良いカラーセットが見つからなかったので Mathematicaから拝借してみました。 オススメのカラーセットがありましたら、教えて頂けると幸いです。

コード

以下はRのコードです。 僕の ggplot2 力が低いため長いコードになっているので、 よろしければご指摘お願いします。 stat_function や annotateを何度もコピペするの、良くないですよね。。。 蛇足だとは思いますが、一応Mathematicaのコードも記載しておきます。

library(ggplot2)
# Mathematicaの色設定を使う
col<-mmcolors
p<-ggplot(data.frame(x=c(0,1)), aes(x))
p<-p+ylim(0,5)
p<-p+scale_fill_hue(l=40)
# 各関数に、それぞれ色を指定する
p<-p+stat_function(fun=dbeta, args=list(1, 1),size=2.5,color=col[[1]])
p<-p+stat_function(fun=dbeta, args=list(1, 5),size=2.5,color=col[[2]])
p<-p+stat_function(fun=dbeta, args=list(3, 9),size=2.5,color=col[[3]])
p<-p+stat_function(fun=dbeta, args=list(5, 1),size=2.5,color=col[[4]])
p<-p+stat_function(fun=dbeta, args=list(6, 6),size=2.5,color=col[[5]])
p<-p+stat_function(fun=dbeta, args=list(9, 3),size=2.5,color=col[[6]])
p<-p+stat_function(fun=dbeta, args=list(16, 16),size=2.5,color=col[[7]])
p<-p+xlab("θ")
p<-p+ylab("P(θ|α,β)")
p<-p+scale_x_continuous(expand = c(0, 0), breaks = seq(0, 1, by = .2))
p<-p + theme_classic()
p<-p + theme(axis.line = element_line(size=1),
             axis.text.x = element_text(size=12,face="bold"),
             axis.text.y = element_text(size=12,face="bold"),
             axis.title.x = element_text(size=12,face="bold"),
             axis.title.y = element_text(size=12,face="bold")
             )
p<-p+annotate("text", label="Be(16,16)", x=.5, y=4.75,fontface="bold")
p<-p+annotate("text", label="Be(1,1)", x=.5, y=1.25, fontface="bold")
p<-p+annotate("text", label="Be(6,6)", x=.5, y=3.0, fontface="bold")
p<-p+annotate("text", label="Be(3,9)", x=.2, y=3.75, fontface="bold")
p<-p+annotate("text", label="Be(9,3)", x=.8, y=3.75, fontface="bold")
p<-p+annotate("text", label="Be(1,5)", x=.1, y=4.75, fontface="bold")
p<-p+annotate("text", label="Be(5,1)", x=.9, y=4.75, fontface="bold")
p

↓はMathematicaのコードです。

Plot[Evaluate@
  MapThread[
   PDF[BetaDistribution[#1, #2], x] &, {{1, 1, 3, 5, 6, 9, 16}, {1, 5,
      9, 1, 6, 3, 16}}], {x, 0, 1}, PlotStyle -> {Thickness[0.01]},
 AxesLabel -> {\[Theta], P(\[Theta]; \[Alpha], \[Beta])}, 
 AxesStyle -> Directive[Black, 18],
 TicksStyle -> {Directive[Black, 18], Directive[Black, 18]}, 
 Epilog -> {Inset[Style["Be(1,1)", 20], {0.5, 1.3}], 
   Inset[Style["Be(1,5)", 20], {0.1, 4.7}], 
   Inset[Style["Be(3,9)", 20], {0.2, 3.6}], 
   Inset[Style["Be(5,1)", 20], {0.9, 4.7}], 
   Inset[Style["Be(6,6)", 20], {0.5, 3.0}], 
   Inset[Style["Be(9,3)", 20], {0.8, 3.6}], 
   Inset[Style["Be(16,16)", 20], {0.5, 4.8}]}]

参考