CU!

]]>

]]>

Let’s set this example upon the distribution.

pfun = PDF[UniformDistribution[{2*Subscript[θ, 1] - Subscript[θ, 2], 2*Subscript[θ, 1] + Subscript[θ, 2]}], x]

One of the most intensive calculations is the characteristic function (eq. the moment generating function). This is straightforward to derive.

cfun=CharacteristicFunction[UniformDistribution[ {2*Subscript[θ, 1]-Subscript[θ, 2],2*Subscript[θ, 1]+Subscript[θ, 2]}],x]

.

The Table[] command calculates for us the raw moments for our distribution.

Table[Limit[D[cfun, {x, n}], x -> 0]/I^n, {n, 4}]

.

Calculate the sample statistics.

T=List[8.23,6.9,1.05,4.8,2.03,6.95]; {Mean[T],Variance[T]}

.

Now, we can use a simple moment matching technique to get estimates for the parameters.

Solve[{Mean[T]-2*Subscript[θ, 1]==0,-(2*Subscript[θ, 1])^2+ 1/3 (12 Subscript[θ, 1]^2+\!\*SubsuperscriptBox[\(θ\), \(2\), \(2\)])- Variance[T]==0},{Subscript[θ, 2],Subscript[θ, 1]}]

.

Check the true value for the .

Reduce[2 Subscript[θ, 1]-Subscript[θ, 2]<=2 Subscript[θ, 1]+Subscript[θ, 2], Subscript[θ, 2]]

Then, .

]]>

How to draw random variates from the Von Mises distribution?

First of all let’s check the pdf of the probability rule, it is , for .

Ok, I admit that Bessels functions can be a bit frightening, but there is a work around we can do. The solution is a Metropolis algorithm simulation. It is not necessary to know the normalizing constant, because it will cancel in the computation of the ratio. The following code is adapted from James Gentle’s notes on Mathematical Statistics .

n <- 1000 x <- rep(NA,n) a <-1 c <-3 yi <-3 j <-0 i<-2 while (i < n) { i<-i+1 yip1 <- yi + 2*a*runif(1)- 1 if (yip1 < pi & yip1 > - pi) { if (exp(c*(cos(yip1)-cos(yi))) > runif(1)) yi <- yip1 else yi <- x[i-1] x[i] <- yip1 } } hist(x,probability=TRUE,fg = gray(0.7), bty="7") lines(density(x,na.rm=TRUE),col="red",lwd=2)

]]>

This is to announce that we plan to release R version 2.11.0 on Thursday, April 22, 2010. Those directly involved should review the generic schedule at http://developer.r-project.org/release-checklist.html The source tarballs will be made available daily (barring build troubles) via http://cran.r-project.org/src/base-prerelease/ For the R Core Team Peter Dalgaard

]]>

SuppDists

deals with this problem efficiently.

library(SuppDists) plot(function(x)dPearson(x,N=23,rho=0.7),-1,1,ylim=c(0,10),ylab="density") plot(function(x)dPearson(x,N=23,rho=0),-1,1,add=TRUE,col="steelblue") plot(function(x)dPearson(x,N=23,rho=-.2),-1,1,add=TRUE,col="green") plot(function(x)dPearson(x,N=23,rho=.9),-1,1,add=TRUE,col="red");grid() legend("topleft", col=c("black","steelblue","red","green"),lty=1, legend=c("rho=0.7","rho=0","rho=-.2","rho=.9"))</pre>

This is how it looks like,

Now, let’s construct a table of critical values for some arbitrary or not significance levels.

```
q=c(.025,.05,.075,.1,.15,.2)
xtabs(qPearson(p=q, N=23, rho = 0, lower.tail = FALSE, log.p = FALSE) ~ q )
# q
# 0.025 0.05 0.075 0.1 0.15 0.2
# 0.4130710 0.3514298 0.3099236 0.2773518 0.2258566 0.1842217
```

We can calculate p-values as usual too…

```
1-pPearson(.41307,N=23,rho=0)
# [1] 0.0250003
```

]]>

There were two men trying to decide what to do for a living. They went to see a counselor, and he decided that they had good problem solving skills.

He tried a test to narrow the area of specialty. He put each man in a room with a stove, a table, and a pot of water on the table. He said “Boil the water”. Both men moved the pot from the table to the stove and turned on the burner to boil the water. Next, he put them into a room with a stove, a table, and a pot of water on the floor. Again, he said “Boil the water”. The first man put the pot on the stove and turned on the burner. The counselor told him to be an Engineer, because he could solve each problem individually. The second man moved the pot from the floor to the table, and then moved the pot from the table to the stove and turned on the burner. The counselor told him to be a mathematician because he reduced the problem to a previously solved problem.

– From The Mathematician, The Physicist and The Engineer (and Others)

]]>

.

The code to do this is the following

rexp1 <- function(lambda, n) { u <- runif(n) x <- -log(u)/lambda } rgamma1 <- function(k, lambda) { sum(rexp1(lambda, k)) }

This works unfortunately only for the case

In the general case we got to result to more “complex” (?) simulation, hence programming. The first technique we gonna use is rejection sampling. As the proposal (or proxy or instrumental) density we set the . The key to implementation is to maximise the ratio of the two densities, ie

.

We find the maximum of the ratio along the next lines.

m<-function(x) exp(-x)*x^(-k+a)*(1/(-1+r))^k*(r^a)*gamma(k)/gamma(a) grid<-seq(0,10,by=.1) a=3.45 k=3 r=2.06 plot(m(grid)~grid,type="l",col="red") grid() ind<-which.max(m(grid)) # 6 m.max<-grid[ind] # 0.5

Analytically we can work out that the maximum is achieved at , then the actual value is .

Now, we draw variates from the integer gamma until one is accepted.

*UPDATED*

n=200000 a=3.45 k=3 r=2.06 lambda=2.71 sample<-rep(NA,n) start<-Sys.time() for (i in 1:n) { # The following is a function tha draws ONE random variate. # It's useful to have it in this form one <- function(a, lambda) { k <- floor(a) m <-m(a-k) while (TRUE) { x <- rgamma1(k,lambda-1) p.accept <- dgamma(x,a,lambda)/(m*dgamma(x,k,lambda-1)) if (runif(1)<p.accept) return(x) } } sample[i]<-one(a, lambda) } Sys.time()-start # Time difference of 25.738 secs grid2 <- seq(0, 10, length.out=100) plot(grid2, m(a-k)*dgamma(grid2,k,lambda-1), type="l", lty=2, col="red", xlab="x", ylab="Density",lwd=2) lines(grid2, dgamma(grid2,a,lambda), col="green",lwd=2) lines(density(sample),col="steelblue",lwd=2) legend("topright", col=c("red","green","steelblue"),lty=c(2,1), legend=c("m(a-k)*g(x)","sample dansity","f(x)"))

Not bad!

]]>

estPi<- function(n, l=1, t=2) { m <- 0 for (i in 1:n) { x <- runif(1) theta <- runif(1, min=0, max=pi/2) if (x < l/2 * sin(theta)) { m <- m +1 } } return(2*l*n/(t*m)) }

So, an estimate would be…

```
estPi(2000,l=1,t=2)
# 3.267974
```

Ok, not that great but for the whole scene it’s remarkable good! Now, we set some increasing sample sizes to account for the estimation.

```
n=8000
r=15
mat=rep(NA,r)
size=rep(NA,r)
for (i in 1:r) {
size[i]<-n*i
mat[i]<-estPi(n*i,l=1,t=2)
}
matrix<-expand.grid(size)
matrix[,2]<-mat
names(matrix)<-list("n","pi")
matrix
# n pi
#1 8000 3.182180
#2 16000 3.165809
#3 24000 3.135615
#4 32000 3.145581
#5 40000 3.138486
#6 48000 3.144860
#7 56000 3.162412
#8 64000 3.111932
#9 72000 3.097574
#10 80000 3.155072
#11 88000 3.157404
#12 96000 3.144139
#13 104000 3.126597
#14 112000 3.150226
#15 120000 3.136599
```

Which is the best estimate?

```
matrix[which.min(abs(matrix[,2]-pi)),]
# n pi
# 12 96000 3.144139
plot(matrix,type="b");abline(h=pi,col="red",lty=2)
```

source : [Chiara Sabatti , pdf]

Take a look @

+ Wiki

+ An introduction to geometrical probability: distributional aspects with applications (A. M. Mathai)

]]>

THE NORMAL LAW OF ERROR STANDS OUT IN THE EXPERIENCE OF MANKIND AS ONE OF THE BROADEST GENERALIZATIONS OF NATURAL PHILOSOPHY . IT SERVES AS THE GUIDING INSTRUMENT IN RESEARCHES IN THE PHYSICAL AND SOCIAL SCIENCES AND IN MEDICINE AGRICULTURE AND ENGINEERING . IT IS AN INDISPENSABLE TOOL FOR THE ANALYSIS AND THE INTERPRETATION OF THE BASIC DATA OBTAINED BY OBSERVATION AND EXPERIMENT

*–W.J. Youden*

Youden is one of the truly inspiring statisticians to me.

]]>