File: preDP.c

package info (click to toggle)
r-cran-eco 3.1-6-1
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 672 kB
  • ctags: 163
  • sloc: ansic: 4,183; makefile: 7
file content (77 lines) | stat: -rw-r--r-- 1,861 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#include <stddef.h>
#include <string.h>
#include <stdio.h>      
#include <math.h>
#include <Rmath.h>
#include <R.h>
#include "vector.h"
#include "subroutines.h"
#include "rand.h"
#include "bayes.h"
#include "sample.h"

/* Prediction for Nonparametric Model for 2x2 Tables */
void preDP(
	   double *pdmu, 
	   double *pdSigma,
	   int *pin_samp,
	   int *pin_draw,
	   int *pin_dim,
	   int *verbose,    /* 1 for output monitoring */
	   double *pdStore
	   ){	   
  
  /* some integers */
  int n_samp = *pin_samp;    /* sample size */
  int n_draw = *pin_draw;    /* sample size of survey data */ 
  int n_dim = *pin_dim;      /* dimension */

  double *mu = doubleArray(n_dim);                /* The mean */
  double *Wstar = doubleArray(n_dim);
  double **Sigma = doubleMatrix(n_dim, n_dim);    /* The covariance matrix */

  /* misc variables */
  int i, j, k, main_loop;   /* used for various loops */
  int itemp = 0;
  int itempM = 0;
  int itempS = 0;
  int progress = 1, itempP = ftrunc((double) n_draw/10);

  /* get random seed */
  GetRNGstate();
  
  for(main_loop=0; main_loop<n_draw; main_loop++){
    for(i=0; i<n_samp; i++) {
      for (j=0;j<n_dim;j++) {
	mu[j] = pdmu[itempM++];
	for (k=j;k<n_dim;k++) {
	  Sigma[j][k] = pdSigma[itempS++];
	  Sigma[k][j] = Sigma[j][k];
	}
      }
      rMVN(Wstar, mu, Sigma, n_dim);
      for (j=0; j<n_dim; j++)
	pdStore[itemp++] = exp(Wstar[j])/(1+exp(Wstar[j]));
    }
    if (*verbose)
      if (itempP == main_loop) {
        Rprintf("%3d percent done.\n", progress*10);
        itempP+=ftrunc((double) n_draw/10); progress++;
        R_FlushConsole();
      }
    R_CheckUserInterrupt();
  }
  
  if(*verbose)
    Rprintf("100 percent done.\n");

  /** write out the random seed **/
  PutRNGstate();

  /* Freeing the memory */
  free(mu);
  free(Wstar);
  FreeMatrix(Sigma,n_dim);
  
} /* main */