2

私はこのようなdfを持っています:

library(dplyr)
library(data.table)
library(ggplot2)
library(scales)

Events <- c("A_1","A_2","A_3","B_1","B_2","B_3","C_1","C_2","C_3","D_1","D_2","D_3","E_1","E_2","E_3")
Percentage_Occur <- c(4.6,6.5,1.3,3.4,6.6,5.5,7.8,2.2,2.4,2.1,6.6,5.9,4.9,11.1,4.3)
df1 <- data.frame(Events,Percentage_Occur)

これらのサブイベントを個々のカテゴリに組み合わせて上位 3 つのイベントを決定しようとしているので、次のようにします。

df2 <- data.frame(df1)
df2$Events <- gsub("*_.*", "\\1", df2$Events)
df2 <- df2 %>% group_by(Events) %>% summarise_each(funs(sum(., na.rm = T)))
df2 <- df2[ order(-df2[,2]), ]

ggplot(df2, aes(reorder(Events,Percentage_Occur), Percentage_Occur)) + 
  geom_bar(stat = "identity") + coord_flip() +
  xlab("Events")

ここに画像の説明を入力

上位 3 つのイベント (この場合は E、B、D) を視覚化できたら、これらの上位 3 つのイベントのサブ イベントを別のプロットにプロットしたいと思います。

ここに画像の説明を入力

トップイベントのサブイベントを抽出することで、これを手動で行いました。これはサンプル データセットなので、実行できました。私が持っているより大きなデータセットにロジックを適用したいと思います。

私が望むのは、トップイベントを特定し（私ができることです）、データフレームを手動で見て抽出することなく、それらのトップイベントに対応するサブイベントをプログラムでプロットすることだけです。理由の 1 つは、これらのイベントが時間の経過とともに変化し、このタイプのロジックを 2 時間ごとに実行して、トップに到達する新しいイベントを確認するためです。これについてご意見をお寄せいただき、前進するのを手伝ってください。

注: 私もより良い色をしたいと思います。

4

1 に答える 1

2

上位 3 つのイベントを自動的に抽出するために、次の方法でデータを処理できます。

library(data.table)
library(splitstackshape)

dt <- cSplit(df1, "Events", sep="_", drop=FALSE)[, tot := sum(Percentage_Occur), Events_1
                                                 ][order(-tot,Events_1,-Percentage_Occur)
                                                   ][, top := rleid(tot)
                                                     ][top <= 3]

そして、 と の助けを借りて、scale_fill_manualよりreorder()良い色とグループ内の順序付きバーを含むプロットが得られます。

# create a vector for the labels of the events in the legend
# this is needed to get the legend in the right order
lbls <- dt$Events

# create the plot
ggplot(dt, aes(x=reorder(Events_1,-tot), y=Percentage_Occur, fill=reorder(Events,-Percentage_Occur), color="black")) +
  geom_bar(stat="identity", position = position_dodge(width=0.8), width=0.7) +
  geom_text(aes(y=1, label=Events), position = position_dodge(width=0.8), angle=90) +
  labs(title="Occurence by Event", x="Events", y="Percentage Occurance") +
  scale_color_manual(values = "black") +
  scale_fill_manual("Events", breaks = lbls,
                    values = c('#d53e4f','#3288bd','#fee08b','#ffffbf','#66c2a5','#f46d43','#fdae61','#abdda4','#e6f598')) +
  guides(color=FALSE) +
  theme_minimal()

結果は次のようになります。

ここに画像の説明を入力

色の値scale_fill_manualを自分の好みに合わせて調整できます。

dplyr/を使用してデータの準備を行うこともできtidyrます (ただし、関数にはまだ必要data.tableですrleid)。

library(dplyr)
library(tidyr)
library(data.table)

df1 <- df1 %>% separate(Events, c("Event","Subevent"), sep="_", remove=FALSE) %>%
  ungroup() %>%
  group_by(Event) %>%
  mutate(tot = sum(Percentage_Occur)) %>%
  ungroup() %>%
  arrange(-tot,-Percentage_Occur) %>%
  mutate(top = rleid(tot)) %>%      # for this part you need data.table
  filter(top <= 3)
于 2015-11-04T20:08:06.917 に答える