Question

我有兴趣使用以下数据集准备粉丝图（https://gjabel.wordpress.com/page/2/）。我的目标是从2014年到2025年解释具有概率范围（0.01,0.05,0.10，...，0.95，0.99）的预测值。我应该感谢您的宝贵评论和建议，使用这些点制作粉丝图估计。

Year    Area
1973    5879
1979    5679
1989    5395
2000    5194
2010    5176
2014    5003

请随时询问任何进一步的信息。非常感谢提前。

Answer 1

你必须提供一些参数（平均值，不确定度，偏斜）

下面是一个基于您自己的数据的示例，但修改好像是预测：

library(fanplot)
library(dplyr) 

# read data
your_data <- 
  structure(list(Year = c(1973L, 1979L, 1989L, 2000L, 2010L, 2014L),
                 Area = c(5879L, 5679L, 5395L, 5194L, 5176L, 5003L)), 
            .Names = c("Year", "Area"),
            class = "data.frame", 
            row.names = c(NA, -6L))

# your data
# I modified your data as if it were forecasts
# I used uncertainty (multiplied by 1000) parameter from fanplot package boe dataset 
your_data <-
  your_data %>%
  mutate(time0 = as.numeric(rep(Year[1], nrow(your_data))),
       time = as.numeric(Year),
       mean = as.numeric(Area), 
       uncertainty = head(boe$uncertainty * 1000, nrow(your_data)),
       skew = rep(0, n()),
       my_time = 1:n()) %>%
  select(time0, time, my_time, mean, uncertainty, skew)

# exemple based on fanplot documentation...with some modifications

k <- nrow(your_data)

# guess work to set percentiles the boe are plotting
p <- c(0.01, seq(0.05, 0.95, 0.05), 0.99)

# estimate percentiles for future time period
pp <- matrix(NA, nrow = length(p), ncol = k)

for (i in 1:k)
  pp[, i] <- qsplitnorm(p, mean = your_data$mean[i], 
                        sd = your_data$uncertainty[i], 
                        skew = your_data$skew[i])
pp

# plot your data

# percentiles 
xx.pn <- 
  pn(pp, 
     start = your_data$my_time[1], 
     frequency = 1, 
     anchor = NULL)

# color palette
my_pal <- 
  colorRampPalette(c("tomato", "gray90"))

fancol <- 
  my_pal(ncol(xx.pn)/2)

# set plot margins
par(oma = c(0, 1, 0.5, 2), 
    mar = c(3, 2, 2, 1))

# plot
plot(NULL, 
     type = "n",
     xlim = c(your_data$my_time[1], 
              your_data$my_time[length(your_data$my_time)]), 
     ylim = c(min(your_data$mean) - 1000 , 
              max(your_data$mean) + 1000),
     las = 1,
     axes = F,
     xlab = "Time")

# add axis
axis(1, 
     at = your_data$my_time, 
     labels = your_data$time, 
     tick = TRUE)

# add fan
fan(xx.pn, 
    fan.col = fancol, 
    txt = NA)

准备R中的扇形图

1 个答案: