Generating/Simulating numbers truncated GPD - r

Question

I'm trying to generate a random sample from the truncated GPD (Generalized Pareto Distribution). In order to do just that, I've begun with writing the CDF and quantile functions of the GPD:
##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
}
This all works perfectly. Now, I want to generate numbers from the Truncated GPD and to do that, I've used the following relation:
where Q resembles the quantile functions of the subscript and F_{GPD}(T) is the CDF of the GPD. Using this, I've written the following code:
##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)
}
But now, if I want for example to generate numbers from the 99th% quantile truncated GPD with the function rtGPD it doesn't work, because my p value keeps changing. So, what am I doing wrong or how can I fix this? All I want is to generate numbers from the truncated GPD at the 99th% quantile for example, or at the 97.5% quantile or... you get the idea.
Thanks in advance!
EDIT: For example, if you run the following code:
set.seed(10)
A= rGPD(10)
sort(A)
qtGPD(0.99,2)
rtGPD(10,2)
Then you should normally get a vector A, with random values from the GPD which can be bigger than 1, like expected.
With the command qtGPD(O.99,2), one obtains
[1] "Generated from the 99th% quantile"
[1] 1.941176
which is also OK. But if you then run rtGPD(10,2), a function that I want to give me random values for the truncated GPD, you get different values for p in runif(10), all generated from different quantiles. I just want to generate/simulate random numbers for the truncated GPD at a certain quantile, for example the 99% quantile. But this code isn't letting me do that.