I am trying to migrate some code from JAGS to Stan. Say I have the following dataset:
N <- 10
nchoices <- 3
ncontrols <- 3
toydata <- list("y" = rbinom(N, nchoices - 1, .5),
"controls" = matrix(runif(N*ncontrols), N, ncontrols),
"N" = N,
"nchoices" = nchoices,
"ncontrols" = ncontrols)
and that I want to run a multinomial logit with the following code (taken from section 9.5 of the documentation):
data {
int N;
int nchoices;
int y[N];
int ncontrols;
vector[ncontrols] controls[N];
}
parameters {
matrix[nchoices, ncontrols] beta;
}
model {
for (k in 1:nchoices)
for (d in 1:ncontrols)
beta[k,d] ~ normal(0,100);
for (n in 1:N)
y[n] ~ categorical(softmax(beta * controls[n]));
}
I now want to fix the first row of beta to zero. In JAGS I would simply declare in the model block that
for (i in 1:ncontrols) {
beta[1,i] <- 0
}
but I am not sure about how to do this in Stan. I have tried many combinations along the lines of section 6.2 of the documentation (Partially Known Parameters) like, for instance,
parameters {
matrix[nchoices, ncontrols] betaNonObs;
}
transformed parameters {
matrix[nchoices, ncontrols] beta;
for (i in 1:ncontrols) beta[1][i] <- 0
for (k in 2:nchoices) beta[k] <- betaNonObs[k - 1]
}
but none of them work. Any suggestions?
It would be helpful to mention the error message. In this case, if beta is declared to be a matrix, then the syntax you want is the R-like syntax
beta[1,i] <- 0.0; // you also omitted the semicolon
To answer your broader question, I believe you were on the right track with your last approach. I would create a matrix of parameters in the parameters block called free_beta and copy those elements to another matrix declared in the model block called beta that has one extra row at the top for the fixed zeros. Like
data {
int N;
int nchoices;
int y[N];
int ncontrols;
vector[ncontrols] controls[N];
}
parameters {
matrix[nchoices-1, ncontrols] free_beta;
}
model {
// copy free beta into beta
matrix[nchoices,ncontrols] beta;
for (d in 1:ncontrols)
beta[1,d] <- 0.0;
for (k in 2:nchoices)
for (d in 1:ncontrols)
beta[k,d] <- free_beta[k-1,d];
// priors on free_beta, which execute faster this way
for (k in 1:(nchoices-1))
row(free_beta,k) ~ normal(0.0, 100.0);
// likelihood
for (n in 1:N)
y[n] ~ categorical(softmax(beta * controls[n]));
}
Related
I am a beginner using stan (and stackoverflow by the way, I have absolutely no idea how you pretty print a dataframe on it, could not find how, sorry).
Let's say I want to make the following model :
y ~ normal(I*S + P*J,sigma)
P ~ normal(dP,1)
(to simplify this example I fix the deviation around P at 1)
where on one hand, I is a n,p matrix predictor and S are the corresponding regression coefficients (size p)
and on the other hand dP and J can only have 3 different values but my dataframe is constructed such as they looks like this (R-project):
dp <- c(0,0,0,0,0,0,0,2,2,2,2,2,2,2,1,1,1,1,1,1)
J <- c(5.2,5.2,....,2.3,2.3,....,7.5,7.5,...)
parameters are S, P and sigma.
I do no want stan to change every components of P, dp represents 3 types of data and I only want three different values of P corresponding to the 3 differents values of dp.
However each row of my dataframe contains different values of I.
edit: said in another way: for each row k, I want :
y[k] ~ I[k,1]*S[1]+I[k,2]*S[2]...+ real_value_P * J[k]
How can I achieve that ?
Here is my code:
data {
int < lower = 1 > NR; // Number of rows
int < lower = 1 > NC; // Number of columns
matrix [NR,NC] I ;// Predictor I
vector [NR] dP;
vector [NR] J ;
vector [NR] y; // Outcome
}
parameters {
real < lower = 0 > sigma; // Error SD
vector [NC] S ;
vector [NC] P ;
}
model {
P ~ normal(dP,1)
y ~ normal(I*S+P*J,sigma) ;
}
I am not sure I have been really clear, stats are still a tough subject to me either and my model is a bit more complicated than presented.
Thanks
The "trick" seems to indicate in a vector ("indices" here) which value of P to take (1,1,1,1,1,...2,2,2,2,2,...,3,3,3,3,3) and then to loop over it in the parameters to assign the correct value :
transformed parameters {
vector [NR] JP ; //J*P
for (k in 1:NR){
JP[k]=True_P[indices[k]]*J[k] ;
}
Hence the complete code :
data {
int < lower = 1 > NR; // Number of rows
int < lower = 1 > NC; // Number of columns
matrix [NR,NC] I ;// Predictor I
int indices[NR]; // indices
vector [3] P ;
vector [NR] dP ;
vector [NR] J ;
vector [NR] y; // Outcome
}
parameters {
real < lower = 0 > sigma; // Error SD
vector < lower = 0 > [NC] S ; // regression coefficients for predictors I
vector [2] True_P ;
}
transformed parameters {
vector [NR] JP ; //J*P
for (k in 1:NR){
JP[k]=True_P[indices[k]]*J[k] ;
}
}
model {
for (k in 1:3){
P[k] ~ normal(True_P[k],1) ;
}
y ~ normal(I*S+JP,sigma) ;
}
generated quantities {
} // The posterior predictive distributiondistribution
I am coding a SIR model in a metapopulation in R, I want to integrate the systema and for that I am using de deSolve with C compiled code, I have used this before but in the case having a few parameters, now I would have Nxm parameters where N is the dimension of the system,so I would like that
/* file age3classp.c */
#include <R.h>
static double parms[3];
static double forc[1];
#define N parms[0]
#define N1 parms[1]
#define gam3 parms[2]
That this parms are vector or matrix NxN
It is posible?
In C my model will be of the form:
# SIR metapopulation model:
SIR <- function(t, state, parameters) {
with(as.list(c(state, parameters)),{
dS = c()
dI = c()
dR = c()
for(i in c(1:dim)){
dS[i] <- delta_N[i]*(S[i]+I[i]+R[i])
dI[i] <- 10
dR[i] <- 10
}
list(c(dS, dI, dR))
})
}
population <- c(S <- matrix(100,ncol=N,nrow =1 ), I <- matrix(10,ncol=N,nrow =1 ),
R <- matrix(0,ncol=N,nrow =1 ))
z <- ode(population, times, SIR, parameters)
In this way it does not recognise S[i] or the others as variables just as initial condition values.
How can I do in order to recognise it as a variable?
Yes this is possible, and there are different ways to do it, depending on your C programming skills. The easiest is to put both states and parameters in two long vectors and then split it at the C level using numbered parameter and variable indices. The equations are then formulated as for-loops.
To improve readability, it is also possible to use
preprocessor constants for the indices or
unions and structs (see below)
a vector for the states and a list for the parameters
The states (y) are always treated as vector, both on the R and the C level, but parameters (p) can also be passed down as lists and then split up at the C level. This can be tricky and requires some understanding of R's data structures.
However, I recommend to start vectorization on the R level. R is quite fast with vectorized models, so the speedup may not compensate for the C programming effort. An example how to implement a vectorized predator-prey model can be found here.
Another idea is to use a code generator, so you may have a look at the CRAN package rodeo that creates fast Fortran code from equations formulated as tabular (i.e. LibreOffice or Excel) tables. Usage does not require kowledge of Fortran.
More about rodeo can be found in a paper (https://doi.org/10.1016/j.envsoft.2017.06.036) and the package documentation at https://dkneis.github.io/
If one really wants to program it in C here a small implementation of a Lotka-Volterra-Competition model see Wikipedia with 3 states. The parameters are handed over as parameter vector p at the C level while a union is used to improve readability:
/* file model.c */
#include <R.h>
union parvec {
struct {
double r[3], a[6];
};
double value[9];
} p;
/* initializer */
void initmod(void (* odeparms)(int *, double *))
{
int N = 9; /* total number of parameters */
odeparms(&N, p.value);
}
/* Derivatives */
void derivs (int *neq, double *t, double *y, double *ydot,
double *yout, int *ip) {
double y_sum = 0;
for (int i = 0; i < *neq; i++) {
y_sum = 0;
for (int j = 0; j < *neq; j++) y_sum += p.a[i + *neq * j] * y[j];
ydot[i] = p.r[i] * y[i] * (1 - y_sum);
}
}
And here the calling R code:
# file call_model.R
library(deSolve)
system("R CMD SHLIB model.c")
dyn.load("model.dll")
p <- c(r = c(0.1, 0.3, 0.04), A = c(0.2, 0.3, 0.3, 0.5, 0.4, 0.2))
y <- c(X = c(2, 2, 2))
times <- seq(0, 200, by = 0.1)
out <- ode(y, times, func = "derivs", parms = p,
dllname = "model", initfunc = "initmod")
matplot.0D(out)
dyn.unload("model.dll")
More elaborated solutions are possible, of course.
I am trying to code a custom Probit function in Stan to improve my understanding of the Stan language and likelihoods. So far I've written the logarithm of the normal pdf but am receiving an error message that I've found to be unintelligible when I am trying to write the likelihood. What am I doing wrong?
Stan model
functions {
real normal_lpdf(real mu, real sigma) {
return -log(2 * pi()) / 2 - log(sigma)
- square(mu) / (2 * sigma^2);
}
real myprobit_lpdf(int y | real mu, real sigma) {
return normal_lpdf(mu, sigma)^y * (1 - normal_lpdf(mu, sigma))^(1-y);
}
}
data {
int N;
int y[N];
}
parameters {
real mu;
real<lower = 0> sigma;
}
model {
for (n in 1:N) {
target += myprobit_lpdf(y[n] | mu, sigma);
}
}
Error
PARSER EXPECTED:
Error in stanc(model_code = paste(program, collapse = "\n"), model_name = model_cppname, :
failed to parse Stan model 'Probit_lpdf' due to the above error.
R code to simulate data
## DESCRIPTION
# testing a Probit model
## DATA
N <- 2000
sigma <- 1
mu <- 0.3
u <- rnorm(N, 0, 2)
y.star <- rnorm(N, mu, sigma)
y <- ifelse(y.star > 0,1, 0)
data = list(
N = N,
y = y
)
## MODEL
out.stan <- stan("Probit_lpdf.stan",data = data, chains = 2, iter = 1000 )
The full error message is
SYNTAX ERROR, MESSAGE(S) FROM PARSER:
Probabilty functions with suffixes _lpdf, _lpmf, _lcdf, and _lccdf,
require a vertical bar (|) between the first two arguments.
error in 'model2a7252aef8cf_probit' at line 7, column 27
-------------------------------------------------
5: }
6: real myprobit_lpdf(real y, real mu, real sigma) {
7: return normal_lpdf(mu, sigma)^y * (1 - normal_lpdf(mu, sigma))^(1-y);
^
8: }
-------------------------------------------------
which is telling you that the normal_lpdf function excepts three inputs and a vertical bar separating the first from the second.
It is also not a good idea to give your function the same name as a function that is already in the Stan language, such as normal_lpdf.
But the functions you have written do not implement the log-likelihood of a probit model anyway. First, the standard deviation of the errors is not identified by the data, so you do not need sigma. Then, the correct expressions would be something like
real Phi_mu = Phi(mu);
real log_Phi_mu = log(Phi_mu);
real log1m_Phi_mu = log1m(Phi_mu);
for (n in 1:N)
target += y[n] == 1 ? log_Phi_mu : log1m_Phi_mu;
although that is just a slow way of doing
target += bernoulli_lpmf(y | Phi(mu));
What is behind Approx and approxfun? I know that these two functions perform a linear interpolation, however I didn't find any reference on how they do that. I guess they use a least square regression model but I am not sure.
Finally, if it's true that they use a least square regression model what is the difference between them and lm + predict?
As commented , you should read the source code. Interpolation problem
Find y(v), given (x,y)[i], i = 0,..,n-1 */
For example approxfun use a simple this algorithm for linear approximation :
y(v), given (x,y)[i], i = 0,..,n-1 */
find the correct interval (i,j) by bisection */
Use i,j for linear interpolation
Here an R code that aprahrase the C function approx1 :
approx1 <-
function( v, x, y)
{
## Approximate y(v), given (x,y)[i], i = 0,..,n-1 */
i <- 1
j <- length(x)
ij <- 0
## find the correct interval by bisection */
while(i < (j-1) ) {
ij <- floor((i + j)/2)
if(v < x[ij])
j <- ij
else
i <- ij
}
## linear interpolation */
if(v == x[j]) return(y[j])
if(v == x[i]) return(y[i])
return (y[i] + (y[j] - y[i]) * ((v - x[i])/(x[j] - x[i])))
}
I am looking for something like the 'msm' package, but for discrete Markov chains. For example, if I had a transition matrix defined as such
Pi <- matrix(c(1/3,1/3,1/3,
0,2/3,1/6,
2/3,0,1/2))
for states A,B,C. How can I simulate a Markov chain according to that transition matrix?
A while back I wrote a set of functions for simulation and estimation of Discrete Markov Chain probability matrices: http://www.feferraz.net/files/lista/DTMC.R.
Relevant code for what you're asking:
simula <- function(trans,N) {
transita <- function(char,trans) {
sample(colnames(trans),1,prob=trans[char,])
}
sim <- character(N)
sim[1] <- sample(colnames(trans),1)
for (i in 2:N) {
sim[i] <- transita(sim[i-1],trans)
}
sim
}
#example
#Obs: works for N >= 2 only. For higher order matrices just define an
#appropriate mattrans
mattrans <- matrix(c(0.97,0.03,0.01,0.99),ncol=2,byrow=TRUE)
colnames(mattrans) <- c('0','1')
row.names(mattrans) <- c('0','1')
instancia <- simula(mattrans,255) # simulates 255 steps in the process
Argh, you found the solution whilst I was writing it up for you. Here's a simple example that I came up with:
run = function()
{
# The probability transition matrix
trans = matrix(c(1/3,1/3,1/3,
0,2/3,1/3,
2/3,0,1/3), ncol=3, byrow=TRUE);
# The state that we're starting in
state = ceiling(3 * runif(1, 0, 1));
cat("Starting state:", state, "\n");
# Make twenty steps through the markov chain
for (i in 1:20)
{
p = 0;
u = runif(1, 0, 1);
cat("> Dist:", paste(round(c(trans[state,]), 2)), "\n");
cat("> Prob:", u, "\n");
newState = state;
for (j in 1:ncol(trans))
{
p = p + trans[state, j];
if (p >= u)
{
newState = j;
break;
}
}
cat("*", state, "->", newState, "\n");
state = newState;
}
}
run();
Note that your probability transition matrix doesn't sum to 1 in each row, which it should do. My example has a slightly altered probability transition matrix which adheres to this rule.
You can now use the markovchain package available in CRAN. The user manual. is pretty good and has several examples.