timriffe

# matrix of marriage counts with female ages in columns and male ages in rows
MAR <- matrix(c(4145,24435,8140,1865,1655,54515,45010,15030,80,6735,20870,19530,5,920,5435,42470),ncol=4)
rownames(MAR) <- colnames(MAR) 	<- c("15-19","20-24","25-29","30-60")
# unmarried males and females at start of the year
unMARf 	<- c(254876,147705,61804,415497)
unMARm 	<- c(265755,199437,114251,429655)
PanmicticRates <- function(MAR,unMARf,unMARm){
	# allocate P, array of stacked component counts
	P <- array(0,dim=c(dim(MAR),min(dim(MAR))))
	Pi <- Ri <- MAR

timriffe

# McFarland Iterative adjustment:

McFarlandMarPredict <- function(M,uf,um,nf,nm,tol=1e-6) {
	# stick marriage mat together with those remaining unmarried
	Mmc <- rbind(cbind(M,um),c(uf,sum(uf,um)))
	# rescale rows then columns until margins add up to new margins
	for(i in 1:25){
		Mmc[-nrow(Mmc),] <- Mmc[-nrow(Mmc),]*(nm/(rowSums(Mmc)[-nrow(Mmc)]))
		Mmc[,-ncol(Mmc)] <- t(t(Mmc)[-ncol(Mmc),]*(nf/(colSums(Mmc)[-ncol(Mmc)])))
		if (sum(abs(rowSums(Mmc[-nrow(Mmc),])-nm)+abs(colSums(Mmc[,-ncol(Mmc)])-nf)) < tol) {break}

timriffe

DownloadMITclassics <- function(dirpath){
       require(Rcurl)
       MITwriters <- c("Confucius","Lao","Ferdowsi","Khayyam","Sadi","Tzu",
                       "Aeschylus","Aesop","Apollonius","Apuleius","Aristophanes","Aristotle",
                       "Antoninus","Augustus","Caesar","Epictetus","Epicurus","Euripides",
                       "Galen","Herodotus","Hippocrates","Homer","Carus","Ovid",
                       "Plato","Plotinus","Plutarch","Porphyry","Quintus","Sophocles",
                       "Tacitus","Thucydides","Virgil")

       # make directory structure:

timriffe

SearchMITclassics <-
function(dirpath="E:\\DATA\\CLASSICS",wordorphrase,linespm=2){
       writers <- list.files(dirpath)
       writers <- select.list(writers,title="Select Writers",multiple=TRUE,preselect=writers)
       output <- list()
       indicesalso <- c(1:linespm,-1:-linespm) # for grabbing nearby lines
       for (i in 1:length(writers)){
               writeri <- list()
               worksi <- list.files(paste(dirpath,writers[i],sep="\\"))
               if (length(writers)==1){

timriffe

# in no particular order (I did Google searches for many of these and found nothing, 
# so here's to mixing wikipedia and R!

# a caveat, most of these are designed to only take x as a vector with 2 values, 
# *even though* there may be generalizations out there for more values in the vector

# also, only a couple of these accept weights, 
# but they can all be properly weighted with very little tinkering

logorithmic.mean <- function(x){

timriffe

# Author: Tim Riffe
###############################################################################


LotkaRanalytic <-
		function(fx,Lx,x){
	R0 <- Rmomentn(fx,Lx,x,0)
	R1 <- Rmomentn(fx,Lx,x,1)
	R2 <- Rmomentn(fx,Lx,x,2)
	# alpha would have been:	 R1/R0	

timriffe

library(lattice) 
nfases 		<- 4 #nombre de intervals
npasosxint 	<- 5 #nombre de passes en cada interval
xmax		<- 5 #mida matriu
ymax		<- 5 #mida amtriu
Avfasenorm 	<- 1 #quantitat incrementada si no hi ha cap 20
Avfase 		<- c(1:4,0) # hacemos la vida mas facil
finalmat <-matrix(4,nrow=ymax,ncol=ymax) #matriz objetivo final, detodo 4

# how many trials and iterations:

timriffe

means <- c()
vars <- c()

for (i in 1:20){
	tosses <- rbinom(n=2^i,size=1,prob=.5)
	means[i] <- mean(tosses)
	vars[i] <- var(tosses)
}

plot(1:20,vars,type='o')

timriffe

x <- seq(0,1,by=.01)
y <- runif(101)

# the hacky way:
plot(x,y,axes=F)
box()
axis(side=1,at=seq(0,1,by=.2),labels=c(paste("0,",seq(0,8,by=2),sep=""),"1,0"))
axis(side=2,at=seq(0,1,by=.2),labels=NA)
text(x=-.05,y=seq(0,1,by=.2),
     labels=c(paste("0,",

timriffe

# the function:

Rates must be an all-numeric MATRIX with 4 columns: "Age", "Year", "Cohort" and a 4th column, such as "ASFR",
col = a vector of colors produced by your favorite color ramp (there is a default inside the function). must be 1 shorter than the number of breaks
breaks = the cut points for determinig colors- must be 1 longer than the number of colors
... additional arguments to pass to plot()

function no works fine with pre-logged mortality data. 

Legend (from fields package) now goes to right margin automatically, and you can pass on arguments to make it friendly for logged data. example to come soon. see ?fields:::image.plot for an idea of how to pass special arguments to the legend.