Hello,
I have the following code and data. I am basically trying to select individuals
in a sample (by setting some weights) to match known counts for a zone. This is
been done by matching gender and age bands. I have tested the function to be
optimised and it does behave as I would expect when the weights are changed.
However when I run the optimisation I get the following output
> optout<-optim(weights0, func_opt, control=list(REPORT=1))
[1] 27164
[1] 27163.8
[1] 27163.8
[1] 27163.8
[1] 27163.8
[1] 27163.8
[1] 27163.8
[1] 27163.8
[1] 27163.8
etc
which suggest an initial change but thereafter the optimisation does not appear
to adapt the weights at all. Can anyone see what this is happening and how to
make the problem optimise?
sample<-read.csv(file="C:\\sample.csv")
cons1<-read.csv(file="C:\\Gender.csv")
cons2<-read.csv(file="C:\\Age9.csv")
weights0 <- array(dim = c(nrow(sample)))
for (zone in 1:2){
weights0 <- rep(1, nrow(sample))
optout<-optim(weights0, func_opt, control=list(REPORT=1))
optout.value
}
func_opt<-function(weights){
TAE <- 0.0
sumMale <- sum(weights[sample[1:nrow(sample),2]=="Male"])
sumFemale <- sum(weights[sample[1:nrow(sample),2]=="Female"])
sumAged50to54 <-sum(weights[sample[1:nrow(sample),3]=="Aged 50 to 54"])
sumAged55to59 <-sum(weights[sample[1:nrow(sample),3]=="Aged 55 to 59"])
sumAged60to64 <-sum(weights[sample[1:nrow(sample),3]=="Aged 60 to 64"])
sumAged65to69 <-sum(weights[sample[1:nrow(sample),3]=="Aged 65 to 69"])
sumAged70to74 <-sum(weights[sample[1:nrow(sample),3]=="Aged 70 to 74"])
sumAged75to79 <-sum(weights[sample[1:nrow(sample),3]=="Aged 75 to 79"])
sumAged80to84 <-sum(weights[sample[1:nrow(sample),3]=="Aged 80 to 84"])
sumAged85to89 <-sum(weights[sample[1:nrow(sample),3]=="Aged 85 to 89"])
sumAged90andolder <-sum(weights[sample[1:nrow(sample),3]=="Aged90 and older"])
TAE <- abs(cons1[zone, 2] - sumMale)
TAE <- TAE + abs(cons1[zone, 3] - sumFemale)
TAE <- TAE + abs(cons2[zone, 2] - sumAged50to54)
TAE <- TAE + abs(cons2[zone, 3] - sumAged55to59)
TAE <- TAE + abs(cons2[zone, 4] - sumAged60to64)
TAE <- TAE + abs(cons2[zone, 5] - sumAged65to69)
TAE <- TAE + abs(cons2[zone, 6] - sumAged70to74)
TAE <- TAE + abs(cons2[zone, 7] - sumAged75to79)
TAE <- TAE + abs(cons2[zone, 8] - sumAged80to84)
TAE <- TAE + abs(cons2[zone, 9] - sumAged85to89)
TAE <- TAE + abs(cons2[zone, 10] - sumAged90andolder)
print(TAE)
return(TAE)
}
sample.csv
id sex Age10
103712 Female Aged 50 to 54
103713 Male Aged 65 to 69
103715 Female Aged 60 to 64
103716 Male Aged 65 to 69
103717 Male Aged 70 to 74
103718 Female Aged 80 to 84
103721 Female Aged 65 to 69
103722 Male Aged 70 to 74
103723 Male Aged 65 to 69
103724 Female Aged 60 to 64
103728 Male Aged 65 to 69
103729 Female Aged 50 to 54
103730 Male Aged 75 to 79
103731 Female Aged 50 to 54
103733 Female Aged 55 to 59
(this goes on for 10000 individuals)
Gender.csv
Zone Male Female
Z1 10547 13234
Z2 16393 18759
Z3 5713 6462
Z4 19651 21834
Z5 26918 33992
Z6 17596 19665
Age9.csv
LA Aged50to54 Aged55to59 Aged60to64 Aged65to69
Aged70to74 Aged75to79 Aged80to84 Aged85to89 Aged90andolder
Z1 4274 3852 3307 3096 3123 2728 1896 1056 449
Z2 7416 6015 5402 4852 4304 3405 2270 1047 441
Z3 2425 2093 1864 1757 1520 1218 766 376 156
Z4 9236 7713 6013 5257 4696 4072 2702 1293 503
Z5 9655 8841 8199 8252 8375 7559 5511 3198 1320
Z6 7797 7210 5754 4851 4216 3664 2376 994 399
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
