R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- c(0.01,0.11,0.05,0.04,0.10,0.04,0.05,0.06,0.02,0.01,0.03,0.06,0.07,0.08,0.04,0.03,0.05,0.06,0.12,0.09,0.10,0.02,0.01,0.01,0.05,0.06,0.03,0.03,0.03,0.04,0.05,0.06,0.01,0.01,0.02,0.05,0.06,0.04,0.01,0.02,0.05,0.05,0.06,0.04,0.03,0.02,0.03,0.04,0.05,0.07,0.09,0.12,0.06,0.08,0.07,0.04,0.03,0.04,0.06,0.08) > par4 = '10' > par3 = '0.1' > par2 = '0.5' > par1 = '0.1' > par4 <- '10' > par3 <- '0.1' > par2 <- '0.5' > par1 <- '0.1' > #'GNU S' R Code compiled by R2WASP v. 1.2.327 () > #Author: root > #To cite this work: Wessa P., (2014), Maximum-likelihood Beta Distribution Fitting (v1.0.5) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_fitdistrbeta.wasp/ > #Source of accompanying publication: Office for Research, Development, and Education > # > library(MASS) > PPCCBeta <- function(shape1, shape2, x) + { + x <- sort(x) + pp <- ppoints(x) + cor(qbeta(pp, shape1=shape1, shape2=shape2), x) + } > par1 <- as.numeric(par1) > par2 <- as.numeric(par2) > par3 <- as.numeric(par3) > par4 <- as.numeric(par4) > if (par1 < 0.1) par1 <- 0.1 > if (par1 > 10) par1 <- 10 > if (par2 < 0.1) par2 <- 0.1 > if (par2 > 10) par2 <- 10 > if (par3 < 0.1) par3 <- 0.1 > if (par3 > 10) par3 <- 10 > if (par4 < 0.1) par4 <- 0.1 > if (par4 > 10) par4 <- 10 > par1h <- par1*10 > par2h <- par2*10 > par3h <- par3*10 > par4h <- par4*10 > sortx <- sort(x) > c <- array(NA,dim=c(par2h,par4h)) > for (i in par1h:par2h) + { + for (j in par3h:par4h) + { + c[i,j] <- cor(qbeta(ppoints(x), shape1=i/10,shape2=j/10),sortx) + } + } > postscript(file="/var/wessaorg/rcomp/tmp/1f12s1419959560.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > filled.contour((par1h:par2h)/10,(par3h:par4h)/10,c[par1h:par2h,par3h:par4h],xlab='shape1',ylab='shape2',main='PPCC Contour Plot - Beta') > dev.off() null device 1 > xbar <- mean(x) > xvar <- var(x) > (a <- (xbar*(1-xbar)/xvar - 1)*xbar) [1] 2.87076 > (b <- (1-xbar)*a/xbar) [1] 55.71617 > (f<-fitdistr(x, 'beta',list(shape1=a,shape2=b))) shape1 shape2 2.6363979 51.2051418 ( 0.4542238) ( 9.6657496) > xlab <- paste('Beta(shape1=',round(f$estimate[[1]],2)) > xlab <- paste(xlab,', shape2=') > xlab <- paste(xlab,round(f$estimate[[2]],2)) > xlab <- paste(xlab,')') > postscript(file="/var/wessaorg/rcomp/tmp/2jeuw1419959560.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > myser <- qbeta(ppoints(x), shape1=f$estimate[[1]], shape2=f$estimate[[2]]) > qqplot(myser, x, main='QQ plot (Beta)', xlab=xlab ) > grid() > dev.off() null device 1 > > #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/wessaorg/rcomp/createtable") > > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'Parameter',1,TRUE) > a<-table.element(a,'Estimated Value',1,TRUE) > a<-table.element(a,'Standard Deviation',1,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'shape1',header=TRUE) > a<-table.element(a,f$estimate[1]) > a<-table.element(a,f$sd[1]) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'shape2',header=TRUE) > a<-table.element(a,f$estimate[2]) > a<-table.element(a,f$sd[2]) > a<-table.row.end(a) > a<-table.end(a) > table.save(a,file="/var/wessaorg/rcomp/tmp/34blu1419959560.tab") > > try(system("convert tmp/1f12s1419959560.ps tmp/1f12s1419959560.png",intern=TRUE)) character(0) > try(system("convert tmp/2jeuw1419959560.ps tmp/2jeuw1419959560.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.288 0.162 1.458