int AllSubsetsMetaAnalysis(gsl_vector * esVector, gsl_vector * varVector,
gsl_vector * metaResultsVector, ST_uint4 from, ST_uint4 to ) {
ST_retcode rc;
ST_uint4 i, nStudies;
ST_long j, nSubsets;
char buf[80];
gsl_combination * comb;
nStudies = esVector->size;
nSubsets = gsl_pow_int(2, nStudies)-1 ;
j=1;
//for(i=1; i <= nStudies; i++) {
for(i=from; i <= to; i++) {
comb = gsl_combination_calloc(nStudies, i);
do {
if(j == nSubsets+1) {
snprintf(buf, 80,"combLength %u Obs %u\n",i, j);
SF_error(buf);
SF_error("Exceeded the maximum number of subsets!!!\n");
return(-2);
}
if ((rc = MetaAnalysis(esVector, varVector, metaResultsVector, comb) )) return(rc);
if ((rc = WriteOut(metaResultsVector, j, comb) )) return(rc);
j += 1;
} while (gsl_combination_next(comb) == GSL_SUCCESS);
}
gsl_combination_free(comb);
return(0);
}
STDLL stata_call(int argc, char *argv[])
{
int get_results(void) ;
int load_data(void) ;
int write_data(void) ;
ST_retcode rc = 0;
// Must specify an argument to plugin
if (argc) {
// Check number of arguments passed to plugin
if (argc > 1) {
SF_error("too many options specified \n") ;
return((ST_retcode) 198) ;
}
} else {
SF_error("must specify the load, create, or write options \n") ;
return((ST_retcode) 198) ;
}
//Option create was specified
if (argc == 1 && strcmp(argv[0], "create") == 0) {
// Query database and get the data types for each variable
rc = get_results() ;
if (rc) {
mysql_free_result(res) ;
mysql_close(&mysql) ;
return((ST_retcode) rc) ;
}
}
//Option load was specified
else if (argc == 1 && strcmp(argv[0], "load") == 0) {
// load the data from the database
rc = load_data() ;
if (rc) {
mysql_free_result(res) ;
mysql_close(&mysql) ;
return((ST_retcode) rc) ;
}
}
//Option write was specified
else if (argc == 1 && strcmp(argv[0], "write") == 0) {
// Write data to database
rc = write_data() ;
if (rc) {
return((ST_retcode) rc) ;
}
}
else {
// Invalid option
SF_error("option not allowed \n") ;
return((ST_retcode) 198) ;
}
return 0;
}
STDLL stata_call(int argc, char *argv[])
{
if (argc == 0) {
SF_error("Missing command line");
return 198;
}
char cmdline[32768];
cmdline[0] = '\0';
SF_display("Attempting to run ");
SF_display(argv[0]);
for (int i = 1; i < argc; i++){
SF_display(argv[i]);
strcat(cmdline, argv[i]);
}
SF_display("\n");
pid_t pid = fork();
int status = 0;
switch (pid) {
case -1:
SF_error("Error forking process");
return 198;
break;
case 0:
/* This is the child process */
execv(argv[0], argv);
exit(0);
break;
default:
/* This is the parent process */
waitpid(pid, &status, 0);
if(WIFEXITED(status)) {
return WEXITSTATUS(status) ;
} else {
SF_error("Process did not exit cleanly");
}
break;
}
}
int WriteOut(gsl_vector * metaResultsVector, ST_long j, gsl_combination * comb) {
ST_retcode rc;
ST_uint4 i, subsetLength = gsl_combination_k(comb);
char digits[52]="abcdefghijklmnopqrstuvwxywABCDEFGHIJKLMNOPQRSTUVWXYZ";
char buf[80] ,temp[80];
if((rc = SF_vstore(3, j, MARES(0)))) return(rc); /* ES_FEM */
if((rc = SF_vstore(4, j, MARES(1)))) return(rc); /* var_FEM */
if((rc = SF_vstore(5, j, MARES(2)))) return(rc); /* ES_REM */
if((rc = SF_vstore(6, j, MARES(3)))) return(rc); /* var_REM */
if((rc = SF_vstore(7, j, MARES(4)))) return(rc); /* df */
if (MARES(4) > 0.0) {
if((rc = SF_vstore(8, j, MARES(5)))) return(rc); /* Q */
if((rc = SF_vstore(9, j, MARES(6)))) return(rc); /* I2 */
}
else {
if((rc = SF_vstore(8, j, SV_missval ))) return(rc); /* Q */
if((rc = SF_vstore(9, j, SV_missval ))) return(rc); /* I2 */
}
if((rc = SF_vstore(10, j, MARES(7)))) return(rc); /* tau2 */
if (subsetLength>80) {
SF_error("Exceeded 80 characters for subset description");
SF_error("I will not print the string variable coding the subsets");
}
else {
for(i=0; i<subsetLength; i++) {
buf[i]=digits[c(i)];
if (i==subsetLength-1) {
buf[i+1]='\0';
}
}
}
if((rc = SF_sstore(11, j, buf))) return(rc);
return 0;
}
int DL(gsl_vector * esVector, gsl_vector * varVector,
gsl_vector * metaResultsVector , gsl_combination * comb,
const ST_double sumOfFixedWeights,
const ST_double sumOfFixedWeights2 ) {
ST_double tau2_DL;
ST_double sumOfRandomDLWeights = 0.0;
ST_double sumOfRandomDLWeightedEffects = 0.0;
ST_double sumOfRandomDLWeightedSquares = 0.0;
ST_uint4 nStudies = (ST_uint4) esVector->size ;
ST_uint4 i , subsetLength;
subsetLength = (ST_uint4) gsl_combination_k(comb);
if (subsetLength < 2) {
SF_error("Never here with one study! Please debug C code");
return(-4);
}
else {
tau2_DL = GSL_MAX((MARES(5) - MARES(4)) /
(sumOfFixedWeights - (sumOfFixedWeights2 / sumOfFixedWeights) ) , 0.0 );
gsl_vector_set(metaResultsVector, 7, tau2_DL);
for(i=0; i<subsetLength ; i++) {
sumOfRandomDLWeights += 1.0 / (gsl_vector_get(varVector, c(i)) + tau2_DL);
sumOfRandomDLWeightedEffects += gsl_vector_get(esVector, c(i))
/ (gsl_vector_get(varVector, c(i)) + tau2_DL);
}
/* Summary ES REM-DL */
gsl_vector_set(metaResultsVector, 2,
sumOfRandomDLWeightedEffects / sumOfRandomDLWeights);
/* Var of summary ES REM-DL */
gsl_vector_set(metaResultsVector, 3,
1.0 / sumOfRandomDLWeights);
}
return 0;
}
STDLL stata_call(int argc, char *argv[]) {
ST_uint4 j, i, from, to;
ST_uint4 n;
ST_long nSubsets;
ST_uint4 nOutputVars=9; /* ES_F, varES_F, es_R, varES_R, df, Q, I2, tau2 subsetString */
ST_uint4 nInputVars=2; /* ES, var*/
ST_double z, es, var;
ST_retcode rc;
//ST_double version = 0.1;
ST_double version = 0.2;
char buf[80];
gsl_vector * esVector;
gsl_vector * varVector;
gsl_vector * metaResultsVector;
//if (argc != 1) {
if (argc != 3) {
snprintf(buf, 80, "Plugin (ver: %g) usage: c_meta nStudies\n", version);
SF_error(buf);
SF_error("Please debug the calling .ado file!!!\n");
return (-1);
}
n = (ST_uint4) atoi(argv[0]);
from = (ST_uint4) atoi(argv[1]); /* added modification */
to = (ST_uint4) atoi(argv[2]); /* added modification */
/*
// debugging by printing out arguments
for (i=0; i< argc; i++) {
snprintf(buf, 80, "\narg%d=%s", i, argv[i]);
SF_error(buf);
}
snprintf(buf, 80, "\nfrom=%d\nto=%d", from, to);
SF_error(buf);
*/
esVector = gsl_vector_alloc(n);
varVector = gsl_vector_alloc(n);
/* This will hold the meta-analysis results */
metaResultsVector = gsl_vector_alloc(nOutputVars-1); /* last var is string */
/*nSubsets = gsl_pow_int(2,n)-1;*/
nSubsets = 0;
for(i=from;i<=to;i++) {
nSubsets = nSubsets + gsl_sf_choose(n, i);
}
if (SF_in2()<nSubsets) {
snprintf(buf, 80, "Plugin needs %ld observations in dataset\n", nSubsets);
SF_error(buf);
SF_error("Please debug the calling .ado file!!!\n");
return (-1);
}
if (SF_nvars() != nInputVars+nOutputVars) {
snprintf(buf, 80, "Plugin expects %d input and %d output variables!\n",
nInputVars, nOutputVars);
SF_error(buf);
SF_error("Please debug the calling .ado file!!!\n");
return(102);
}
for(j=SF_in1(); j<= n ; j++) {
if (SF_ifobs(j)) {
if((rc=SF_vdata(1,j,&z))) return(rc);
es = z;
if((rc=SF_vdata(2,j,&z))) return(rc);
var = z;
if(SF_is_missing(es) | SF_is_missing(var)) {
snprintf(buf, 80,"You have passed missing values (obs # %d) in the C plugin!\n", j);
SF_error(buf);
SF_error("Please debug the calling .ado file!!!\n");
return(-1);
}
else {
/* do stuff here */
gsl_vector_set(esVector,j-1, es);
gsl_vector_set(varVector,j-1, var);
}
}
}
if ((rc=AllSubsetsMetaAnalysis(esVector, varVector, metaResultsVector, from, to))) return(rc);
gsl_vector_free(esVector);
gsl_vector_free(varVector);
gsl_vector_free(metaResultsVector);
return(0);
}
int get_results()
{
int num_obs, num_vars, num_bytes ;
char query[1024] ;
char buff[16] ;
char * stata_mac_vars ;
char * stata_mac_types ;
MYSQL_ROW row ;
MYSQL_FIELD *field ;
ST_retcode rc ;
ST_double val = 0 ;
// Create MySQL connection
if(mysql_init(&mysql)==NULL)
{
SF_error("failed to initate MySQL connection\n") ;
return 198 ;
}
// Connect to database stata_test
if (!mysql_real_connect(&mysql,"127.0.0.1","user",
"password","stata_test",3306,NULL,0))
{
SF_error("error connecting to database\n") ;
return 198 ;
}
// Query database
strcpy(query, "SELECT * FROM stata_test") ;
rc=mysql_real_query(&mysql,query, strlen(query)) ;
if (rc)
{
SF_error("error making query\n") ;
return 198 ;
}
// Get results
res=mysql_store_result(&mysql) ;
num_vars = mysql_num_fields(res) ;
num_obs = mysql_num_rows(res) ;
// Allocate memory for arrays
stata_mac_vars = malloc(num_vars*33*sizeof(char)) ;
stata_mac_types = malloc(num_vars*12) ;
*stata_mac_vars = '\0' ;
*stata_mac_types = '\0' ;
// Create array of variable names and data types
while((field = mysql_fetch_field(res)))
{
strcat(stata_mac_vars, field->name) ;
strcat(stata_mac_vars, " ") ;
if (IS_NUM(field->type)) { // Numeric data
strcat(stata_mac_types, "double ") ;
}
else {
strcat(stata_mac_types, "str244 ") ;
}
}
// Store variable names/types and observation number into Stata macro
SF_macro_save("_vars", stata_mac_vars) ;
sprintf(buff, "%i", num_obs) ;
SF_macro_save("_obs", buff) ;
SF_macro_save("_types", stata_mac_types) ;
// Free memory
free(stata_mac_vars) ;
free(stata_mac_types) ;
return 0 ;
}
int write_data(void)
{
int c,r,max_len ;
max_len = 33*SF_nvars() ;
char query[40+max_len] ;
char varnames[max_len] ;
char vartypes[max_len] ;
char buff[16] ;
char *var = NULL ;
char *type = NULL ;
char *remove_comma ;
ST_retcode rc ;
ST_double val = 0 ;
// Create MySQL connection
if(mysql_init(&mysql)==NULL)
{
SF_error("failed to initate MySQL connection\n") ;
return 198 ;
}
// Connect to database stata_test
if (!mysql_real_connect(&mysql,"127.0.0.1","user",
"password","stata_test",3306,NULL,0))
{
SF_error("error connecting to database\n") ;
return 198 ;
}
// Grab variable names from Stata macro myvars
SF_macro_use("_myvars", varnames, max_len) ;
// Build query
strcpy(query, "INSERT INTO stata_test (") ;
var = strtok(varnames, " ") ;
// Insert varnames into query
while (var!=NULL) {
strcat(query, var) ;
strcat(query, ",") ;
var = strtok(NULL, " ") ;
}
remove_comma = strrchr(query, ',');
*remove_comma = ')';
strcat(query, " VALUES(") ;
// Insert values into query
for(r=SF_in1();r<=SF_in2(); r++){
SF_macro_use("_mytypes", vartypes, max_len) ;
type = strtok(vartypes, " ") ;
if(SF_ifobs(r)) {
for(c=1;c<=SF_nvars();c++){
if (strstr(type, "str")) {
if(rc = SF_sdata(c,r,buff)) return(rc) ;
}
else {
if(rc = SF_vdata(c,r,&val)) return(rc) ;
sprintf(buff, "%g", val) ;
}
strcat(query, "'") ;
strcat(query, buff) ;
strcat(query, "'") ;
strcat(query, ",") ;
type = strtok(NULL, " ") ;
}
remove_comma = strrchr(query, ',') ;
*remove_comma = ')' ;
strcat(query, ",(") ;
}
}
remove_comma = strrchr(query, ',');
*remove_comma = '\0';
// Query database
rc=mysql_real_query(&mysql,query, strlen(query)) ;
if (rc)
{
SF_error("error making query\n") ;
return 198 ;
}
return 0 ;
}
