生成/模拟数字截断的GPD

Question

我试图从截断的GPD（广义Pareto分布）中生成随机样本。为了做到这一点，我开始编写GPD的CDF和分位数函数：

##CDF of the GPD
pGPD <- function(q, xi = 1, mu = 0, beta = 1, lower.tail = TRUE){ 
  shape = xi
  location = mu
  scale = beta

  # Probability:
  p = .pepd(q, location, scale, shape, lower.tail)

  # Return Value:
  p
}

##Quantile function (inverse of CDF) of GPD
qGPD <- function(p, xi = 1, mu = 0, beta = 1, lower.tail = TRUE){   
  shape = xi
  location = mu
  scale = beta

  # Quantiles:
  q = .qepd(p, location, scale, shape, lower.tail)

  # Return Value:
  q
}

##Generate random numbers of GPD-distribution
rGPD <- function(n, xi = 1, mu = 0, beta = 1){   
  shape = xi
  location = mu
  scale = beta

  # Random Variates:
  r = .repd(n, location, scale, shape)

  # Return Value:
  r
}

.pepd <- function(q, location = 0, scale = 1, shape = 0, lower.tail = TRUE) {
    # Check:
    stopifnot(min(scale) > 0) 
    stopifnot(length(shape) == 1) 

    # Probability:
    q <- pmax(q - location, 0)/scale
    if (shape == 0) 
      p <- 1 - exp(-q)
    else {
      p <- pmax(1 + shape * q, 0)
      p <- 1 - p^(-1/shape)
    }

    # Lower Tail:
    if (!lower.tail) 
      p <- 1 - p

    # Return Value: 
    p
  }

.qepd <-function(p, location = 0, scale = 1, shape = 0, lower.tail = TRUE){ 
    # Check:
    stopifnot(min(scale) > 0) 
    stopifnot(length(shape) == 1)
    stopifnot(min(p, na.rm = TRUE) >= 0)
    stopifnot(max(p, na.rm = TRUE) <= 1) 

    # Lower Tail:
    if (lower.tail) 
      p <- 1 - p

    # Quantiles:
    if (shape == 0) {
      q = location - scale * log(p)
    } else {
      q = location + scale * (p^(-shape) - 1)/shape
    }

    # Return Value: 
    q
  }

.repd <- 
  function(n, location = 0, scale = 1, shape = 0) {
    # Check:
    stopifnot(min(scale) > 0) 
    stopifnot(length(shape) == 1)

    # Random Variates:
    if (shape == 0) {
      r = location + scale * rexp(n)
    } else {
      r = location + scale * (runif(n)^(-shape) - 1)/shape
    }

    # Return Value:
    r
  }

这一切都很完美。现在，我想从截断的GPD中生成数字，为此，我使用了以下关系：

其中Q类似于下标的分位数函数，而F_ {GPD}（T）是GPD的CDF。使用这个，我写了下面的代码：

##Quantiles truncated GPD
qtGPD <- function (p,q,xi=1,mu=0,beta=1,lower.tail=TRUE){
  ans= qGPD(p*pGPD(q,xi,mu,beta,lower.tail), 
            xi,mu,beta, lower.tail)
  print(paste0("Generated from the ", 100*p, "th% quantile"))
  return (ans)
}

rtGPD <- function (n,q,xi=1,mu=0,beta=1,lower.tail=TRUE){
  qtGPD(p= runif(n),q,xi,mu,beta,lower.tail)
}

但是现在，如果我想要使用函数rtGPD从第99％分位数截断的GPD生成数字，它不起作用，因为我的p值不断变化。那么，我做错了什么或如何解决这个问题？我想要的只是从99％分位数的截断GPD中生成数字，或者在97.5％分位数处生成数字，或者......你得到了这个想法。

提前致谢！

编辑：例如，如果您运行以下代码：

set.seed(10)
A= rGPD(10)
sort(A)

qtGPD(0.99,2)
rtGPD(10,2)

那么你通常应该得到一个向量A，其中GPD中的随机值可能大于1，就像预期的那样。

使用命令qtGPD(O.99,2)获取

[1] "Generated from the 99th% quantile"
[1] 1.941176

哪也行。但是如果你运行rtGPD(10,2)，我想给我一个截断的GPD随机值的函数，你得到runif（10）中p的不同值，所有这些都是从不同的分位数生成的。我只想在某个分位数处生成/模拟截断的GPD的随机数，例如99％分位数。但是这段代码不允许我这样做。