"TearDrop"チャートを作成する

Question

Rで "涙/アイスクリームコーン"チャートを作成しようとしました。目標は、実際の値と相対値を複数の要因で比較することです。トラブルのサイズが変化するラインで（別名コーンを作る）2点を結ぶを持つ、しかし

：私たちは、それが見えるようにしたいもののモックアップを描きました。ここに私がこれまで持っているものを説明するためのデモコードがいくつかあります。

person = c("Bob", "Joe", "Sue", "Jane", "Bob", "Joe", "Sue", "Jane", "Bob", "Joe", "Sue", "Jane", "Bob", "Joe", "Sue", "Jane") 
period = c("2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", "2017", "2017","2017","2017","2017","2017","2017","2017") 
metric = c("Metric1", "Metric1", "Metric1", "Metric1", "Metric2", "Metric2", "Metric2", "Metric2", "Metric1", "Metric1", "Metric1", "Metric1", "Metric2", "Metric2", "Metric2", "Metric2") 
value = round(runif(16, -0.005, 1.0049), 2) 

tmp = data.frame(person, period, metric, value)  

ggplot(data = tmp, 
      aes_string(x = "person", 
         y = value, 
         color = "person", 
         fill= "person")) + 
    geom_point(aes(size = period))+ 
    geom_line() + 
    scale_size_manual("Year", values=c(3, 6)) + 
    facet_wrap(~metric, nrow=1, labeller = label_wrap_gen()) + 
    labs(y = "Dummy Example", 
     fill="person") + 
    theme(legend.direction = "horizontal", 
     legend.position = "bottom", 
     legend.key = element_blank(), 
     legend.background = element_rect(fill = "white", colour = "gray30"), 
     plot.title=element_text(hjust=.5, size=22), 
     axis.title.x=element_blank(), 
     axis.text.x = element_text(angle =90, hjust=1)) 

実行すると、2016と2017のデータポイントが異なることがわかります。それらの間にスムーズな移行が必要です。

ご協力いただければ幸いです。ここで

----ソリューション----

はあなたのすべてのおかげで、私は一緒に置くことができたソリューションです。

library(ggplot2) 
library(ggforce) 

person = c("Bob", "Joe", "Sue", "Jane", "Bob", "Joe", "Sue", "Jane", "Bob", "Joe", "Sue", "Jane", "Bob", "Joe", "Sue", "Jane") 
period = c("2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", "2017", "2017","2017","2017","2017","2017","2017","2017") 
metric = c("Metric1", "Metric1", "Metric1", "Metric1", "Metric2", "Metric2", "Metric2", "Metric2", "Metric1", "Metric1", "Metric1", "Metric1", "Metric2", "Metric2", "Metric2", "Metric2") 
value = round(runif(16, -0.005, 1.0049), 2) 

tmp = data.frame(person, period, metric, value)  
tmp$x <- as.numeric(tmp$person) * .25 # to use continuous x 
tmp$r <- ifelse(as.numeric(tmp$HALF_YEAR)==1, .01, .04) #set radious based on period 

#Create single line for each person/metric by Metric 
{ 
    tmp2 <- cast(tmp, person+metric ~ period, value=value) 
    tmp2$x <- as.numeric(tmp2$person) * .25 # to use continuous x 
} 


#create dataframe for polygons to fill the cones 
{ 
    #Create Dummy section (to create dataframe) 
    { 
    tmp.c <- rep(tmp2[1, 1], 4) 
    tmp.t <- rep(tmp2[1, 2], 4) 
    tmp.x <- c(tmp2[1, 5]-.01, tmp2[1, 5]-.04, tmp2[1, 5]+.04, tmp2[1, 5]+.01) 
    tmp.y <- c(tmp2[1, 3], tmp2[1, 4], tmp2[1, 4], tmp2[1, 3]) 
    tmp.P <- data.frame(tmp.c, tmp.t, tmp.x, tmp.y) 
    } 

    for(i in seq_len(nrow(tmp2))) { 
    if(as.numeric(tmp2[i, 3]) > as.numeric(tmp2[i,4])) { 
     tmp.x <- c(tmp2[i, "x"]-.04, tmp2[i, "x"]-.01, tmp2[i, "x"]+.01, tmp2[i, "x"]+.04) 
     tmp.y <- c(min(tmp2[i, 3], tmp2[i, 4]), max(tmp2[i, 3], tmp2[i, 4]), max(tmp2[i, 3], tmp2[i, 4]), min(tmp2[i, 3], tmp2[i, 4])) 
    }else{ 
     tmp.x <- c(tmp2[i, "x"]-.01, tmp2[i, "x"]-.04, tmp2[i, "x"]+.04, tmp2[i, "x"]+.01) 
     tmp.y <- c(min(tmp2[i, 3], tmp2[i, 4]), max(tmp2[i, 3], tmp2[i, 4]), max(tmp2[i, 3], tmp2[i, 4]), min(tmp2[i, 3], tmp2[i, 4])) 
    } 

    tmp.c <- rep(tmp2[i, "person"], 4) 
    tmp.t <- rep(tmp2[i, "metric"], 4) 

    tmp.P <- rbind(tmp.P, data.frame(tmp.c, tmp.t, tmp.x, tmp.y)) 
    } 

    names(tmp.P) <- c("person", "metric", "x", "y") 

    #remove earlier dummy frame 
    tmp.P <- tail(tmp.P, -4) 
} 

#Create plot 
ggplot(tmp) + 
    geom_circle(aes_string(x0='x', y0='value', r='r', fill='person', color = 'person')) + 
    geom_polygon(data=tmp.P, aes(x=x, y=y, fill=person, color = person)) + 
    facet_wrap(~metric, nrow=1, labeller = label_wrap_gen()) +  
    labs(y = "Example", fill="person") + 
    scale_fill_manual("person", values=colors) + 
    scale_color_manual("person", values=colors) + 
    coord_fixed() + 
    theme(legend.direction = "horizontal", 
     legend.position = "bottom", 
     legend.key = element_blank(), 
     legend.background = element_rect(fill = "white", colour = "gray30"), 
     plot.title=element_text(hjust=.5, size=22), 
     axis.title.x=element_blank(), 
     axis.text.x = element_text(angle =90, hjust=1)) + 
    scale_x_continuous(breaks = seq(.25,1,.25), labels = levels(tmp$person)) 

をそして、それは素晴らしい作品 - Working Example

のみ問題を今は値に応じて、グラフが押しつぶされます - しかし、私はcord_fixedを取り除くことができません。なぜなら円が狂ってしまうからです。ここで

は、データの一例であり、それはどのようなものか。そのために周りの仕事に

value = c(0.96, 0.96, 0.97, 0.99, 0.94, 0.96, 0.96, 0.98, 0.99, 0.95, 0.96, 0.99, 0.97, 0.91, 0.95, 0.97) 

Squashed Plot

任意の考えを？

Answer 1

それは特にエレガントではないのですが、あなたは、単にgeom_circleの組み合わせ（とそれを描くことができ）ggforceパッケージと注意geom_segment（から）。あなたは円の直径の凡例をクリーンアップする必要があり、そしておそらくより良い探して円錐形のため、しかし、例えばスケーリング値のいくつかを調整します：

library(ggplot2) 
library(ggforce) 

tmp$x.origin <- as.numeric(tmp$person) * .25 # to use continuous x 
tmp$r <- abs(as.numeric(tmp$period) - 3) *.02 # vary radius by year 
tmp2 <- cbind(tmp[1:8,],tmp[9:16,c(4,6)]) # messy reshape... 
names(tmp2)[4:8] <- c("value.2016", "x.origin", "r.2016", "value.2017", "r.2017") 

ggplot(tmp) + geom_circle(aes(x0=x.origin, y0=value, r=r, fill=person, color = person, alpha = .3)) + 
    geom_segment(data = tmp2, aes(x = x.origin - r.2016, xend = x.origin - r.2017, y = value.2016, yend = value.2017, color = person)) + 
    geom_segment(data = tmp2, aes(x = x.origin + r.2016, xend = x.origin + r.2017, y = value.2016, yend = value.2017, color = person)) + 
    facet_wrap(~metric, nrow=1, labeller = label_wrap_gen()) + labs(y = "Dummy Example", fill="person") + coord_fixed() + theme(legend.position = "bottom") + 
    scale_x_continuous(breaks = seq(.25,1,.25), labels = levels(tmp$person)) 

Answer 2

おそらくティアドロップチャートを作成することができますが、これらのオプションはどれですか？

library(tidyverse) 

ggplot(tmp, aes(period, value, group=person, colour=person)) + 
    geom_line() + 
    geom_point() + 
    geom_text(data=tmp %>% group_by(person, metric) %>% arrange(period) %>% slice(1), 
      aes(label=person), position=position_nudge(x=-0.2)) + 
    facet_grid(. ~ metric) + 
    guides(colour=FALSE) 

ggplot(tmp, aes(period, value, colour=metric, group=metric)) + 
    geom_line(position=position_dodge(0.5)) + 
    geom_point(position=position_dodge(0.5)) + 
    facet_grid(. ~ person, scales="free_x")