This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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: |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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){ |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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){ |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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: |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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') |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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,", |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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. |
OlderNewer