Beispiel #1
0
std::map<STM::ParName, double> Metropolis::do_sample(int n, bool saveDeviance)
// n is the number of samples to take
// returns a map of acceptance rates keyed by parameter name
{
	// 	shuffle the order of parameters
	std::vector<STM::ParName> parNames (parameters.active_names());
	std::random_shuffle(parNames.begin(), parNames.end(), 
			[this](int n){ return gsl_rng_uniform_int(rng.get(), n); });
	
	std::map<STM::ParName, int> numAccepted;
	for(const auto & par : parNames)
		numAccepted[par] = 0;

	for(int i = 0; i < n; i++)
	{
		for(int j = 0; j < thinSize; j++)
		{
			// step through each parameter
			for(const auto & par : parNames) {
				STM::ParPair proposal = propose_parameter(par);
				numAccepted[par] += select_parameter(proposal);
			}
		}
		parameters.increment();
		currentSamples.push_back(parameters.current_state());
		if(saveDeviance)
			sampleDeviance.push_back(std::pair<double, int>(-2 * currentLL, 1));

		//		if desired, some debugging output
		if(outputLevel >= EngineOutputLevel::Verbose) {
			std::cerr << "  iteration " << parameters.iteration() - 1 << 
					"    posterior probability: " << currentPosteriorProb <<
					"    likelihood: " << currentLL << "\n";
			if(outputLevel >= EngineOutputLevel::ExtraVerbose) {
			std::ios_base::fmtflags oldflags = std::cerr.flags();
				std::streamsize oldprecision = std::cerr.precision();

				std::cerr << std::fixed << std::setprecision(3) << " ";
				STM::ParMap st = parameters.current_state();
				int coln = 0;
				for(auto pa : st) {
					std::cerr << std::setw(6) << pa.first << std::setw(8) << pa.second;
					if(++coln >= 7) {
						std::cerr << "\n ";
						coln = 0;
					}
				}
				std::cerr << std::endl;
			
				std::cerr.flags (oldflags);
				std::cerr.precision (oldprecision);
			}
		}
}

	std::map<STM::ParName, double> acceptanceRates;
	for(const auto & par : parNames)
		acceptanceRates[par] = double(numAccepted[par]) / (n*thinSize);
	return acceptanceRates;
}
Beispiel #2
0
void tabbing_format
(     MPL *mpl,
      SYMBOL *altval          /* not changed */
)
{     SET *set = NULL;
      PARAMETER *par;
      SLICE *list, *col;
      TUPLE *tuple;
      int next_token, j, dim = 0;
      char *last_name = NULL;
      /* read the optional <prefix> */
      if (is_symbol(mpl))
      {  get_token(mpl /* <symbol> */);
         next_token = mpl->token;
         unget_token(mpl /* <symbol> */);
         if (next_token == T_COLON)
         {  /* select the set to saturate it with data */
            set = select_set(mpl, mpl->image);
            /* the set must be simple (i.e. not set of sets) */
            if (set->dim != 0)
               error(mpl, "%s must be a simple set", set->name);
            /* and must not be defined yet */
            if (set->array->head != NULL)
               error(mpl, "%s already defined", set->name);
            /* add new (the only) member to the set and assign it empty
               elemental set */
            add_member(mpl, set->array, NULL)->value.set =
               create_elemset(mpl, set->dimen);
            last_name = set->name, dim = set->dimen;
            get_token(mpl /* <symbol> */);
            insist(mpl->token == T_COLON);
            get_token(mpl /* : */);
         }
      }
      /* read the table heading that contains parameter names */
      list = create_slice(mpl);
      while (mpl->token != T_ASSIGN)
      {  /* there must be symbolic name of parameter */
         if (!is_symbol(mpl))
            error(mpl, "parameter name or := missing where expected");
         /* select the parameter to saturate it with data */
         par = select_parameter(mpl, mpl->image);
         /* the parameter must be subscripted */
         if (par->dim == 0)
            error(mpl, "%s not a subscripted parameter", mpl->image);
         /* the set (if specified) and all the parameters in the data
            block must have identical dimension */
         if (dim != 0 && par->dim != dim)
         {  insist(last_name != NULL);
            error(mpl, "%s has dimension %d while %s has dimension %d",
               last_name, dim, par->name, par->dim);
         }
         /* set default value for the parameter (if specified) */
         if (altval != NULL)
            set_default(mpl, par, copy_symbol(mpl, altval));
         /* append the parameter to the column list */
         list = expand_slice(mpl, list, (SYMBOL *)par);
         last_name = par->name, dim = par->dim;
         get_token(mpl /* <symbol> */);
         /* skip optional comma */
         if (mpl->token == T_COMMA) get_token(mpl /* , */);
      }
      if (slice_dimen(mpl, list) == 0)
         error(mpl, "at least one parameter name required");
      get_token(mpl /* := */);
      /* skip optional comma */
      if (mpl->token == T_COMMA) get_token(mpl /* , */);
      /* read rows that contain tabbing data */
      while (is_symbol(mpl))
      {  /* read subscript list */
         tuple = create_tuple(mpl);
         for (j = 1; j <= dim; j++)
         {  /* read j-th subscript */
            if (!is_symbol(mpl))
            {  int lack = slice_dimen(mpl, list) + dim - j + 1;
               insist(tuple != NULL);
               insist(lack > 1);
               error(mpl, "%d items missing in data group beginning wit"
                  "h %s", lack, format_symbol(mpl, tuple->sym));
            }
            /* read and append j-th subscript to the n-tuple */
            tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
            /* skip optional comma *between* <symbols> */
            if (j < dim && mpl->token == T_COMMA)
               get_token(mpl /* , */);
         }
         /* if the set is specified, add to it new n-tuple, which is a
            copy of the subscript list just read */
         if (set != NULL)
            check_then_add(mpl, set->array->head->value.set,
               copy_tuple(mpl, tuple));
         /* skip optional comma between <symbol> and <value> */
         if (mpl->token == T_COMMA) get_token(mpl /* , */);
         /* read values accordingly to the column list */
         for (col = list; col != NULL; col = col->next)
         {  /* if the token is single point, no value is provided */
            if (is_literal(mpl, "."))
            {  get_token(mpl /* . */);
               continue;
            }
            /* read value and assign it to new parameter member */
            if (!is_symbol(mpl))
            {  int lack = slice_dimen(mpl, col);
               insist(tuple != NULL);
               if (lack == 1)
                  error(mpl, "one item missing in data group beginning "
                     "with %s", format_symbol(mpl, tuple->sym));
               else
                  error(mpl, "%d items missing in data group beginning "
                     "with %s", lack, format_symbol(mpl, tuple->sym));
            }
            read_value(mpl, (PARAMETER *)col->sym, copy_tuple(mpl,
               tuple));
            /* skip optional comma preceding the next value */
            if (col->next != NULL && mpl->token == T_COMMA)
               get_token(mpl /* , */);
         }
         /* delete the original subscript list */
         delete_tuple(mpl, tuple);
         /* skip optional comma (only if there is next data group) */
         if (mpl->token == T_COMMA)
         {  get_token(mpl /* , */);
            if (!is_symbol(mpl)) unget_token(mpl /* , */);
         }
      }
      /* delete the column list (it contains parameters, not symbols,
         so nullify it before) */
      for (col = list; col != NULL; col = col->next) col->sym = NULL;
      delete_slice(mpl, list);
      return;
}
Beispiel #3
0
void parameter_data(MPL *mpl)
{     PARAMETER *par;
      SYMBOL *altval = NULL;
      SLICE *slice;
      int tr = 0;
      insist(is_literal(mpl, "param"));
      get_token(mpl /* param */);
      /* read optional default value */
      if (is_literal(mpl, "default"))
      {  get_token(mpl /* default */);
         if (!is_symbol(mpl))
            error(mpl, "default value missing where expected");
         altval = read_symbol(mpl);
         /* if the default value follows the keyword 'param', the next
            token must be only the colon */
         if (mpl->token != T_COLON)
            error(mpl, "colon missing where expected");
      }
      /* being used after the keyword 'param' or the optional default
         value the colon begins data in the tabbing format */
      if (mpl->token == T_COLON)
      {  get_token(mpl /* : */);
         /* skip optional comma */
         if (mpl->token == T_COMMA) get_token(mpl /* , */);
         /* read parameter data in the tabbing format */
         tabbing_format(mpl, altval);
         /* on reading data in the tabbing format the default value is
            always copied, so delete the original symbol */
         if (altval != NULL) delete_symbol(mpl, altval);
         /* the next token must be only semicolon */
         if (mpl->token != T_SEMICOLON)
            error(mpl, "symbol, number, or semicolon missing where expe"
               "cted");
         get_token(mpl /* ; */);
         goto done;
      }
      /* in other cases there must be symbolic name of parameter, which
         follows the keyword 'param' */
      if (!is_symbol(mpl))
         error(mpl, "parameter name missing where expected");
      /* select the parameter to saturate it with data */
      par = select_parameter(mpl, mpl->image);
      get_token(mpl /* <symbol> */);
      /* read optional default value */
      if (is_literal(mpl, "default"))
      {  get_token(mpl /* default */);
         if (!is_symbol(mpl))
            error(mpl, "default value missing where expected");
         altval = read_symbol(mpl);
         /* set default value for the parameter */
         set_default(mpl, par, altval);
      }
      /* create initial fake slice of all asterisks */
      slice = fake_slice(mpl, par->dim);
      /* read zero or more data assignments */
      for (;;)
      {  /* skip optional comma */
         if (mpl->token == T_COMMA) get_token(mpl /* , */);
         /* process current assignment */
         if (mpl->token == T_ASSIGN)
         {  /* assignment ligature is non-significant element */
            get_token(mpl /* := */);
         }
         else if (mpl->token == T_LBRACKET)
         {  /* left bracket begins new slice; delete the current slice
               and read new one */
            delete_slice(mpl, slice);
            slice = read_slice(mpl, par->name, par->dim);
            /* each new slice resets the "transpose" indicator */
            tr = 0;
         }
         else if (is_symbol(mpl))
         {  /* number or symbol begins data in the plain format */
            plain_format(mpl, par, slice);
         }
         else if (mpl->token == T_COLON)
         {  /* colon begins data in the tabular format */
            if (par->dim == 0)
err1:          error(mpl, "%s not a subscripted parameter",
                  par->name);
            if (slice_arity(mpl, slice) != 2)
err2:          error(mpl, "slice currently used must specify 2 asterisk"
                  "s, not %d", slice_arity(mpl, slice));
            get_token(mpl /* : */);
            /* read parameter data in the tabular format */
            tabular_format(mpl, par, slice, tr);
         }
         else if (mpl->token == T_LEFT)
         {  /* left parenthesis begins the "transpose" indicator, which
               is followed by data in the tabular format */
            get_token(mpl /* ( */);
            if (!is_literal(mpl, "tr"))
err3:          error(mpl, "transpose indicator (tr) incomplete");
            if (par->dim == 0) goto err1;
            if (slice_arity(mpl, slice) != 2) goto err2;
            get_token(mpl /* tr */);
            if (mpl->token != T_RIGHT) goto err3;
            get_token(mpl /* ) */);
            /* in this case the colon is optional */
            if (mpl->token == T_COLON) get_token(mpl /* : */);
            /* set the "transpose" indicator */
            tr = 1;
            /* read parameter data in the tabular format */
            tabular_format(mpl, par, slice, tr);
         }
         else if (mpl->token == T_SEMICOLON)
         {  /* semicolon terminates the data block */
            get_token(mpl /* ; */);
            break;
         }
         else
            error(mpl, "syntax error in parameter data block");
      }
      /* delete the current slice */
      delete_slice(mpl, slice);
done: return;
}