correction of age heaping

model.stan

data {
  int A;
  int Y[A];
  int J;
  int From[J];
  int To[J];
}

parameters {
  simplex[A] q;
  real<lower=0> s_q;
  vector<lower=0, upper=1>[J] r;
  real<lower=0, upper=1> mu_r;
  real<lower=0> s_r;
}

transformed parameters {
  vector[A] mu = q;
  for (j in 1:J) {
    mu[To[j]]   = mu[To[j]]   + r[j]*q[From[j]];
    mu[From[j]] = mu[From[j]] - r[j]*q[From[j]];
  }
}

model {
  r ~ normal(mu_r, s_r);
  target += -log_diff_exp(normal_lcdf(1 | mu_r, s_r), normal_lcdf(0 | mu_r, s_r));
  q[3:(A-1)] ~ normal(2*q[2:(A-2)] - q[1:(A-3)], s_q);
  Y ~ multinomial(mu);
}

run-model.R

library(rstan)

age_idx <- seq(from=0, to=75, by=5) + 1
li <- lapply(c(-2,-1,1,2), function(j) data.frame(to=age_idx, from=age_idx + j))
age_heap <- subset(do.call(rbind, li), from > 1 & from <= 76)

d <- read.delim('http://kasugano.sakura.ne.jp/images/20160622/data.txt', stringsAsFactors=FALSE)
d_F <- subset(d, Sex=='Female')
d_M <- subset(d, Sex=='Male')
A <- length(d_F$Age)

stanmodel <- stan_model(file='model/model.stan')
data_F <- list(A=A, Y=d_F$Value, J=nrow(age_heap), From=age_heap$from, To=age_heap$to)
fit_F <- sampling(stanmodel, data=data_F, seed=123)
data_M <- list(A=A, Y=d_M$Value, J=nrow(age_heap), From=age_heap$from, To=age_heap$to)
fit_M <- sampling(stanmodel, data=data_M, seed=123)