Suppose population data
Age0 Age1 Age2 Age3 Age4 Age5 Age6 Age7 Age8 Age9 Age10 Age11
1 268818 261156 255699 249954 249764 250261 251251 252536 254123 256020 257009 256488
2 269489 261305 255394 251470 249123 249254 250075 251372 252931 254813 257074 258142
3 264620 258160 253543 250538 248914 248444 248895 250038 251642 253477 255653 258278
4 252431 262504 258066 254720 252358 250874 250049 249660 250167 251689 253781 255974
5 234872 240086 260846 258418 256334 254612 253263 252082 250855 250728 252172 254521
6 216095 228774 238871 259449 259030 258208 257122 255910 254370 252302 251543 252908
Where for each age there are a few thousand individuals. i.e. for Age0 there are 268818 babies in year 1. I want to get the median Age at each year. So far I have created an inefficient code and I am looking for some help to get it to become faster. The code I am using is this (NOTE: it is inefficient for large populations):
cells<-NULL
data<-MYdata[,3:103]
data<-data*1000 #i do this because of excel/R consider differently the . and ,
MedianMatrix<-matrix(nrow = nrow(data),ncol = 1)
for(i in 1:nrow(data)){
for(j in 1:ncol(data)){
print(c(i,j))
cell<-rep(j-1,times=data[i,j])
cells<-c(cells,cell)
}
print(length(cells))
MedianMatrix[i,1]<-median(cells)
cells<-NULL
}
MedianMatrix
Any help/recommendations to make it run faster? Thank you.
Instead of expanding the entire vector and finding the median, you can compute the cumulative sum over the age groups and then find the greatest age where the sum is less than or equal to the half the population size.
D <- read.table(header=TRUE, text="
Age0 Age1 Age2 Age3 Age4 Age5 Age6 Age7 Age8 Age9 Age10 Age11
268818 261156 255699 249954 249764 250261 251251 252536 254123 256020 257009 256488
269489 261305 255394 251470 249123 249254 250075 251372 252931 254813 257074 258142
264620 258160 253543 250538 248914 248444 248895 250038 251642 253477 255653 258278
252431 262504 258066 254720 252358 250874 250049 249660 250167 251689 253781 255974
234872 240086 260846 258418 256334 254612 253263 252082 250855 250728 252172 254521
216095 228774 238871 259449 259030 258208 257122 255910 254370 252302 251543 252908
")
apply(D, 1, function(x) {
cum <- c(0, cumsum(x))
which.max(cum[cum <= sum(x)/2])-1
})