int tclcommand_HarmonicWell(ClientData data, Tcl_Interp *interp, int argc, char **argv) {
DoubleList dl;
init_doublelist(&dl);
if(!ARG1_IS_DOUBLELIST(dl)) {
puts("Expected double list");
return TCL_ERROR;
}
if(dl.n != 4) {
puts("Wrong # of args");
for(int i = 0; i < dl.n; i++)
printf("%d %e\n", i, dl.e[i]);
return TCL_ERROR;
}
// printf("x %e %e %e, k %e\n", dl.e[0], dl.e[1],dl.e[2],dl.e[3]);
if (harmonicWell != NULL)
delete harmonicWell;
harmonicWell = new HarmonicWell(dl.e[0], dl.e[1], dl.e[2], dl.e[3],
espressoSystemInterface);
forceActors.push_back(harmonicWell);
return TCL_OK;
}
static void preparePolygammaOdd(int n, double binom, Polynom *series)
{
int order;
double deriv;
double maxx, x_order, coeff, pref;
deriv = 2*n + 1;
maxx = 0.5;
// to get 1/(2n)! instead of 1/(2n+1)!
pref = 2*deriv*(1 + deriv);
init_doublelist(series);
for (order = 0;; order++) {
// only odd exponents of x
x_order = 2*order + 1;
coeff = pref*hzeta(1 + deriv + x_order, 2);
if ((fabs(maxx*coeff)*(4.0/3.0) < ROUND_ERROR_PREC) && (x_order > deriv))
break;
realloc_doublelist(series, order + 1);
series->e[order] = -binom*coeff;
maxx *= 0.25;
pref *= (1.0 + deriv/(x_order + 1));
pref *= (1.0 + deriv/(x_order + 2));
}
series->n = order;
}
int main(void)
{
double_plist h;
init_doublelist(&h); //初始化一个双向循环链表
create_doublelist(h); //创建该链表
show_doublelist(h); //遍历该链表
sort_doublelist(h); //对该链表奇数升序偶数降序排序
show_doublelist(h); //遍历链表
return 0;
}
static void preparePolygammaEven(int n, double binom, Polynom *series)
{
/* (-0.5 n) psi^2n/2n! (-0.5 n) and psi^(2n+1)/(2n)! series expansions
note that BOTH carry 2n! */
int order;
double deriv;
double maxx, x_order, coeff, pref;
deriv = 2*n;
if (n == 0) {
// psi^0 has a slightly different series expansion
maxx = 0.25;
alloc_doublelist(series, 1);
series->e[0] = 2*(1 - C_GAMMA);
for (order = 1;; order += 1) {
x_order = 2*order;
coeff = -2*hzeta(x_order + 1, 2);
if (fabs(maxx*coeff)*(4.0/3.0) < ROUND_ERROR_PREC)
break;
realloc_doublelist(series, order + 1);
series->e[order] = coeff;
maxx *= 0.25;
}
series->n = order;
}
else {
// even, n > 0
maxx = 1;
pref = 2;
init_doublelist(series);
for (order = 0;; order++) {
// only even exponents of x
x_order = 2*order;
coeff = pref*hzeta(1 + deriv + x_order, 2);
if ((fabs(maxx*coeff)*(4.0/3.0) < ROUND_ERROR_PREC) && (x_order > deriv))
break;
realloc_doublelist(series, order + 1);
series->e[order] = -binom*coeff;
maxx *= 0.25;
pref *= (1.0 + deriv/(x_order + 1));
pref *= (1.0 + deriv/(x_order + 2));
}
series->n = order;
}
}
int tclcommand_external_potential_tabulated(Tcl_Interp* interp, int argc, char **argv, ExternalPotential* e)
{
char* filename =0;
DoubleList scalelist;
init_doublelist(&scalelist);
while (argc>0) {
if (ARG0_IS_S("file") ) {
if (argc>1) {
filename = argv[1];
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "Usage: external_potential file <filename>\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("scale")) {
if (argc>1 && ARG_IS_DOUBLELIST(1, scalelist)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "Usage: external_potential tabulated scale <float>\n" , (char *)NULL);
return TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "Unknown argument to external_potential: " , argv[0], "\n", (char *)NULL);
return TCL_ERROR;
}
}
if (filename == 0) {
Tcl_AppendResult(interp, "No filename given to external_potential tabulated\n" , (char *)NULL);
return TCL_ERROR;
}
if (external_potential_tabulated_init(n_external_potentials-1, filename, scalelist.n, scalelist.e)==ES_ERROR) {
Tcl_AppendResult(interp, "Error creating external potential\n" , (char *)NULL);
return TCL_ERROR;
}
return gather_runtime_errors(interp, TCL_OK);
}
int tclcommand_inter_parse_twist_stack(Tcl_Interp *interp, int bond_type, int argc, char **argv) {
DoubleList params;
init_doublelist(¶ms);
argc--;
argv++;
if(!ARG0_IS_DOUBLELIST(params)) {
twist_stack_usage(interp);
return ES_ERROR;
}
if(params.n != 17) {
puts("Wrong number of parameters");
twist_stack_usage(interp);
return ES_ERROR;
}
twist_stack_set_params(bond_type, ¶ms);
return ES_OK;
}
/** Initialize force and energy tables */
void force_and_energy_tables_init() {
init_doublelist(&tabulated_forces);
init_doublelist(&tabulated_energies);
}
int tclcommand_analyze_set_parse_trapmol(Tcl_Interp *interp, int argc, char **argv)
{
#ifdef MOLFORCES
#ifdef EXTERNAL_FORCES
int trap_flag = 0;
int noforce_flag =0;
int i;
#endif
#endif
int mol_num;
double spring_constant;
double drag_constant;
int isrelative;
DoubleList trap_center;
IntList trap_coords;
IntList noforce_coords;
char usage[] = "trapmol usage: <mol_id> { <xpos> <ypos> <zpos> } <isrelative> <spring_constant> <drag_constant> coords { <trapped_coord> <trapped_coord> <trapped_coord> } noforce_coords {<noforce_coord> <noforce_coord> <noforce_coord>}";
init_doublelist(&trap_center);
init_intlist(&trap_coords);
alloc_intlist(&trap_coords,3);
init_intlist(&noforce_coords);
alloc_intlist(&noforce_coords,3);
/* Unless coords are specified the default is just to trap it completely */
trap_coords.e[0] = 1;
trap_coords.e[1] = 1;
trap_coords.e[2] = 1;
Tcl_ResetResult(interp);
/* The first argument should be a molecule number */
if (!ARG0_IS_I(mol_num)) {
Tcl_AppendResult(interp, "first argument should be a molecule id", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
/* Sanity checks */
if (mol_num > n_molecules) {
Tcl_AppendResult(interp, "trapmol: cannot trap mol %d because it does not exist",mol_num , (char *)NULL);
return TCL_ERROR;
}
argc--;
argv++;
}
/* The next argument should be a double list specifying the trap center */
if (!ARG0_IS_DOUBLELIST(trap_center)) {
Tcl_AppendResult(interp, "second argument should be a double list", (char *)NULL);
Tcl_AppendResult(interp, usage , (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* The next argument should be an integer specifying whether the trap is relative (fraction of box_l) or absolute */
if (!ARG0_IS_I(isrelative)) {
Tcl_AppendResult(interp, "third argument should be an integer", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* The next argument should be the spring constant for the trap */
if (!ARG0_IS_D(spring_constant)) {
Tcl_AppendResult(interp, "fourth argument should be a double", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* The next argument should be the drag constant for the trap */
if (!ARG0_IS_D(drag_constant)) {
Tcl_AppendResult(interp, "fifth argument should be a double", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* Process optional arguments */
while ( argc > 0 ) {
if ( ARG0_IS_S("coords") ) {
if ( !ARG_IS_INTLIST(1,trap_coords) ) {
Tcl_AppendResult(interp, "an intlist is required to specify coords", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
} else if ( ARG0_IS_S("noforce_coords")) {
if ( !ARG_IS_INTLIST(1,noforce_coords) ) {
Tcl_AppendResult(interp, "an intlist is required to specify coords", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
} else {
Tcl_AppendResult(interp, "an option is not recognised", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
}
}
#ifdef MOLFORCES
#ifdef EXTERNAL_FORCES
for (i = 0; i < 3; i++) {
if (trap_coords.e[i])
trap_flag |= COORD_FIXED(i);
if (noforce_coords.e[i])
noforce_flag |= COORD_FIXED(i);
}
if (set_molecule_trap(mol_num, trap_flag,&trap_center,spring_constant, drag_constant, noforce_flag, isrelative) == TCL_ERROR) {
Tcl_AppendResult(interp, "set topology first", (char *)NULL);
return TCL_ERROR;
}
#else
Tcl_AppendResult(interp, "Error: EXTERNAL_FORCES not defined ", (char *)NULL);
return TCL_ERROR;
#endif
#endif
realloc_doublelist(&trap_center,0);
realloc_intlist(&trap_coords,0);
realloc_intlist(&noforce_coords,0);
return tclcommand_analyze_set_parse_topo_part_sync(interp);
}
int tclcommand_analyze_parse_local_stress_tensor(Tcl_Interp *interp, int argc, char **argv)
{
char buffer[TCL_DOUBLE_SPACE];
int periodic[3];
double range_start[3];
double range[3];
int bins[3];
int i,j,k,l;
DoubleList *TensorInBin;
PTENSOR_TRACE(fprintf(stderr,"%d: Running tclcommand_analyze_parse_local_stress_tensor\n",this_node));
/* 'analyze stress profile ' */
if (argc != 12) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "local_stress_tensor requires 12 inputs: x_periodic, y_periodic, z_periodic, x_range_start, y_range_start, z_range_start, x_range, y_range, z_range, x_bins, y_bins, z_bins", (char *)NULL);
return(TCL_ERROR);
}
const char *usage = "usage: analyse local_stress_tensor <x_periodic> <y_periodic> <z_periodic> <x_range_start> <y_range_start> <z_range_start> <x_range> <y_range> <z_range> <x_bins> <y_bins> <z_bins>";
for (i=0;i<3;i++) {
if ( !ARG0_IS_I(periodic[i]) ) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,usage, (char *)NULL);
return (TCL_ERROR);
} else {
argc -= 1;
argv += 1;
}
}
for (i=0;i<3;i++) {
if ( !ARG0_IS_D(range_start[i]) ) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,usage, (char *)NULL);
return (TCL_ERROR);
} else {
argc -= 1;
argv += 1;
}
}
for (i=0;i<3;i++) {
if ( !ARG0_IS_D(range[i]) ) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,usage, (char *)NULL);
return (TCL_ERROR);
} else {
argc -= 1;
argv += 1;
}
}
for (i=0;i<3;i++) {
if ( !ARG0_IS_I(bins[i]) ) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,usage, (char *)NULL);
return (TCL_ERROR);
} else {
argc -= 1;
argv += 1;
}
}
/* Allocate a doublelist of bins to keep track of stress profile */
TensorInBin = (DoubleList *)malloc(bins[0]*bins[1]*bins[2]*sizeof(DoubleList));
if ( TensorInBin ) {
/* Initialize the stress profile */
for ( i = 0 ; i < bins[0]*bins[1]*bins[2]; i++ ) {
init_doublelist(&TensorInBin[i]);
alloc_doublelist(&TensorInBin[i],9);
for ( j = 0 ; j < 9 ; j++ ) {
TensorInBin[i].e[j] = 0.0;
}
}
} else {
Tcl_AppendResult(interp,"could not allocate memory for local_stress_tensor", (char *)NULL);
return (TCL_ERROR);
}
mpi_local_stress_tensor(TensorInBin, bins, periodic,range_start, range);
PTENSOR_TRACE(fprintf(stderr,"%d: tclcommand_analyze_parse_local_stress_tensor: finished mpi_local_stress_tensor \n",this_node));
/* Write stress profile to Tcl export */
Tcl_AppendResult(interp, "{ LocalStressTensor } ", (char *)NULL);
for ( i = 0 ; i < bins[0] ; i++) {
for ( j = 0 ; j < bins[1] ; j++) {
for ( k = 0 ; k < bins[2] ; k++) {
Tcl_AppendResult(interp, " { ", (char *)NULL);
sprintf(buffer," { %d %d %d } ",i,j,k);
Tcl_AppendResult(interp,buffer, (char *)NULL);
Tcl_AppendResult(interp, " { ", (char *)NULL);
for ( l = 0 ; l < 9 ; l++) {
Tcl_PrintDouble(interp,TensorInBin[i*bins[1]*bins[2]+j*bins[2]+k].e[l],buffer);
Tcl_AppendResult(interp, buffer, (char *)NULL);
Tcl_AppendResult(interp, " ", (char *)NULL);
}
Tcl_AppendResult(interp, " } ", (char *)NULL);
Tcl_AppendResult(interp, " } ", (char *)NULL);
}
}
}
/* Free memory */
for ( i = 0 ; i < bins[0]*bins[1]*bins[2] ; i++ ) {
realloc_doublelist(&TensorInBin[i],0);
}
free(TensorInBin);
return TCL_OK;
}
int tclcommand_analyze_wallstuff(Tcl_Interp *interp, int argc, char **argv)
{
/* 'analyze wallmsd -xy|-z <min> <max>' */
/******************************************************************************/
char buffer[TCL_INTEGER_SPACE + TCL_DOUBLE_SPACE + 2];
DoubleList g;
int job, bin;
double rmin, rmax,rclocal;
int rbins, boxes;
enum { BINS, MX, MYZ, RDFYZ,BONDYZ,SCALE,SCALE2, PRINT };
if (argc < 2) {
Tcl_AppendResult(interp, "expected: analyze wallstuff -bins <binboundaries> | -myz <bin> |-mx <bin> | -rdfyz <bin> <rmin> <rmax> <rdfbins> | -bondyz | -scale | -scale2 | -print",
(char *)NULL);
return TCL_ERROR;
}
// 1. what do we do?
if (ARG0_IS_S("-bins")) {
job = BINS;
}
else if (ARG0_IS_S("-mx") && argc == 2) {
job = MX;
}
else if (ARG0_IS_S("-myz") && argc == 2) {
job = MYZ;
}
else if (ARG0_IS_S("-rdfyz") && argc == 5) {
job = RDFYZ;
}
else if (ARG0_IS_S("-bondyz") && argc == 5) {
job = BONDYZ;
}
else if (ARG0_IS_S("-scale") && argc == 4) {
job = SCALE;
}
else if (ARG0_IS_S("-scale2") && argc == 4) {
job = SCALE2;
}
else if (ARG0_IS_S("-print") && argc == 2) {
job = PRINT;
}
else {
Tcl_AppendResult(interp, ": analyze wallstuff -bins|-myz|-mx|-rdfyz|-bondyz|-scale|-scale2...", (char *)NULL);
return TCL_ERROR;
}
// 2. parameters
// 2. a) 1. parameter, bin or boundaries
switch (job) {
case BINS:
realloc_doublelist(&wallstuff_boundaries, wallstuff_boundaries.n = 0);
if (!ARG_IS_DOUBLELIST(1, wallstuff_boundaries)) {
return TCL_ERROR;
}
if (wallstuff_boundaries.n < 2) {
return (TCL_ERROR);
}
break;
case MX:
case MYZ:
case RDFYZ:
case BONDYZ:
case SCALE:
case SCALE2:
case PRINT:
if (!ARG_IS_I(1, bin)) {
return (TCL_ERROR);
}
if (bin < 0 || bin >= wallstuff_boundaries.n-1) {
return (TCL_ERROR);
}
break;
}
// 2. other parameters, only for rdf
switch (job) {
case RDFYZ:
if (!ARG_IS_D(2, rmin)) {
return (TCL_ERROR);
}
if (!ARG_IS_D(3, rmax)) {
return (TCL_ERROR);
}
if (!ARG_IS_I(4, rbins)) {
return (TCL_ERROR);
}
break;
case BONDYZ:
if (!ARG_IS_D(2, rclocal)) {
return (TCL_ERROR);
}
if (!ARG_IS_D(3, rmax)) {
return (TCL_ERROR);
}
if (!ARG_IS_I(4, rbins)) {
return (TCL_ERROR);
}
break;
case SCALE:
if (!ARG_IS_I(2, boxes)) {
return (TCL_ERROR);
}
case SCALE2:
if (!ARG_IS_I(2, boxes)) {
return (TCL_ERROR);
}
if (!ARG_IS_D(3, rclocal)) {
return (TCL_ERROR);
}
break;
}
// result double list
init_doublelist(&g);
// check that data is there
switch (job) {
case BINS:
case RDFYZ:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case BONDYZ:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case SCALE:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case SCALE2:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case MX:
case MYZ:
// these cases use the positions array
if (n_configs == 0) {
Tcl_AppendResult(interp, "no configurations found! Use 'analyze append' to save some!",
(char *)NULL);
return TCL_ERROR;
}
break;
}
// finally, do what is necessary
switch (job) {
case BINS:
wall_sort_particles();
break;
case MX:
realloc_doublelist(&g, g.n = n_configs);
calc_wallmsdx(g.e, bin);
break;
case MYZ:
realloc_doublelist(&g, g.n = n_configs);
calc_wallmsdyz(g.e, bin);
break;
case RDFYZ:
realloc_doublelist(&g, g.n = rbins);
calc_wallrdfyz(g.e, bin, rmin, rmax, rbins);
break;
case BONDYZ:
realloc_doublelist(&g, g.n = rbins+2);
calc_wallbondyz(g.e, bin, rclocal, rmax, rbins);
break;
case SCALE:
realloc_doublelist(&g, g.n = 3*pow(4,boxes));
calc_scaling (g.e,bin, boxes, rclocal);
break;
case SCALE2:
realloc_doublelist(&g, g.n = 14*pow(4,boxes));
calc_scaling2 (g.e,bin, boxes, rclocal);
break;
case PRINT:
// just write out what wall_sort_particles has put into
// this bin
for (int i = 1; i < wallstuff_part_in_bin[bin].n; i++) {
sprintf(buffer," %d",wallstuff_part_in_bin[bin].e[i]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
break;
}
// print out double results, if any
if (g.n) {
sprintf(buffer,"%f",g.e[0]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
for (int i = 1; i < g.n; i++) {
sprintf(buffer," %f",g.e[i]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
realloc_doublelist(&g, g.n = 0);
}
return (TCL_OK);
}
int tclcommand_metadynamics_parse_load_stat(Tcl_Interp *interp, int argc, char **argv){
/* Parse free energy profile and biased force that were provided from an
* earlier simulation. Allows one to restart from a loaded state, and can
* even be used to allow multiple walkers communicating their data through TCL. */
if(meta_switch == META_OFF) {
Tcl_AppendResult(interp, "Metadynamics hasn't been initialized yet", (char *)NULL);
return (TCL_ERROR);
}
argc -= 1; argv += 1;
// There should be
if (argc != 3) {
Tcl_AppendResult(interp, "Incorrect number of arguments: 'metadynamics load_stat <profile_list> <force_list>'", (char *)NULL);
return (TCL_ERROR);
}
// load free energy profile
int i, tmp_argc, parse_error = 0, empty_line=0;
char **tmp_argv;
DoubleList profile, force;
init_doublelist(&profile);
Tcl_ResetResult(interp);
Tcl_SplitList(interp, argv[1], &tmp_argc, (const char ***)&tmp_argv);
realloc_doublelist(&profile, profile.n = tmp_argc);
//printf("profile.n %d, meta_xi_num_bins %d\n",profile.n,meta_xi_num_bins);
/* Now check that the number of items parsed is equal to the number of bins */
/* If there's one extra line, assume it's an empty line */
if (profile.n == meta_xi_num_bins+1)
empty_line = 1;
else if (profile.n != meta_xi_num_bins) {
Tcl_AppendResult(interp, "Size of profile list loaded is different than expected from number of bins", (char *)NULL);
return (TCL_ERROR);
}
/* call meta_init() in case it has been loaded yet */
meta_init();
for(i = 0 ; i < tmp_argc-empty_line; i++) {
int tmp_argc2;
char **tmp_argv2;
Tcl_SplitList(interp, tmp_argv[i], &tmp_argc2, (const char ***)&tmp_argv2);
if (tmp_argc2 != 1) {
Tcl_AppendResult(interp, "data set has to be a list of doubles", (char *) NULL);
parse_error = 1; break;
}
if (Tcl_GetDouble(interp, tmp_argv2[0], &(profile.e[i])) == TCL_ERROR) { parse_error = 1; break; }
/* Load data into meta_acc_fprofile */
meta_acc_fprofile[i] = profile.e[i];
Tcl_Free((char *)tmp_argv2);
}
Tcl_Free((char *)tmp_argv);
if (parse_error) return TCL_ERROR;
// load force
argc -= 1; argv += 1;
init_doublelist(&force);
Tcl_ResetResult(interp);
Tcl_SplitList(interp, argv[1], &tmp_argc, (const char ***)&tmp_argv);
realloc_doublelist(&force, force.n = tmp_argc);
/* Now check that the number of items parsed is equal to the number of bins */
if (profile.n == meta_xi_num_bins+1)
empty_line = 1;
else if (profile.n != meta_xi_num_bins) {
Tcl_AppendResult(interp, "Size of force list loaded is different than expected from number of bins", (char *)NULL);
return (TCL_ERROR);
}
for(i = 0 ; i < tmp_argc-empty_line; i++) {
int tmp_argc2;
char **tmp_argv2;
Tcl_SplitList(interp, tmp_argv[i], &tmp_argc2, (const char ***)&tmp_argv2);
if (tmp_argc2 != 1) {
Tcl_AppendResult(interp, "data set has to be a list of doubles", (char *) NULL);
parse_error = 1; break;
}
if (Tcl_GetDouble(interp, tmp_argv2[0], &(force.e[i])) == TCL_ERROR) { parse_error = 1; break; }
/* Load data into meta_acc_fprofile */
meta_acc_force[i] = -1.*force.e[i];
Tcl_Free((char *)tmp_argv2);
}
Tcl_Free((char *)tmp_argv);
if (parse_error) return TCL_ERROR;
return (TCL_OK);
}
int tclcommand_bin(ClientData cdata, Tcl_Interp *interp,
int argc, char **argv)
{
DoubleList coords, data, count, sum, bins;
int i, num_bins, give_bincounts = 0;
double min_bin, max_bin, contr;
int w, s, e, c;
char buffer[2 + TCL_DOUBLE_SPACE];
init_doublelist(&coords);
init_doublelist(&data);
init_doublelist(&sum);
init_doublelist(&bins);
/* type of the binning */
if (argc > 1 && ARG1_IS_S("-stats")) {
give_bincounts = 1;
argc -= 1; argv += 1;
}
/* type of the binning */
if (argc > 2 && ARG1_IS_S("-bins")) {
if (!ARG_IS_DOUBLELIST(2, bins))
return TCL_ERROR;
argc -= 2; argv += 2;
}
else if (argc > 4 &&
(ARG1_IS_S("-linbins") || ARG1_IS_S("-logbins"))) {
if (!ARG_IS_D(2, min_bin) ||
!ARG_IS_D(3, max_bin) ||
!ARG_IS_I(4, num_bins))
return TCL_ERROR;
/* swap if necessary */
if (min_bin > max_bin) { double tmp = min_bin; min_bin = max_bin; max_bin = tmp; }
if (ARG1_IS_S("-linbins")) setup_linear_bins(&bins, min_bin, max_bin, num_bins);
else if (ARG1_IS_S("-logbins")) setup_log_bins(&bins, min_bin, max_bin, num_bins);
argc -= 4; argv += 4;
}
if (bins.n < 2) {
Tcl_AppendResult(interp, "please specify at least two bin boundaries", (char *) NULL);
return TCL_ERROR;
}
/* determine job to do */
if (argc == 2 && ARG1_IS_S("-binctrwdth")) {
/* just return the centers */
Tcl_PrintDouble(interp, .5*(bins.e[0] + bins.e[1]), buffer);
Tcl_AppendResult(interp, "{", buffer, (char *) NULL);
Tcl_PrintDouble(interp, bins.e[1] - bins.e[0], buffer);
Tcl_AppendResult(interp, " ", buffer, "}", (char *) NULL);
for (i = 1; i < bins.n - 1; i++) {
Tcl_PrintDouble(interp, .5*(bins.e[i] + bins.e[i+1]), buffer);
Tcl_AppendResult(interp, " {", buffer, (char *) NULL);
Tcl_PrintDouble(interp, bins.e[i+1] - bins.e[i], buffer);
Tcl_AppendResult(interp, " ", buffer, "}", (char *) NULL);
}
return TCL_OK;
}
else if (argc == 2) {
/* do the binning with bisection search algorithm */
/* check for the type of data */
if (!ARG1_IS_DOUBLELIST(coords)) {
int i, tmp_argc, parse_error = 0;
const char **tmp_argv;
Tcl_ResetResult(interp);
Tcl_SplitList(interp, argv[1], &tmp_argc, &tmp_argv);
realloc_doublelist(&coords, coords.n = tmp_argc);
realloc_doublelist(&data, data.n = tmp_argc);
for(i = 0 ; i < tmp_argc; i++) {
int tmp_argc2;
const char **tmp_argv2;
Tcl_SplitList(interp, tmp_argv[i], &tmp_argc2, &tmp_argv2);
if (tmp_argc2 != 2) {
Tcl_AppendResult(interp, "data set has to be either a list of doubles or of lists of 2 doubles", (char *) NULL);
parse_error = 1; break;
}
if (Tcl_GetDouble(interp, tmp_argv2[0], &(coords.e[i])) == TCL_ERROR) { parse_error = 1; break; }
if (Tcl_GetDouble(interp, tmp_argv2[1], &(data.e[i])) == TCL_ERROR) { parse_error = 1; break; }
Tcl_Free((char *)tmp_argv2);
}
Tcl_Free((char *)tmp_argv);
if (parse_error) return TCL_ERROR;
}
/* the binning itself */
alloc_doublelist(&count, count.n = bins.n - 1);
for (i = 0; i < count.n; i++) count.e[i] = 0;
if (data.n) {
alloc_doublelist(&sum, sum.n = bins.n - 1);
for (i = 0; i < sum.n; i++) sum.e[i] = 0;
}
for (i = 0; i < coords.n; i++) {
double cd = coords.e[i];
if (cd < bins.e[0] || cd > bins.e[bins.n-1])
continue;
s = 0; e = bins.n - 1;
while ((w = e - s) > 1) {
c = (e + s)/2;
if (cd >= bins.e[c]) s = c; else e = c;
}
count.e[s]++;
if (data.n)
sum.e[s] += data.e[i];
}
/* normalization */
contr = 1./coords.n;
for (i = 0; i < count.n; i++) {
if (data.n) {
if (count.e[i]) {
double tmp = sum.e[i]/count.e[i];
Tcl_PrintDouble(interp, tmp, buffer);
}
else
strcpy(buffer, "n/a");
}
else {
Tcl_PrintDouble(interp, count.e[i] * contr, buffer);
}
if (i == 0)
Tcl_AppendResult(interp, buffer, (char *) NULL);
else
Tcl_AppendResult(interp, " ", buffer, (char *) NULL);
if (give_bincounts) {
sprintf(buffer, "%d", (int)count.e[i]);
Tcl_AppendResult(interp, " ", buffer, (char *) NULL);
}
}
return TCL_OK;
}
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: bin -bins <binboundarylist> | "
"(-linbins|-logbins <start> <end> <num>) <data>|-binctrwdth\n", (char *) NULL);
Tcl_AppendResult(interp, " <data> is a list of doubles to bin or lists {coord data},"
" where data is to be averaged in each bin", (char *) NULL);
return TCL_ERROR;
}
