How to draw Poisson density curve in R? - r

I need to show that the amount of events in Poisson process are distributed by Poisson distribution with parameter lambda * t.
Here is the Poisson process generator:
ppGen <- function(lambda, maxTime){
taos <- taosGen(lambda, maxTime)
pp <- NULL
for(i in 1:maxTime){
pp[i] <- sum(taos <= i)
}
return(pp)
}
Here I try to replicate the process 1000 times and vectorisee the total occurrences in each realisation:
d <- ppGen(0.5,100)
tail(d,n=1)
reps <- 1000
x1 <- replicate(reps, tail(ppGen(0.5,100), n=1))
hist(x1)
Here is the histogram:
Here I am trying to draw a theoretical Poisson density curve with parameter lambda * t:
xfit<-seq(1,100,length=100)
yfit<-dpois(xfit,lambda = 0.5*100)
lines(xfit,yfit)
But the curve doesn't appear anywhere near the histogram. Can anyone suggest on the right way to do this?

Maybe you can try curve like below
x <- rpois(1000, 0.5 * 100)
dp <- function(x, lbd = 0.5 * 100) dpois(x, lambda = lbd)
curve(dp, 0, 100)
hist(x, freq = FALSE, add = TRUE)

Related

How to run white noise and autoregressive model (1) on observations

I'm trying to utilize the FitAR package and an autoregressive model/AR(1) --see #A below-- to compare noise (e.g. white/random noise, see #B below) to lynx counts. Setting this up has been confusing. I'm pulling a random noise example I came across and lynx data from FitAR. The white noise model would help determine what may be of significance in the lynx data.
#A lynx
install.packages(FitAR)
library(FitAR)
library(lattice)
library(leaps)
library(ltsa)
library(bestglm)
help("FitAR-package")
par(mfrow=c(1,2))
lynx <- (log(lynx))
ans <- FitAR((lynx),1)
z4<-Boot.FitAR(ans)
par(mfrow=c(2,1))
TimeSeriesPlot((lynx))
title(main="lynx")
TimeSeriesPlot(z4)
title(main="Simulated AR lynx")
#B white noise
install.packages("compositions")
library("compositions")
rnorm(n, mean = 0, sd = 1)
set.seed(100)
x <- NULL
x[1] <- 0
for (i in 2:100) {
x[i] <- x[i-1] + rnorm(1,0,1)
}
ts.plot(x, main = 'Random walk', xlab = '', ylab = '', col='blue', lwd = 2)
This book has some examples generating white noise time series in R.
set.seed(123)
## random normal variates
GWN <- rnorm(n = 100, mean = 5, sd = 0.2)
## random Poisson variates
PWN <- rpois(n = 50, lambda = 20)
TimeSeriesPlot(GWN)
TimeSeriesPlot(PWN)
You can use these white noise examples with FitAR.
ans <- FitAR(GWN, 1, MeanMLEQ=TRUE)
TimeSeriesPlot(ans)
This FitAR documentation I found interesting
It has an example simulating Gaussian noise
library(FitAR)
set.seed(123)
phi <- c(2.7607, -3.8106, 2.6535, -0.9238)
z <- SimulateGaussianAR(phi, 1000)
ans <- FitAR(z, 4, MeanMLEQ=TRUE)
TimeSeriesPlot(ans)

how to solve and plot a differential equation in R?

I want to solve and graph a differential equation for exponential growth but I can't quite understand how to use the deSolve library. My equation is N = N_0 * e^(rt) and the code that I tried is
library(deSolve)
## Time
t <- seq(0, 5, 1)
## Initial population
N0 <- 2
## Parameter values
r = 1
fn <- function(t, N0, r) with(r, list(N0 * exp(r*t)))
## Solving and ploting
out <- ode(N0, t, fn, params)
plot(out, lwd=2, main="exp")
but the output that I hope is not what I want. The graphs that I want to obtain are the following:
I hope you can help me. Thank you
The model function fn should contain the derivative, the integration is then done by the solver. First order growth can of course be solved analytically, but this is not always possible for more complex models.
library(deSolve)
## == derivative ==
fn <- function(t, N, r) {
# dN/dt = r * N
list(r * N)
}
r <- 1 # Parameter value
N <- 0:100 # sequence of N
t <- 0 # dummy as the derivative is not time dependent
plot(N, fn(t, N, r)[[1]], type="l")
## == integration ==
t <- seq(0, 5, .1) # time
N0 <- 2 # initial state
## numerical solver
out <- ode(N0, t, fn, r)
plot(out, lwd=2, main="exp")
## for comparison: analytical integration
lines(t, N0*exp(r*t), lwd=2, lty="dotted", col="red")
Alternatively you could try the curve function.
op <- par(mfrow=c(1, 2), mar=c(5, 5, 4, 3))
curve(r*x, from=0, to=100, xlab="N", ylab=bquote(dot(N)), main=bquote(dot(N)==N))
curve(N0 * exp(r*x), from=0, to=5, xlab="Time t", ylab="N(t)", main="Exponential growth")
par(op)

r deSolve - plotting time evolution pde

suppose that we have a pde that describes the evolution of a variable y(t,x) over time t and space x, and I would like to plot its evolution on a three dimensional diagram (t,x,y). With deSolve I can solve the pde, but I have no idea about how to obtain this kind of diagram.
The example in the deSolve package instruction is the following, where y is aphids, t=0,...,200 and x=1,...,60:
library(deSolve)
Aphid <- function(t, APHIDS, parameters) {
deltax <- c (0.5, rep(1, numboxes - 1), 0.5)
Flux <- -D * diff(c(0, APHIDS, 0)) / deltax
dAPHIDS <- -diff(Flux) / delx + APHIDS * r
list(dAPHIDS )
}
D <- 0.3 # m2/day diffusion rate
r <- 0.01 # /day net growth rate
delx <- 1 # m thickness of boxes
numboxes <- 60
Distance <- seq(from = 0.5, by = delx, length.out = numboxes)
APHIDS <- rep(0, times = numboxes)
APHIDS[30:31] <- 1
state <- c(APHIDS = APHIDS) # initialise state variables
times <-seq(0, 200, by = 1)
out <- ode.1D(state, times, Aphid, parms = 0, nspec = 1, names = "Aphid")
"out" produces a matrix containing all the data that we need, t, y(x1), y(x2), ... y(x60). How can I produce a surface plot to show the evolution and variability of y in (t,x)?
The ways change a bit depending on using package. But you can do it with little cost because out[,-1] is an ideal matrix form to draw surface. I showed two examples using rgl and plot3D package.
out2 <- out[,-1]
AphID <- 1:ncol(out2)
library(rgl)
persp3d(times, AphID, out2, col="gray50", zlab="y")
# If you want to change color with value of Z-axis
# persp3d(times, AphID, out2, zlab="y", col=topo.colors(256)[cut(c(out2), 256)])
library(plot3D)
mat <- mesh(times, AphID)
surf3D(mat$x, mat$y, out2, bty="f", ticktype="detailed", xlab="times", ylab="AphID", zlab="y")

Bayesian simple linear regression Gibbs Sampling with gamma prior

Please help me out.
I am doing Metopolis_hasting within Gibbs to generate a Markov Chian with stationary distribution equal to the joint conditional distribution of (beta,phi) given observed y. Where the model for y is simple linear regression and phi is 1/sigma^2. The full conditional distribution for phi is gamma(shape=shape_0+n/2,rate=rate_0 + 0.5*sum((y$y-b[1]-b[1]*y$x)^2)) where shape_0 and rate_0 are prior distribution of phi (which follows a gamma)
Here is my code:
y <- read.table("...",header = T)
n <- 50
shape_0 <- 10
rate_0 <- 25
shape <- shape_0+n/2
mcmc <- function (n = 10){
X <- matrix(0,n,3)
b <- c(5,2)
phi <- 0.2
X[1,] <- c(b,phi)
count1 <- 0
count2 <- 0
for (i in 2:n){
phi_new <- rnorm(1,phi,1) #generate new phi candidate
rate <- rate_0 + 0.5*sum((y$y-b[1]-b[1]*y$x)^2)
prob1 <- min(dgamma(phi_new,shape = shape,
rate = rate)/dgamma(phi,shape = shape, rate = rate),1)
##here is where I run into trouble, dgamma(phi_new,shape = shape,
##rate = rate)
##and dgamma(phi,shape = shape, rate = rate) both gives 0
u <- runif(1)
if (prob1>u)
{X[i,3] <- phi_new; count1=count1+1}
else {X[i,3] <-phi}
phi <- X[i,3]
....}
I know I should use log transformation on the precision parameter, but I'm not exactly sure how to do it. log(dgamma(phi_new,shape = shape, rate = rate)) would return -inf.
Thank you so much for help.

How to plot the probabilistic density function of a function?

Assume A follows Exponential distribution; B follows Gamma distribution
How to plot the PDF of 0.5*(A+B)
This is fairly straight forward using the "distr" package:
library(distr)
A <- Exp(rate=3)
B <- Gammad(shape=2, scale=3)
conv <- 0.5*(A+B)
plot(conv)
plot(conv, to.draw.arg=1)
Edit by JD Long
Resulting plot looks like this:
If you're just looking for fast graph I usually do the quick and dirty simulation approach. I do some draws, slam a Gaussian density on the draws and plot that bad boy:
numDraws <- 1e6
gammaDraws <- rgamma(numDraws, 2)
expDraws <- rexp(numDraws)
combined <- .5 * (gammaDraws + expDraws)
plot(density(combined))
output should look a little like this:
Here is an attempt at doing the convolution (which #Jim Lewis refers to) in R. Note that there are probably much more efficient ways of doing this.
lower <- 0
upper <- 20
t <- seq(lower,upper,0.01)
fA <- dexp(t, rate = 0.4)
fB <- dgamma(t,shape = 8, rate = 2)
## C has the same distribution as (A + B)/2
dC <- function(x, lower, upper, exp.rate, gamma.rate, gamma.shape){
integrand <- function(Y, X, exp.rate, gamma.rate, gamma.shape){
dexp(Y, rate = exp.rate)*dgamma(2*X-Y, rate = gamma.rate, shape = gamma.shape)*2
}
out <- NULL
for(ix in seq_along(x)){
out[ix] <-
integrate(integrand, lower = lower, upper = upper,
X = x[ix], exp.rate = exp.rate,
gamma.rate = gamma.rate, gamma.shape = gamma.shape)$value
}
return(out)
}
fC <- dC(t, lower=lower, upper=upper, exp.rate=0.4, gamma.rate=2, gamma.shape=8)
## plot the resulting distribution
plot(t,fA,
ylim = range(fA,fB,na.rm=TRUE,finite = TRUE),
xlab = 'x',ylab = 'f(x)',type = 'l')
lines(t,fB,lty = 2)
lines(t,fC,lty = 3)
legend('topright', c('A ~ exp(0.4)','B ~ gamma(8,2)', 'C ~ (A+B)/2'),lty = 1:3)
I'm not an R programmer, but it might be helpful to know that for independent random variables with PDFs f1(x) and f2(x), the PDF
of the sum of the two variables is given by the convolution f1 * f2 (x) of the two input PDFs.

Resources