int main(int argc, char *argv[]) { PetscErrorCode ierr; params params; Mat H; SlepcInitialize(&argc,&argv,(char*)0,help); ierr = PetscPrintf(PETSC_COMM_WORLD,"--------------------------------------------------------------------------------------\n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," _______ __ __ _______ _______ ______ _______ \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," |__ __| \\/ |/ ____\\ \\ / /_ _| ____|__ __| \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," | | | \\ / | (___ \\ \\ /\\ / / | | | |__ | | \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," | | | |\\/| |\\___ \\ \\ \\/ \\/ / | | | __| | | \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," | | | | | |____) | \\ /\\ / _| |_| | | | \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," |_| |_| |_|_____/ \\/ \\/ |_____|_| |_| \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," True Muonium Solver with Iterative Front-Form Techniques \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," \n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"--------------------------------------------------------------------------------------\n");CHKERRQ(ierr); read_input(ierr,argv,¶ms); print_input(ierr,¶ms); if(check_file(params.hfile)) { PetscViewer viewer_H; PetscViewerBinaryOpen(PETSC_COMM_WORLD,params.hfile.c_str(),FILE_MODE_READ,&viewer_H); MatCreate(PETSC_COMM_WORLD,&H); MatSetFromOptions(H); MatLoad(H,viewer_H); PetscViewerDestroy(&viewer_H); }else { discretize(ierr,¶ms); // ierr = VecView(params.mu,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); // ierr = VecView(params.theta,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); write_output(ierr,¶ms); coulomb_trick(ierr,¶ms); // ierr = VecView(params.CT,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ct_discrete(ierr,¶ms); // ierr = VecView(params.CT,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); hamiltonian(ierr,¶ms,H); // ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_DENSE);//DENSE<-->COMMON // MatView(H,PETSC_VIEWER_STDOUT_WORLD); } cleanup(ierr,¶ms); eigensolver(ierr,¶ms,H,argc,argv); ierr = MatDestroy(&H);CHKERRQ(ierr); ierr = SlepcFinalize(); return 0; }
/* conditional independence tests. */ SEXP ctest(SEXP x, SEXP y, SEXP sx, SEXP data, SEXP test, SEXP B, SEXP alpha, SEXP learning) { int ntests = length(x), nobs = 0; double *pvalue = NULL, statistic = 0, df = NA_REAL; const char *t = CHAR(STRING_ELT(test, 0)); test_e test_type = test_label(t); SEXP xx, yy, zz, result; /* allocate the return value, which the same length as x. */ PROTECT(result = allocVector(REALSXP, ntests)); setAttrib(result, R_NamesSymbol, x); pvalue = REAL(result); /* set all elements to zero. */ memset(pvalue, '\0', ntests * sizeof(double)); /* extract the variables from the data. */ PROTECT(xx = c_dataframe_column(data, x, FALSE, FALSE)); PROTECT(yy = c_dataframe_column(data, y, TRUE, FALSE)); PROTECT(zz = c_dataframe_column(data, sx, FALSE, FALSE)); nobs = length(yy); if (IS_DISCRETE_ASYMPTOTIC_TEST(test_type)) { /* parametric tests for discrete variables. */ statistic = ct_discrete(xx, yy, zz, nobs, ntests, pvalue, &df, test_type); }/*THEN*/ else if ((test_type == COR) || (test_type == ZF) || (test_type == MI_G) || (test_type == MI_G_SH)) { /* parametric tests for Gaussian variables. */ statistic = ct_gaustests(xx, yy, zz, nobs, ntests, pvalue, &df, test_type); }/*THEN*/ else if (test_type == MI_CG) { /* conditional linear Gaussian mutual information test. */ statistic = ct_micg(xx, yy, zz, nobs, ntests, pvalue, &df); }/*THEN*/ else if (IS_DISCRETE_PERMUTATION_TEST(test_type)) { statistic = ct_dperm(xx, yy, zz, nobs, ntests, pvalue, &df, test_type, INT(B), IS_SMC(test_type) ? NUM(alpha) : 1); }/*THEN*/ else if (IS_CONTINUOUS_PERMUTATION_TEST(test_type)) { statistic = ct_gperm(xx, yy, zz, nobs, ntests, pvalue, &df, test_type, INT(B), IS_SMC(test_type) ? NUM(alpha) : 1); }/*THEN*/ UNPROTECT(4); /* catch-all for unknown tests (after deallocating memory.) */ if (test_type == ENOTEST) error("unknown test statstic '%s'.", t); /* increase the test counter. */ test_counter += ntests; if (isTRUE(learning)) return result; else return c_create_htest(statistic, test, pvalue[ntests - 1], df, B); }/*CTEST*/