File:
[LON-CAPA] /
capa /
capa51 /
pProj /
capaFunction.c
Revision
1.15:
download - view:
text,
annotated -
select for diffs
Tue Sep 24 15:10:40 2002 UTC (22 years, 1 month ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- should be looking for a , when setting the seed
/* definition of all capa functions
Copyright (C) 1992-2000 Michigan State University
The CAPA system is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
The CAPA system is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public
License along with the CAPA system; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
As a special exception, you have permission to link this program
with the TtH/TtM library and distribute executables, as long as you
follow the requirements of the GNU GPL in regard to all of the
software in the executable aside from TtH/TtM.
*/
/* =||>>================================================================<<||= */
/* 45678901234567890123456789012345678901234567890123456789012345678901234567 */
/* by Isaac Tsai, 1996, 1997, 1998, 1999, 2000 */
/* =||>>================================================================<<||= */
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "capaParser.h" /* Symbol_p */
#include "capaFunction.h" /* RANDOM_F etc. */
#include "capaToken.h"
#include "capaCommon.h"
#include "ranlib.h"
char Parse_class[QUARTER_K];
int Parse_set;
int Parse_section;
char Parse_student_number[MAX_STUDENT_NUMBER+1];
char Parse_name[MAX_NAME_CHAR+1];
long capaid_plus_gen;
int managermode;
extern int Parsemode_f;
extern int Lexi_qnum;
extern char Opened_filename[MAX_OPENED_FILE][QUARTER_K];
extern int Input_idx;
extern int Current_line[MAX_OPENED_FILE];
extern int Func_idx;
extern Symbol FuncStack[MAX_FUNC_NEST];
#ifdef TTH
extern int textohtmldyn(char*,char**,char**,int);
char *tth_err;
#endif
/* --------------------------------------------------------------------------- */
int
match_function(func, argc) char *func; int argc;
{
if( !strcmp(func,"random") ) return (((argc==2 || argc==3)? RANDOM_F : MIS_ARG_COUNT));
if( !strcmp(func,"random_normal") ) return ((argc==5)? RANDOM_NORMAL_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_multivariate_normal") ) return ((argc==6)? RANDOM_MULTIVARIATE_NORMAL_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_beta") ) return ((argc==5)? RANDOM_BETA_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_gamma") ) return ((argc==5)? RANDOM_GAMMA_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_poisson") ) return ((argc==4)? RANDOM_POISSON_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_exponential") ) return ((argc==4)? RANDOM_EXPONENTIAL_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_chi") ) return ((argc==4)? RANDOM_CHI_F : MIS_ARG_COUNT);
if( !strcmp(func,"random_noncentral_chi") ) return ((argc==5)? RANDOM_NONCENTRAL_CHI_F : MIS_ARG_COUNT);
if( !strcmp(func,"choose") ) return (CHOOSE_F);
if( !strcmp(func,"tex") ) return (((argc==2)? TEX_F: MIS_ARG_COUNT));
if( !strcmp(func,"var_in_tex") ) return (VAR_IN_TEX_F);
if( !strcmp(func,"html") ) return (((argc==1)? HTML_F: MIS_ARG_COUNT));
if( !strcmp(func,"web") ) return (((argc==3)? WEB_F: MIS_ARG_COUNT));
if( !strcmp(func,"pin") ) return (((argc<2)? PIN_F: MIS_ARG_COUNT));
if( !strcmp(func,"capa_id") ) return (((argc<2)? PIN_F: MIS_ARG_COUNT));
if( !strcmp(func,"class") ) return (((argc==0)? CLASS_F: MIS_ARG_COUNT));
if( !strcmp(func,"section") ) return (((argc==0)? SECTION_F: MIS_ARG_COUNT));
if( !strcmp(func,"set") ) return (((argc==0)? SET_F: MIS_ARG_COUNT));
if( !strcmp(func,"problem") ) return (((argc==0)? PROBLEM_F: MIS_ARG_COUNT));
if( !strcmp(func,"name") ) return (((argc==0)? NAME_F: MIS_ARG_COUNT));
if( !strcmp(func,"student_number") ) return (((argc==0)? SNUMBER_F: MIS_ARG_COUNT));
if( !strcmp(func,"due_date") ) return (((argc<2)? DUE_DATE_F: MIS_ARG_COUNT));
if( !strcmp(func,"due_day") ) return (((argc<2)? DUE_DAY_F: MIS_ARG_COUNT));
if( !strcmp(func,"open_date") ) return (((argc<2)? OPEN_DATE_F: MIS_ARG_COUNT));
if( !strcmp(func,"answer_date") ) return (((argc<2)? ANSWER_DATE_F: MIS_ARG_COUNT));
if( !strcmp(func,"to_string") ) return (((argc==1 || argc==2)? TO_STRING_F: MIS_ARG_COUNT));
if( !strcmp(func,"sub_string") ) return (((argc==2 || argc==3)? SUB_STRING_F: MIS_ARG_COUNT));
if( !strcmp(func,"strlen") ) return (((argc==1)? STRLEN_F: MIS_ARG_COUNT));
if( !strcmp(func,"get_seed") ) return (((argc==0)? GET_SEED_F: MIS_ARG_COUNT));
if( !strcmp(func,"set_seed") ) return (((argc==1)? SET_SEED_F: MIS_ARG_COUNT));
if( !strcmp(func,"init_array") ) return (((argc==1)? INIT_ARRAY_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_index") ) return (((argc==1)? ARRAY_INDEX_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_sorted_index") ) return (((argc==2)? ARRAY_SORTED_INDEX_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_max") ) return (((argc==1)? ARRAY_MAX_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_min") ) return (((argc==1)? ARRAY_MIN_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_moments") ) return (((argc==2)? ARRAY_MOMENTS_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_var") ) return (((argc==1)? ARRAY_VARIANCE_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_std_dev") ) return (((argc==1)? ARRAY_STD_DEV_F: MIS_ARG_COUNT));
if( !strcmp(func,"array_skewness") ) return (((argc==1)? ARRAY_SKEWNESS_F: MIS_ARG_COUNT));
if( !strcmp(func,"to_int") ) return (((argc==1)? TO_INT_F: MIS_ARG_COUNT));
if( !strcmp(func,"format") ) return (FORMAT_F);
if( !strcmp(func,"pick") ) return (((argc> 1)? PICK_F: MIS_ARG_COUNT));
if( !strcmp(func,"sin") ) return (((argc==1)? SIN_F: MIS_ARG_COUNT));
if( !strcmp(func,"cos") ) return (((argc==1)? COS_F: MIS_ARG_COUNT));
if( !strcmp(func,"tan") ) return (((argc==1)? TAN_F: MIS_ARG_COUNT));
if( !strcmp(func,"asin") ) return (((argc==1)? ASIN_F: MIS_ARG_COUNT));
if( !strcmp(func,"acos") ) return (((argc==1)? ACOS_F: MIS_ARG_COUNT));
if( !strcmp(func,"atan") ) return (((argc==1)? ATAN_F: MIS_ARG_COUNT));
if( !strcmp(func,"sinh") ) return (((argc==1)? SINH_F: MIS_ARG_COUNT));
if( !strcmp(func,"cosh") ) return (((argc==1)? COSH_F: MIS_ARG_COUNT));
if( !strcmp(func,"tanh") ) return (((argc==1)? TANH_F: MIS_ARG_COUNT));
if( !strcmp(func,"asinh") ) return (((argc==1)? ASINH_F: MIS_ARG_COUNT));
if( !strcmp(func,"acosh") ) return (((argc==1)? ACOSH_F: MIS_ARG_COUNT));
if( !strcmp(func,"atanh") ) return (((argc==1)? ATANH_F: MIS_ARG_COUNT));
if( !strcmp(func,"atan2") ) return (((argc==2)? ATANTWO_F: MIS_ARG_COUNT));
if( !strcmp(func,"j0") ) return (((argc==1)? J_ZERO_F: MIS_ARG_COUNT));
if( !strcmp(func,"j1") ) return (((argc==1)? J_ONE_F: MIS_ARG_COUNT));
if( !strcmp(func,"jn") ) return (((argc==2)? J_N_F: MIS_ARG_COUNT));
if( !strcmp(func,"y0") ) return (((argc==1)? Y_ZERO_F: MIS_ARG_COUNT));
if( !strcmp(func,"y1") ) return (((argc==1)? Y_ONE_F: MIS_ARG_COUNT));
if( !strcmp(func,"yn") ) return (((argc==2)? Y_N_F: MIS_ARG_COUNT));
if( !strcmp(func,"log") ) return (((argc==1)? LOG_F: MIS_ARG_COUNT));
if( !strcmp(func,"log10") ) return (((argc==1)? LOG_TEN_F: MIS_ARG_COUNT));
if( !strcmp(func,"exp") ) return (((argc==1)? EXP_F: MIS_ARG_COUNT));
if( !strcmp(func,"pow") ) return (((argc==2)? POW_F: MIS_ARG_COUNT));
if( !strcmp(func,"erf") ) return (((argc==1)? ERF_F: MIS_ARG_COUNT));
if( !strcmp(func,"erfc") ) return (((argc==1)? ERFC_F: MIS_ARG_COUNT));
if( !strcmp(func,"sqrt") ) return (((argc==1)? SQRT_F: MIS_ARG_COUNT));
if( !strcmp(func,"min") ) return (MIN_F);
if( !strcmp(func,"max") ) return (MAX_F);
if( !strcmp(func,"abs") ) return (((argc==1)? ABS_F: MIS_ARG_COUNT));
if( !strcmp(func,"floor") ) return (((argc==1)? FLOOR_F: MIS_ARG_COUNT));
if( !strcmp(func,"ceil") ) return (((argc==1)? CEIL_F: MIS_ARG_COUNT));
if( !strcmp(func,"sgn") ) return (((argc==1)? SGN_F: MIS_ARG_COUNT));
if( !strcmp(func,"mod") ) return (((argc==2)? MOD_F: MIS_ARG_COUNT));
if( !strcmp(func,"remainder") ) return (((argc==2)? REMAINDER_F: MIS_ARG_COUNT));
if( !strcmp(func,"factorial") ) return (((argc==1)? FACTORIAL_F: MIS_ARG_COUNT));
if( !strcmp(func,"roundto") ) return (((argc==2)? ROUNDTO_F: MIS_ARG_COUNT));
if( !strcmp(func,"eval_formula") ) return (((argc==3)? EVALUATE_F: MIS_ARG_COUNT));
if( !strcmp(func,"capa_id_plus") ) return (((argc==1 || argc==2)? CAPAID_PLUS: MIS_ARG_COUNT));
if( !strcmp(func,"seat_number") ) return (((argc <2)? SEAT_NUMBER: MIS_ARG_COUNT));
if( !strcmp(func,"duration") ) return (((argc==0)? DURATION: MIS_ARG_COUNT));
if( !strcmp(func,"is_open") ) return (((argc <2)? IS_OPEN_F: MIS_ARG_COUNT));
if( !strcmp(func,"is_due") ) return (((argc <2)? IS_DUE_F: MIS_ARG_COUNT));
if( !strcmp(func,"is_answer") ) return (((argc <2)? IS_ANSWER_F: MIS_ARG_COUNT));
if( !strcmp(func,"correct") ) return (((argc <3)? CORRECT_F: MIS_ARG_COUNT));
if( !strcmp(func,"grade") ) return (((argc <3)? GRADE_F: MIS_ARG_COUNT));
if( !strcmp(func,"tries") ) return (((argc <3)? TRIES_F: MIS_ARG_COUNT));
if( !strcmp(func,"managermode")) return (((argc==0)? MANAGERMODE_F:MIS_ARG_COUNT));
return (UNKNOWN_F);
}
/**********************************************************/
#ifdef SGN
#undef SGN
#endif
#define SGN(xx) ( (xx) > 0 ? 1 : ( (xx) == 0 ? 0 : -1) )
#define MAX_DOUBLE 1.7976931348623157E+308
#define MIN_DOUBLE 2.2250738585072014E-308
#define INT_DIV 0
#define REAL_DIV 1
#define INT_LOWER 0
#define REAL_LOWER 2
#define INT_UPPER 0
#define REAL_UPPER 4
#define ALL_INTEGER 0
int which_set(argc,argp,resultp)
int argc;
ArgNode_t *argp;
Symbol *resultp;
{
char aline[MAX_BUFFER_SIZE], tmpS[MAX_BUFFER_SIZE];
int result=Parse_set;
if( argc == 1 ) {
if( (FIRST_ARGTYPE(argp) == S_VAR ) ||
(FIRST_ARGTYPE(argp) == S_CONSTANT ) ) {
sprintf(aline,"<<ARG TYPE MISMATCH>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS, "function %s() cannot accept string as argument.\n",
FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
result=-1;
} else {
if( (FIRST_ARGTYPE(argp) == I_VAR ) ||
(FIRST_ARGTYPE(argp) == I_CONSTANT ) ) {
result = FIRST_ARGINT(argp);
} else {
result = FIRST_ARGREAL(argp);
}
}
}
return result;
}
Symbol *
do_function(func,argc,argp)
int func;
int argc;
ArgNode_t *argp;
{
Symbol *resultp;
ArgNode_t *tmpArgp;
char aline[MAX_BUFFER_SIZE], tmpS[MAX_BUFFER_SIZE], fmt_str[FORMAT_STRING_LENG];
char num_str[SMALL_LINE_BUFFER],date_str[SMALL_LINE_BUFFER];
double tmpA=0.0, tmpB=0.0;
int slots, noError, errCode, mo, yy, dd, hh, mm, tmpInt;
long rout;
char *wday[9] = {"Sat,", "Sun,", "Mon,", "Tue,", "Wed,", "Thr,", "Fri,", "Sat,", "\0"};
char *month[14] = { "UNKNOWN", "Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec", "\0"};
resultp = (Symbol *)capa_malloc(1,sizeof(Symbol));
switch(func) {
case RANDOM_F: { int type_flag=0;
double r_lower=0.0, r_upper=1.0, r_division=1.0;
errCode = 0; rout = ignlgi();
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT: break;
case R_VAR: case R_CONSTANT: type_flag = (type_flag | 1); break;
case S_VAR: case S_CONSTANT: errCode = 1; break;
}
switch( SECOND_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT: break;
case R_VAR: case R_CONSTANT: type_flag = (type_flag | 2); break;
case S_VAR: case S_CONSTANT: errCode = 2; break;
}
if( argc == 3 ) {
switch( THIRD_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT: break;
case R_VAR: case R_CONSTANT: type_flag = (type_flag | 4); break;
case S_VAR: case S_CONSTANT: errCode = 4; break;
}
}
if( errCode == 0 ) {
if( argc == 3 ) {
switch(type_flag) {
case 0: r_division = (double)FIRST_ARGINT(argp);
r_upper = (double)SECOND_ARGINT(argp);
r_lower = (double)THIRD_ARGINT(argp); break;
case 2: r_division = (double)FIRST_ARGINT(argp);
r_upper = SECOND_ARGREAL(argp);
r_lower = (double)THIRD_ARGINT(argp); break;
case 4: r_division = (double)FIRST_ARGINT(argp);
r_upper = (double)SECOND_ARGINT(argp);
r_lower = THIRD_ARGREAL(argp); break;
case 6: r_division = (double)FIRST_ARGINT(argp);
r_upper = SECOND_ARGREAL(argp);
r_lower = THIRD_ARGREAL(argp); break;
case 1: r_division = FIRST_ARGREAL(argp);
r_upper = (double)SECOND_ARGINT(argp);
r_lower = (double)THIRD_ARGINT(argp); break;
case 3: r_division = FIRST_ARGREAL(argp);
r_upper = SECOND_ARGREAL(argp);
r_lower = (double)THIRD_ARGINT(argp); break;
case 5: r_division = FIRST_ARGREAL(argp);
r_upper = (double)SECOND_ARGINT(argp);
r_lower = THIRD_ARGREAL(argp); break;
case 7: r_division = FIRST_ARGREAL(argp);
r_upper = SECOND_ARGREAL(argp);
r_lower = THIRD_ARGREAL(argp); break;
}
} else { /* two args */
switch(type_flag) {
case 0: r_upper = (double)FIRST_ARGINT(argp);
r_lower = (double)SECOND_ARGINT(argp); break;
case 1: r_upper = FIRST_ARGREAL(argp);
r_lower = (double)SECOND_ARGINT(argp); break;
case 2: r_upper = (double)FIRST_ARGINT(argp);
r_lower = SECOND_ARGREAL(argp); break;
case 3: r_upper = FIRST_ARGREAL(argp);
r_lower = SECOND_ARGREAL(argp); break;
}
r_division = 1.0;
}
if( r_upper >= r_lower ) {
slots = 1 + (int)floor( (r_upper - r_lower)/r_division );
if( type_flag == 0 ) {
resultp->s_type = I_CONSTANT;
resultp->s_int = (int)r_lower + ((int)r_division)*(rout % slots );
} else {
resultp->s_type = R_CONSTANT;
resultp->s_real = r_lower + r_division*(double)(rout % slots );
}
} else {
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<2ND ARG MUST .GE. 1ST ARG>>");
sprintf(tmpS,"random()'s second arg. must be greater than the first arg.\n");
capa_msg(MESSAGE_ERROR,tmpS);
}
} else {
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARG CANNOT BE STRING>>");
sprintf(tmpS,"random() cannot accept string as argument.\n");
capa_msg(MESSAGE_ERROR,tmpS);
}
} break;
case CHOOSE_F: { int ii, pick=1;
ArgNode_t *tmpArgp;
noError = 1;
tmpArgp = argp; ii=0;
while( ii < argc-1 ) {tmpArgp = tmpArgp->a_next; ii++; }
switch( FIRST_ARGTYPE(tmpArgp) ) {
case IDENTIFIER:
sprintf(tmpS,"The first argument to choose(): \"%s\" has not been defined yet. I will choose the first element.\n",FIRST_ARGNAME(tmpArgp));
capa_msg(MESSAGE_ERROR,tmpS);
pick = 1;
break;
case I_VAR: case I_CONSTANT:
pick = FIRST_ARGINT(tmpArgp); break;
case R_VAR: case R_CONSTANT:
pick = (int)FIRST_ARGREAL(tmpArgp);
sprintf(tmpS,"The first argument to choose() is a real number: \"%.15g\", it must be an integer, I will use %d instead.\n",FIRST_ARGREAL(tmpArgp),pick);
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR: case S_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("CHOOSE: first argument must be an integer");
sprintf(tmpS,"The first argument to choose() cannot be a string, I will choose the first element.\n");
capa_msg(MESSAGE_ERROR,tmpS);
pick = 1;
break;
}
if( noError ) {
if( (pick <= 0) || (pick > argc-1) ) {
sprintf(tmpS,"The first argument to choose() is out of bounds, tt is %d, but should be in the range [1,%d].\n", pick, argc-1);
capa_msg(MESSAGE_ERROR,tmpS);
pick = argc-1;
} else { pick = argc - pick; }
for(ii=1,tmpArgp = argp;(ii < pick)&&(ii < argc-1);ii++) { tmpArgp = tmpArgp->a_next; }
resultp->s_type = (tmpArgp->a_sp)->s_type;
switch((tmpArgp->a_sp)->s_type) {
case IDENTIFIER:
sprintf(tmpS,"The variable \"%s\" selected by choose() has not yet been defined.\n",(tmpArgp->a_sp)->s_name);
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(tmpS);
break;
case I_VAR: case I_CONSTANT:
resultp->s_type = I_CONSTANT;
resultp->s_int = (tmpArgp->a_sp)->s_int; break;
case R_VAR: case R_CONSTANT:
resultp->s_type = R_CONSTANT;
resultp->s_real = (tmpArgp->a_sp)->s_real; break;
case S_VAR: case S_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave((tmpArgp->a_sp)->s_str); break; /********* */
}
}
} break;
case PIN_F: {
if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
resultp->s_type = I_CONSTANT;
resultp->s_int=capa_PIN(Parse_student_number,tmpInt,0);
}
break;
case CLASS_F: {
resultp->s_type = S_CONSTANT;
if(strlen(Parse_class) != 0 ) {
resultp->s_str=strsave(Parse_class);
} else {
resultp->s_str=strsave("UNKNOWN");
}
}
break;
case SECTION_F:{ resultp->s_type = I_CONSTANT;
resultp->s_int = Parse_section;
} break;
case PROBLEM_F:{ resultp->s_type = I_CONSTANT;
resultp->s_int= Lexi_qnum+1;
} break;
case SET_F: { resultp->s_type = I_CONSTANT;
resultp->s_int=Parse_set;
} break;
case NAME_F: {
resultp->s_type = S_CONSTANT;
resultp->s_str=strsave(Parse_name);
} break;
case SNUMBER_F: {
resultp->s_type = S_CONSTANT;
resultp->s_str=strsave(Parse_student_number);
} break;
case IS_DUE_F:
case IS_ANSWER_F:
case IS_OPEN_F: {
int whichDate=CHECK_OPEN_DATE;
if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
resultp->s_type = I_CONSTANT;
switch(func) {
case IS_OPEN_F: whichDate=CHECK_OPEN_DATE;break;
case IS_DUE_F: whichDate=CHECK_DUE_DATE;break;
case IS_ANSWER_F: whichDate=CHECK_ANS_DATE;break;
}
if( capa_check_date(whichDate,Parse_student_number,
Parse_section,tmpInt) < 0 ) {
resultp->s_int = 0;
} else {
resultp->s_int = 1;
}
} break;
case DUE_DATE_F:
{ if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
resultp->s_type = S_CONSTANT;
if(capa_get_date(CHECK_DUE_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mo, &dd, &hh, &mm);
sprintf(aline, "%s %s %2d, %4d at %02d:%02d",
wday[weekday(yy,mo,dd)], month[mo], dd, yy, hh, mm);
resultp->s_str= strsave(aline);
} else {
resultp->s_str= strsave("UNKNOWN");
}
} break;
case DUE_DAY_F:
{ if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
resultp->s_type = S_CONSTANT;
if(capa_get_date(CHECK_DUE_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mm, &dd, &hh, &mm);
sprintf(aline, "%s %s %2d, %4d",
wday[weekday(yy,mo,dd)], month[mo], dd, yy);
resultp->s_str= strsave(aline);
} else {
resultp->s_str= strsave("UNKNOWN");
}
} break;
case OPEN_DATE_F:
{ if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
resultp->s_type = S_CONSTANT;
if(capa_get_date(CHECK_OPEN_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mm, &dd, &hh, &mm);
sprintf(aline, "%s %s %2d, %4d at %02d:%02d",
wday[weekday(yy,mo,dd)], month[mo], dd, yy, hh, mm);
resultp->s_str= strsave(aline);
} else {
resultp->s_str= strsave("UNKNOWN");
}
} break;
case ANSWER_DATE_F:
{ if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
resultp->s_type = S_CONSTANT;
if(capa_get_date(CHECK_ANS_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mo, &dd, &hh, &mm);
sprintf(aline, "%s %s %2d, %4d at %02d:%02d",
wday[weekday(yy,mo,dd)], month[mo], dd, yy, hh, mm);
resultp->s_str= strsave(aline);
} else {
resultp->s_str= strsave("UNKNOWN");
}
} break;
case STRLEN_F: {
resultp->s_type = I_CONSTANT;
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR:
case I_CONSTANT:
resultp->s_type = S_CONSTANT;
sprintf(tmpS,"strlen() only accepts string variable, not integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_str=strsave(tmpS);
break;
case R_VAR:
case R_CONSTANT:
resultp->s_type = S_CONSTANT;
sprintf(tmpS,"strlen() only accepts string variable, not float number.\n");
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_str=strsave(tmpS);
break;
case S_VAR:
case S_CONSTANT:
resultp->s_int = strlen( FIRST_ARGSTR(argp) );
break;
case IDENTIFIER:
sprintf(tmpS,"Unknown variable, %s, argument to function strlen()\n",argp->a_sp->s_name);
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_str=strsave(tmpS);
break;
}
} break;
case TO_STRING_F:
{ char aline[MAX_BUFFER_SIZE],rline[MAX_BUFFER_SIZE];
resultp->s_type = S_CONSTANT;
if( argc == 1 ) {
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR:
case I_CONSTANT:
sprintf(aline,"%ld",FIRST_ARGINT(argp));
resultp->s_str = strsave(aline); break;
case R_VAR:
case R_CONSTANT:
sprintf(aline,"%.15g",FIRST_ARGREAL(argp));
resultp->s_str = strsave(aline); break;
case S_VAR:
case S_CONSTANT:
resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
case IDENTIFIER:
sprintf(tmpS,"Unknown variable, %s, argument to function to_string()\n",argp->a_sp->s_name);
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_str=strsave(tmpS);
break;
}
} else {
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR:
case I_CONSTANT:
case R_VAR:
case R_CONSTANT:
sprintf(tmpS,
"to_string()'s second arg. must be a string.\n");
capa_msg(MESSAGE_ERROR,tmpS);
sprintf(aline,"%%.15g");
break;
case S_VAR:
case S_CONSTANT:
sprintf(aline,"%%%s",FIRST_ARGSTR(argp));
break;
case IDENTIFIER:
sprintf(tmpS,"Unknown variable, %s, argument to function to_string()\n",argp->a_next->a_sp->s_name);
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_str=strsave(tmpS);
break;
}
switch( SECOND_ARGTYPE(argp) ) {
case I_VAR:
case I_CONSTANT:
sprintf(aline,"%ld",SECOND_ARGINT(argp));
resultp->s_str = strsave(aline); break;
case R_VAR:
case R_CONSTANT:
sprintf(rline,aline,SECOND_ARGREAL(argp));
resultp->s_str = strsave(rline); break;
case S_VAR:
case S_CONSTANT:
resultp->s_str = strsave(SECOND_ARGSTR(argp));
break;
case IDENTIFIER:
sprintf(tmpS,"Unknown variable, %s, argument to function to_string()\n",argp->a_sp->s_name);
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_str=strsave(tmpS);
break;
}
}
} break;
case SUB_STRING_F: /* sub_string(str, 2), 1 is the first char */
/* sub_string(str, 3, 5) means start from the third char and take 5 chars */
{ int idx=1, leng, rleng=0,ii;
char *a_str, *b_str;
resultp->s_type = S_CONSTANT;
if( argc == 2 ) { /* two arguments format */
switch( FIRST_ARGTYPE(argp) ) {
case IDENTIFIER:
sprintf(tmpS,
"sub_string()'s second arg. must be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case I_VAR:
case I_CONSTANT:
idx = FIRST_ARGINT(argp);
break;
case R_VAR:
case R_CONSTANT:
idx = (int) FIRST_ARGREAL(argp);
break;
case S_VAR:
case S_CONSTANT:
sprintf(tmpS,
"sub_string()'s second arg. must be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
switch( SECOND_ARGTYPE(argp) ) {
case IDENTIFIER:
sprintf(tmpS,
"sub_string()'s first arg. is not defined before use.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case I_VAR:
case I_CONSTANT:
sprintf(tmpS,
"sub_string()'s first arg. cannot be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case R_VAR:
case R_CONSTANT:
sprintf(tmpS,
"sub_string()'s first arg. cannot be a number.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR:
case S_CONSTANT:
a_str = SECOND_ARGSTR(argp);
leng = strlen(a_str);
if( (idx<1) || (idx > leng) ) {
sprintf(tmpS, "sub_string()'s second arg. is out of range.\n");
capa_msg(MESSAGE_ERROR,tmpS);
idx = 1;
}
b_str = (char *)&a_str[idx-1];
resultp->s_str = strsave(b_str);
if( SECOND_ARGTYPE(argp) == S_CONSTANT) {
/* freed in free arg_list */
/* capa_mfree((char *)SECOND_ARGSTR(argp)); */
}
break;
}
} else { /* three arguments format sub_string(string, start, length) */
switch( FIRST_ARGTYPE(argp) ) {
case IDENTIFIER:
sprintf(tmpS,
"sub_string()'s third arg. must be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case I_VAR:
case I_CONSTANT:
rleng = FIRST_ARGINT(argp);
break;
case R_VAR:
case R_CONSTANT:
rleng = (int) FIRST_ARGREAL(argp);
break;
case S_VAR:
case S_CONSTANT:
sprintf(tmpS,
"sub_string()'s third arg. must be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
switch( SECOND_ARGTYPE(argp) ) {
case IDENTIFIER:
sprintf(tmpS,
"sub_string()'s second arg. must be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case I_VAR:
case I_CONSTANT:
idx = SECOND_ARGINT(argp);
break;
case R_VAR:
case R_CONSTANT:
idx = (int) SECOND_ARGREAL(argp);
break;
case S_VAR:
case S_CONSTANT:
sprintf(tmpS,
"sub_string()'s second arg. must be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
switch( THIRD_ARGTYPE(argp) ) {
case IDENTIFIER:
sprintf(tmpS,
"sub_string()'s first arg. is not defined before use.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case I_VAR:
case I_CONSTANT:
sprintf(tmpS,
"sub_string()'s first arg. cannot be an integer.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case R_VAR:
case R_CONSTANT:
sprintf(tmpS,
"sub_string()'s first arg. cannot be a number.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR:
case S_CONSTANT:
a_str = THIRD_ARGSTR(argp);
leng = strlen(a_str);
if( (idx < 1) || (idx > leng) ) {
sprintf(tmpS, "sub_string()'s second arg. is out of range.\n");
capa_msg(MESSAGE_ERROR,tmpS);
idx = 1;
}
if( (rleng<1) || ((rleng+idx-1) > leng)) {
rleng = leng - idx + 1;
}
b_str = (char *)capa_malloc((rleng+1)*sizeof(char),1);
for(ii=idx-1;ii<(rleng+idx-1);ii++) {
b_str[ii-idx+1] = a_str[ii];
}
resultp->s_str = strsave(b_str);
capa_mfree(b_str);
if( THIRD_ARGTYPE(argp) == S_CONSTANT) {
/* handled in free_arglist() */
/* capa_mfree((char *)THIRD_ARGSTR(argp)); */
}
break;
}
}
} break;
case PICK_F: { int ii, pick=1;
ArgNode_t *tmpArgp;
noError = 1;
rout = ignlgi();
tmpArgp = argp; ii=0;
while( ii < argc-1 ) {tmpArgp = tmpArgp->a_next; ii++; }
switch( FIRST_ARGTYPE(tmpArgp) ) {
case I_VAR:
case I_CONSTANT:
pick = FIRST_ARGINT(tmpArgp);
if( (pick <= 0 ) || (pick > argc-1) ) {
noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("PICK: first arg out of bound.");
}
break;
case R_VAR:
case R_CONSTANT:
pick = (int)FIRST_ARGREAL(tmpArgp);
if( (pick <= 0 ) || (pick > argc-1) ) {
noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("PICK: first arg out of bound.");
}
break;
case S_VAR:
case S_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("PICK: first arg must be int");
break;
}
if( noError ) {
for( ii=0; ii< pick; ii++) {
}
}
}
break;
case GET_SEED_F:
{ long seed1, seed2;
char *tmp;
getsd(&seed1,&seed2);
tmp = (char *)capa_malloc(32,1);
sprintf(tmp,"%ld,%ld",seed1,seed2);
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(tmp);
capa_mfree(tmp);
} break;
case SET_SEED_F:
{ long seed1, seed2;
int leng;
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT: break;
case R_VAR: case R_CONSTANT: break;
case S_VAR: case S_CONSTANT:
leng = strlen(FIRST_ARGSTR(argp));
if( (index(FIRST_ARGSTR(argp), ',') != NULL) ) {
sscanf(FIRST_ARGSTR(argp),"%ld,%ld", &seed1, &seed2);
setall(seed1,seed2);
}
break;
}
resultp->s_type = I_CONSTANT;
resultp->s_int = 0;
} break;
/* generate random numbers according to a pre-defined distributions and a seed */
case RANDOM_MULTIVARIATE_NORMAL_F:
/* random_multivariate_normal(return_array,item_cnt,seed,dimen,mean_vector,covariance_vector) */
/* the dimension of both mean_vector and covariance_vector should be the same as item_cnt */
/* It will return item_cnt numbers in standard normal deviate in return_array */
/* item_cnt, seed, dimen, mean_vec, cov_vec
are all destroyed after this function !!!*/
{ char *mean_vec_str, *cov_vec_str, *seed_str, *out_vec_str;
int dimen, item_cnt, tmp_int;
long tmp_long;
Symbol *r_p;
errCode = 0;
switch( FIRST_ARGTYPE(argp) ) { /* parameter one covariance_matrix of size dimen*dimen */
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"%s()'s last arg. must be an array name.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
cov_vec_str = strsave( FIRST_ARGSTR(argp) );
break;
case IDENTIFIER:
cov_vec_str = strsave( FIRST_ARGNAME(argp) );
/*
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE AN ARRAY WITH DATA>>");
sprintf(tmpS,"%s()'s last arg. must be an array with data (covariance array).\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
*/
break;
}
if(errCode == 0) {
switch( SECOND_ARGTYPE(argp) ) { /* parameter two mean_vector */
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<THE FIFTH ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"%s()'s fifth arg. must be an array name.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
mean_vec_str = strsave( SECOND_ARGSTR(argp) );
break;
case IDENTIFIER:
mean_vec_str = strsave( SECOND_ARGNAME(argp) );
/*
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<THE FIFTH ARG. OF THIS FUNCTION MUST BE AN ARRAY WITH DATA>>");
sprintf(tmpS,"%s()'s fifth arg. must be an array with data (mean array).\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
*/
break;
}
if(errCode == 0 ) {
switch( THIRD_ARGTYPE(argp) ) { /* parameter three dimen */
case I_VAR: case I_CONSTANT:
dimen = THIRD_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
dimen = (int)THIRD_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<THE FOURTH ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s fourth arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) { /* parameter four seed */
switch( FOURTH_ARGTYPE(argp) ) { /* seed */
case I_VAR: case I_CONSTANT:
seed_str = (char *)capa_malloc(32,1);
sprintf(seed_str,"%ld",FOURTH_ARGINT(argp) );
break;
case R_VAR: case R_CONSTANT:
tmp_long = (long)FOURTH_ARGREAL(argp);
seed_str = (char *)capa_malloc(32,1);
sprintf(seed_str,"%ld",tmp_long);
break;
case S_VAR: case S_CONSTANT:
seed_str = strsave(FOURTH_ARGSTR(argp));
break;
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<THIRD ARG. OF THIS FUNCTION MUST BE A NUMBER OR STRING>>");
sprintf(tmpS,"%s()'s third arg. must be a number or a string.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( FIFTH_ARGTYPE(argp) ) { /* parameter five item_cnt */
case I_VAR: case I_CONSTANT:
item_cnt = FIFTH_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
item_cnt = (int)FIFTH_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<SECOND ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s second arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) { /* array_name, clear the content of this array first */
switch( SIXTH_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<FIRST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"%s()'s first arg. must be a name of an array.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
tmp_int = free_array(SIXTH_ARGSTR(argp));
out_vec_str= strsave(SIXTH_ARGSTR(argp));
break;
case IDENTIFIER:
tmp_int = free_array(SIXTH_ARGNAME(argp));
out_vec_str= strsave(SIXTH_ARGNAME(argp));
break;
} /* send switch */
} /* end if array_name check */
} /* end if (item_cnt) check */
} /* end if (seed) check */
} /* end if (dimen) check */
} /* end if (mean_vector) check */
if(errCode == 0 ) { /* all the parameter checks OK */
r_p = gen_multivariate_normal(out_vec_str,seed_str,item_cnt,dimen,mean_vec_str,cov_vec_str);
capa_mfree((char *)resultp);
resultp = r_p;
}
if( out_vec_str != NULL ) capa_mfree((char *)out_vec_str);
if( seed_str != NULL ) capa_mfree((char *)seed_str);
if( mean_vec_str != NULL ) capa_mfree((char *)mean_vec_str);
if( cov_vec_str != NULL ) capa_mfree((char *)cov_vec_str);
} break;
case RANDOM_NORMAL_F: /* random_normal(return_array,item_cnt,seed,av,std_dev) */
case RANDOM_BETA_F: /* random_beta(return_array,item_cnt,seed,aa,bb) */
case RANDOM_GAMMA_F: /* random_gamma(return_array,item_cnt,seed,a,r) */
case RANDOM_POISSON_F: /* random_poisson(return_array,item_cnt,seed,mu) */
case RANDOM_EXPONENTIAL_F:
/* random_exponential(return_array,item_cnt,seed,av) */
case RANDOM_CHI_F: /* random_chi(return_array,item_cnt,seed,df) */
case RANDOM_NONCENTRAL_CHI_F:
/* random_noncentral_chi(return_array,item_cnt,seed,df,xnonc) */
/* gen_random_by_selector(output_p,sel,seed,item_cnt,p1,p2) */
{ int sel, item_cnt, tmp_int;
float para1, para2;
char *tmp_str;
long tmp_long;
Symbol *r_p;
switch(func) { /* assigns the function selector */
case RANDOM_NORMAL_F: sel = NORMAL_DIS; break;
case RANDOM_BETA_F: sel = BETA_DIS; break;
case RANDOM_GAMMA_F: sel = GAMMA_DIS; break;
case RANDOM_POISSON_F: sel = POISSON_DIS; break;
case RANDOM_EXPONENTIAL_F: sel = EXPONENTIAL_DIS; break;
case RANDOM_CHI_F: sel = CHI_DIS; break;
case RANDOM_NONCENTRAL_CHI_F: sel = NONCENTRAL_CHI_DIS; break;
}
switch(func) {
case RANDOM_NORMAL_F:
case RANDOM_BETA_F:
case RANDOM_GAMMA_F: /* two-parameter functions */
case RANDOM_NONCENTRAL_CHI_F:
{ errCode = 0;
switch( FIRST_ARGTYPE(argp) ) { /* parameter two */
case I_VAR: case I_CONSTANT:
para2 = (float)FIRST_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
para2 = (float)FIRST_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s last arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( SECOND_ARGTYPE(argp) ) { /* parameter one */
case I_VAR: case I_CONSTANT:
para1 = (float)SECOND_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
para1 = (float)SECOND_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<FOURTH ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s fourth arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( THIRD_ARGTYPE(argp) ) { /* seed */
case I_VAR: case I_CONSTANT:
tmp_str = (char *)capa_malloc(32,1);
sprintf(tmp_str,"%ld",THIRD_ARGINT(argp) );
break;
case R_VAR: case R_CONSTANT:
tmp_long = (long)THIRD_ARGREAL(argp);
tmp_str = (char *)capa_malloc(32,1);
sprintf(tmp_str,"%ld",tmp_long);
break;
case S_VAR: case S_CONSTANT:
tmp_str = strsave(THIRD_ARGSTR(argp));
break;
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<THIRD ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s third arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( FOURTH_ARGTYPE(argp) ) { /* item_cnt */
case I_VAR: case I_CONSTANT:
item_cnt = FOURTH_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
item_cnt = (int)FOURTH_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<SECOND ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s second arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( FIFTH_ARGTYPE(argp) ) { /* array_name, clear the content of this array first */
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<FIRST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"%s()'s first arg. must be a name of an array.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
tmp_int = free_array(FIFTH_ARGSTR(argp));
r_p = gen_random_by_selector(FIFTH_ARGSTR(argp),sel,tmp_str,item_cnt,para1,para2);
capa_mfree((char *)resultp);
resultp = r_p;
break;
case IDENTIFIER:
tmp_int = free_array(FIFTH_ARGNAME(argp));
r_p = gen_random_by_selector(FIFTH_ARGNAME(argp),sel,tmp_str,item_cnt,para1,para2);
capa_mfree((char *)resultp);
resultp = r_p;
break;
}
} /* the fourth argument of this function (item_cnt) */
} /* the third argument of this function (seed) */
} /* the second argument of this function (paramenter one) */
} /* the first argument of this function (parameter two) */
}
break;
case RANDOM_POISSON_F:
case RANDOM_EXPONENTIAL_F:
case RANDOM_CHI_F: /* one parameter functions */
{ errCode = 0;
switch( FIRST_ARGTYPE(argp) ) { /* parameter one */
case I_VAR: case I_CONSTANT:
para1 = (float)FIRST_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
para1 = (float)FIRST_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s last arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( SECOND_ARGTYPE(argp) ) { /* seed */
case I_VAR: case I_CONSTANT:
tmp_str = (char *)capa_malloc(32,1);
sprintf(tmp_str,"%ld",SECOND_ARGINT(argp) );
break;
case R_VAR: case R_CONSTANT:
tmp_long = (long)SECOND_ARGREAL(argp);
tmp_str = (char *)capa_malloc(32,1);
sprintf(tmp_str,"%ld",tmp_long);
break;
case S_VAR: case S_CONSTANT:
tmp_str = strsave(SECOND_ARGSTR(argp));
break;
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<THIRD ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s third arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( THIRD_ARGTYPE(argp) ) { /* item_cnt */
case I_VAR: case I_CONSTANT:
item_cnt = THIRD_ARGINT(argp);
break;
case R_VAR: case R_CONSTANT:
item_cnt = (int)THIRD_ARGREAL(argp);
break;
case S_VAR: case S_CONSTANT:
case IDENTIFIER:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<SECOND ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
sprintf(tmpS,"%s()'s second arg. must be a number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
}
if(errCode == 0 ) {
switch( FOURTH_ARGTYPE(argp) ) { /* array_name, clear the content of this array first */
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<FIRST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"%s()'s first arg. must be a name of an array.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
tmp_int = free_array(FOURTH_ARGSTR(argp));
r_p = gen_random_by_selector(FOURTH_ARGSTR(argp),sel,tmp_str,item_cnt,para1,para2);
capa_mfree((char *)resultp);
resultp = r_p;
break;
case IDENTIFIER:
tmp_int = free_array(FOURTH_ARGNAME(argp));
r_p = gen_random_by_selector(FOURTH_ARGNAME(argp),sel,tmp_str,item_cnt,para1,para2);
capa_mfree((char *)resultp);
resultp = r_p;
break;
}
} /* the third argument of this function (seed) */
} /* the second argument of this function (paramenter one) */
} /* the first argument of this function (parameter two) */
}
break;
} /* end second switch */
} break;
case ARRAY_MOMENTS_F: /* array_moments(output,input) */
{
char *tmp_input;
Symbol *r_p;
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"array_moments()'s arg. must be a name of an array.\n");
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
tmp_input = strsave(FIRST_ARGSTR(argp));
errCode = 0;
break;
case IDENTIFIER:
tmp_input = strsave(FIRST_ARGNAME(argp));
errCode = 0;
break;
}
if( errCode == 0 ) {
switch( SECOND_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"array_moments()'s arg. must be a name of an array.\n");
capa_msg(MESSAGE_ERROR,tmpS);
errCode = 1;
break;
case S_VAR: case S_CONSTANT:
r_p = array_moments(SECOND_ARGSTR(argp),tmp_input);
capa_mfree((char *)tmp_input);
/* fprintf(stdout,"DONE array_moments()\n"); fflush(stdout); */
break;
case IDENTIFIER:
r_p = array_moments(SECOND_ARGNAME(argp),tmp_input);
capa_mfree((char *)tmp_input);
break;
}
if(errCode == 0 ) {
capa_mfree((char *)resultp);
resultp = r_p;
}
}
} break;
case ARRAY_SORTED_INDEX_F: /* array_sorted_index(array_name_str, sort_type) */
{
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT:
switch( FIRST_ARGINT(argp) ) {
case ASCEND_SORT: break;
case DESCEND_SORT: break;
case NUMERICAL_SORT: break;
default: break;
}
break;
case R_VAR: case R_CONSTANT: break;
case S_VAR: case S_CONSTANT:
break;
}
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("NOT YET");
} break;
case INIT_ARRAY_F:
{ int rr;
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"init_array()'s arg. must be a name of an array.\n");
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR: case S_CONSTANT: /* allows the use of init_array(array[1]) which array[1]="another" */
rr = free_array(FIRST_ARGSTR(argp));
resultp->s_type = I_CONSTANT;
resultp->s_int = rr;
break;
case IDENTIFIER:
rr = free_array(FIRST_ARGNAME(argp));
resultp->s_type = I_CONSTANT;
resultp->s_int = rr;
break;
}
} break;
case ARRAY_MAX_F:
case ARRAY_MIN_F:
{ int min;
Symbol *r_p;
min = ((func==ARRAY_MIN_F)? 1 : 0);
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT:
case R_VAR: case R_CONSTANT:
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
sprintf(tmpS,"%s()'s arg. must be a name of an array.\n",(min ? "min" : "max"));
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR: case S_CONSTANT: /* this allows the use of min(array[1]) which array[1]="another" */
r_p = array_min_max(FIRST_ARGSTR(argp),min);
if( r_p == NULL ) { /* array name is not in array tree */
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<STRING ARRAY NAME IS NOT YET DEFINED!>>");
} else {
/*
fprintf(stdout,"min_max():: STR arg. R=%g\n",r_p->s_real); fflush(stdout);
*/
capa_mfree((char *)resultp);
resultp = r_p;
}
break;
case IDENTIFIER:
r_p = array_min_max(FIRST_ARGNAME(argp),min);
if( r_p == NULL ) { /* array name is not in array tree */
/* fprintf(stdout,"min_max() return NULL\n"); fflush(stdout); */
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARRAY NAME IS NOT YET DEFINED!>>");
} else {
/*
fprintf(stdout,"min_max():: ID arg. R=%g\n",r_p->s_real); fflush(stdout);
*/
capa_mfree((char *)resultp);
resultp = r_p;
}
break;
}
} break;
case SIN_F:
case COS_F:
case TAN_F:
case ASIN_F:
case ACOS_F:
case ATAN_F:
case SINH_F:
case COSH_F:
case TANH_F:
case ASINH_F:
case ACOSH_F:
case ATANH_F:
case J_ZERO_F:
case J_ONE_F:
case Y_ZERO_F:
case Y_ONE_F:
case LOG_F:
case LOG_TEN_F:
case EXP_F:
case ERF_F:
case ERFC_F:
case ABS_F:
case SQRT_F:
case FLOOR_F:
case CEIL_F:
case SGN_F:{ if( (FIRST_ARGTYPE(argp) == S_VAR ) || (FIRST_ARGTYPE(argp) == S_CONSTANT ) ) {
sprintf(aline,"<<ARG TYPE MISMATCH>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS,"function %s() cannot accept string as argument.\n", FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
} else {
if( (FIRST_ARGTYPE(argp) == I_VAR ) || (FIRST_ARGTYPE(argp) == I_CONSTANT ) ) {
tmpA = (double)FIRST_ARGINT(argp);
} else {
tmpA = (double)FIRST_ARGREAL(argp);
}
resultp->s_type = R_CONSTANT;
switch(func) {
case SIN_F: resultp->s_real = sin(tmpA); break;
case COS_F: resultp->s_real = cos(tmpA); break;
case TAN_F: resultp->s_real = tan(tmpA); break;
case ASIN_F: if(fabs(tmpA) <= 1.0) {
resultp->s_real = asin(tmpA);
} else {
resultp->s_type = S_CONSTANT;
sprintf(aline,"<<ARG OUT OF BOUND>>");
resultp->s_str = strsave(aline);
sprintf(tmpS, "asin()'s arg. is not in the range of [-1.0,+1.0].\n");
capa_msg(MESSAGE_ERROR,tmpS);
}
break;
case ACOS_F: if(fabs(tmpA) <= 1.0) {
resultp->s_real = acos(tmpA);
} else {
resultp->s_type = S_CONSTANT;
sprintf(aline,"<<ARG OUT OF BOUND>>");
resultp->s_str = strsave(aline);
sprintf(tmpS,"acos()'s arg. is not in the range of [-1.0,+1.0].\n");
capa_msg(MESSAGE_ERROR,tmpS);
}
break;
case ATAN_F: resultp->s_real = atan(tmpA); break;
case SINH_F: resultp->s_real = sinh(tmpA); break;
case COSH_F: resultp->s_real = cosh(tmpA); break;
case TANH_F: resultp->s_real = tanh(tmpA); break;
case ASINH_F: resultp->s_real = asinh(tmpA); break;
case ACOSH_F: resultp->s_real = acosh(tmpA); break;
case ATANH_F: resultp->s_real = atanh(tmpA); break;
case J_ZERO_F: resultp->s_real = j0(tmpA); break;
case J_ONE_F: resultp->s_real = j1(tmpA); break;
case Y_ZERO_F: resultp->s_real = y0(tmpA); break;
case Y_ONE_F: resultp->s_real = y1(tmpA); break;
case LOG_F: resultp->s_real = log(tmpA); break;
case LOG_TEN_F: resultp->s_real = log10(tmpA); break;
case EXP_F: resultp->s_real = exp(tmpA); break;
case ERF_F: resultp->s_real = erf(tmpA); break;
case ERFC_F: resultp->s_real = erfc(tmpA); break;
case ABS_F: resultp->s_real = fabs(tmpA); break;
case SQRT_F: if( tmpA >= 0.0) {
resultp->s_real = sqrt(tmpA);
} else {
resultp->s_type = S_CONSTANT;
sprintf(aline,"<<ARG OUT OF BOUND>>");
resultp->s_str = strsave(aline);
sprintf(tmpS, "sqrt()'s arg. is not in the range of [0.0,+Inf].\n");
capa_msg(MESSAGE_ERROR,tmpS);
}
break;
case FLOOR_F: resultp->s_type = I_CONSTANT;
resultp->s_int = (long)floor(tmpA); break;
case CEIL_F: resultp->s_type = I_CONSTANT;
resultp->s_int = (long)ceil(tmpA); break;
case SGN_F: resultp->s_type = I_CONSTANT;
resultp->s_int = (int)SGN(tmpA); break;
}
}
}
break;
case ATANTWO_F:
case J_N_F:
case Y_N_F:
case POW_F: { noError = 1;
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: tmpA = (double)FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: tmpA = FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: noError = 0;
resultp->s_str = strsave("<<MIS TYPE>>");
sprintf(tmpS,"%s()'s second arg. cannot be string.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
switch(SECOND_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: tmpB = (double)SECOND_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: tmpB = SECOND_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: noError = 0;
resultp->s_str = strsave("<<MIS TYPE>>");
sprintf(tmpS,"%s()'s first arg. cannot be string.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
if ( POW_F == func ) {
if ((!(((double)((int)tmpA)) == tmpA)) && (tmpB < 0.0)) {
resultp->s_str = strsave("<<ARG OUT OF BOUND>>");
sprintf(tmpS,
"%s()'s arguments would result in a complex number.\n",
FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
noError=0;
}
}
if(noError) {
resultp->s_type = R_CONSTANT;
switch( func ) {
case J_N_F: resultp->s_real = jn((int)tmpB, tmpA); break;
case Y_N_F: resultp->s_real = yn((int)tmpB, tmpA); break;
case POW_F: resultp->s_real = pow(tmpB, tmpA); break;
case ATANTWO_F: resultp->s_real = atan2(tmpB, tmpA); break;
}
}else {
resultp->s_type = S_CONSTANT;
}
}
break;
case TEX_F: { if (Parsemode_f != TeX_MODE) {
#ifdef TTH
#define CHARLEN 1024*1024
{
char *html;
if ( (Parsemode_f==HTML_MODE) &&
((SECOND_ARGTYPE(argp) == S_VAR) ||
(SECOND_ARGTYPE(argp) == S_CONSTANT))
) {
printf("Hi There %s\n",SECOND_ARGSTR(argp));
resultp->s_type = SECOND_ARGTYPE(argp);
if(tth_err) { free(tth_err); tth_err=NULL; }
textohtmldyn(SECOND_ARGSTR(argp),&html,&tth_err,CHARLEN);
if(html) {
resultp->s_str=strsave(html);
capa_mfree(html);
} else {
resultp->s_str=strsave("");
}
break;
}
}
#undef CHARLEN
#endif
resultp->s_type = FIRST_ARGTYPE(argp);
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
}
} else {
resultp->s_type = SECOND_ARGTYPE(argp);
switch(SECOND_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = SECOND_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = SECOND_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(SECOND_ARGSTR(argp)); break;
}
}
} break;
case VAR_IN_TEX_F:{
if (Parsemode_f == TeX_MODE) {
resultp->s_type = FIRST_ARGTYPE(argp);
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
}
} else {
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("");
}
} break;
case HTML_F: { if (Parsemode_f == HTML_MODE) {
resultp->s_type = FIRST_ARGTYPE(argp);
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
}
} else {
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("");
}
/* printf("HTML:%s\n",resultp->s_str); */
} break;
case WEB_F:
case FORMAT_F: { /* web(ASCII,TeX,HTML) */
if( argc == 3 ) {
switch(Parsemode_f) {
case HTML_MODE: {
resultp->s_type = FIRST_ARGTYPE(argp);
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
}
} break;
case TeX_MODE: {
resultp->s_type = SECOND_ARGTYPE(argp);
switch(SECOND_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = SECOND_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = SECOND_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(SECOND_ARGSTR(argp)); break;
}
} break;
default: {
resultp->s_type = THIRD_ARGTYPE(argp);
switch(THIRD_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = THIRD_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = THIRD_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(THIRD_ARGSTR(argp)); break;
}
} break;
}
} else { /* argc == 2 */
switch(Parsemode_f) {
case TeX_MODE: {
resultp->s_type = FIRST_ARGTYPE(argp);
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
}
} break;
default : {
resultp->s_type = SECOND_ARGTYPE(argp);
switch(SECOND_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: resultp->s_int = SECOND_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: resultp->s_real = SECOND_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: resultp->s_str = strsave(SECOND_ARGSTR(argp)); break;
}
} break;
}
}
} break;
case FACTORIAL_F: {
int ii;
unsigned long long l_fac;
double d_fac;
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: {
if( FIRST_ARGINT(argp) < 0 ) {
sprintf(aline,"<<FACTORIAL ERROR>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
} else {
if( FIRST_ARGINT(argp) <= 12 ) {
resultp->s_type = I_CONSTANT;
l_fac = 1;
for(ii=2; ii <= FIRST_ARGINT(argp); ii++) { l_fac *= ii; }
resultp->s_int = l_fac;
} else {
resultp->s_type = R_CONSTANT;
d_fac = 362880.0;
for(ii=10; ii <= FIRST_ARGINT(argp); ii++) { d_fac *= ii; }
resultp->s_real = d_fac;
}
}
}
break;
case R_VAR:
case R_CONSTANT: {
if( FIRST_ARGREAL(argp) < 0.0 ) {
sprintf(aline,"<<FACTORIAL ERROR>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n", FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
} else {
if( FIRST_ARGREAL(argp) <= 13.0 ) {
resultp->s_type = I_CONSTANT;
l_fac = 1;
for(ii=2; ii <= FIRST_ARGREAL(argp); ii++) { l_fac *= ii; }
resultp->s_int = l_fac;
} else {
resultp->s_type = R_CONSTANT;
d_fac = 362880.0;
for(ii=10; ii <= FIRST_ARGREAL(argp); ii++) { d_fac *= ii; }
resultp->s_real = d_fac;
}
}
}
break;
case S_VAR:
case S_CONSTANT: {
sprintf(aline,"<<FACTORIAL ERROR>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS,"%s()'s arg. cannot be of string type.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
}
break;
}
} break;
case MOD_F: break;
case REMAINDER_F: break;
case MAX_F:
case MIN_F: { int ii, idx, type;
tmpArgp = argp;
tmpA = ((func == MIN_F)? MAX_DOUBLE : - MAX_DOUBLE);
type = R_CONSTANT; idx = -1;
noError = 1;
for(ii = 0; (ii < argc)&&(noError); ii++) {
switch (FIRST_ARGTYPE(tmpArgp)) {
case I_VAR:
case I_CONSTANT:
if( type == S_CONSTANT) {
sprintf(aline,"<<ARG TYPE>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS,"%s()'s arg. type cannot mix string with int or real.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
noError = 0;
} else {
switch(func) {
case MIN_F:
if( tmpA <= FIRST_ARGINT(tmpArgp) ) {
} else {
idx = ii; type = I_CONSTANT;
tmpA = (double)FIRST_ARGINT(tmpArgp);
}
break;
case MAX_F:
if( tmpA >= FIRST_ARGINT(tmpArgp) ) {
} else {
idx = ii; type = I_CONSTANT;
tmpA = (double)FIRST_ARGINT(tmpArgp);
}
break;
}
}
break;
case R_VAR:
case R_CONSTANT:
if( type == S_CONSTANT ) {
sprintf(aline,"<<ARG TYPE>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS,"%s()'s arg. type cannot mix string with int or real.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
noError = 0;
} else {
switch(func) {
case MIN_F:
if( tmpA <= FIRST_ARGREAL(tmpArgp) ) {
} else {
idx = ii; type = R_CONSTANT;
tmpA = FIRST_ARGREAL(tmpArgp);
}
break;
case MAX_F:
if( tmpA >= FIRST_ARGREAL(tmpArgp) ) {
} else {
idx = ii; type = R_CONSTANT;
tmpA = FIRST_ARGREAL(tmpArgp);
}
break;
}
}
break;
case S_VAR:
case S_CONSTANT:
if( (ii != 0)&&(type != S_CONSTANT) ) {
sprintf(aline,"<<ARG TYPE>>");
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(aline);
sprintf(tmpS," %s()'s arg. type cannot mix string with int or real.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
noError = 0;
} else {
if( ii == 0 ) { idx = 0; strcpy(tmpS, FIRST_ARGSTR(tmpArgp)); }
type = S_CONSTANT;
switch( func) {
case MIN_F:
if( strcmp(tmpS, FIRST_ARGSTR(tmpArgp)) <= 0 ) {
} else {
idx = ii;
strcpy(tmpS, FIRST_ARGSTR(tmpArgp));
}
break;
case MAX_F:
if( strcmp(tmpS, FIRST_ARGSTR(tmpArgp)) >= 0 ) {
} else {
idx = ii;
strcpy(tmpS, FIRST_ARGSTR(tmpArgp));
}
break;
}
}
break;
}
tmpArgp = tmpArgp->a_next;
}
if( noError ) {
for(tmpArgp=argp,ii=0; ii<idx; ii++) { tmpArgp=tmpArgp->a_next; }
resultp->s_type = type;
switch(type) {
case I_CONSTANT: resultp->s_int = (tmpArgp->a_sp)->s_int;
break;
case R_CONSTANT: resultp->s_real = (tmpArgp->a_sp)->s_real;
break;
case S_CONSTANT: resultp->s_str = strsave((tmpArgp->a_sp)->s_str);
break;
}
}
}
break;
case ROUNDTO_F: {
noError = 1; hh = 0; /* reuse integer hh and mm */
switch(FIRST_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: mm = FIRST_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: mm = (int)FIRST_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<MIS TYPE>>");
sprintf(tmpS,
"%s()'s second arg. cannot be string.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
switch(SECOND_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT: hh = SECOND_ARGINT(argp); break;
case R_VAR:
case R_CONSTANT: tmpA = SECOND_ARGREAL(argp); break;
case S_VAR:
case S_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<MIS TYPE>>");
sprintf(tmpS,
"%s()'s first arg. cannot be string.\n",
FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
}
if(noError) {
resultp->s_type = R_CONSTANT;
if( hh != 0 ) {
resultp->s_type = I_CONSTANT;
resultp->s_int = hh;
} else {
if ( mm >= 0 ) {
sprintf(fmt_str,"%%.%df",mm);
sprintf(num_str,fmt_str,tmpA);
tmpB = atof(num_str);
resultp->s_real = tmpB;
} else {
sprintf(tmpS,"%s()'s second arg. cannot be negative (%d).\n",
FuncStack[Func_idx].s_name,mm);
capa_msg(MESSAGE_ERROR,tmpS);
resultp->s_real = tmpA; /* not changed */
}
}
}
} break;
case EVALUATE_F: { char *f_str, *v_str, *pt_str, *out_come;
noError = 1;
switch(FIRST_ARGTYPE(argp)) { /* now only accepts string like "0.0,0.1,0.2,0.3,0.4,0.5" */
case I_VAR:
case I_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<Evaulate Formula: Pts TYPE incorrect>>");
sprintf(tmpS,
"%s()'s third arg. cannot be integer.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
case R_VAR:
case R_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<Evaulate Formula: Pts TYPE incorrect>>");
sprintf(tmpS,
"%s()'s third arg. cannot be integer.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR:
case S_CONSTANT:
pt_str = FIRST_ARGSTR(argp);
break;
}
switch(SECOND_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT:
case R_VAR:
case R_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<Evaluate Formula: Var list TYPE incorrect>>");
sprintf(tmpS,
"%s()'s second arg. cannot be number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR:
case S_CONSTANT: v_str = SECOND_ARGSTR(argp);
break;
}
switch(THIRD_ARGTYPE(argp)) {
case I_VAR:
case I_CONSTANT:
case R_VAR:
case R_CONSTANT: noError = 0;
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<Evaluate Formula: Formula TYPE incorrect>>");
sprintf(tmpS,
"%s()'s first arg. cannot be number.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
break;
case S_VAR:
case S_CONSTANT: f_str = THIRD_ARGSTR(argp);
break;
}
if(noError) {
resultp->s_type = S_CONSTANT;
/* printf("EVALUATE:::%s,%s,%s\n",f_str, v_str, pt_str); */
out_come = eval_formula_range_str(f_str, v_str, pt_str);
if( !out_come ) {
resultp->s_str = strsave("<<Evaluate formula:: NULL>>");
sprintf(tmpS,
"%s() cannot evaluate the formula correctly.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
} else {
resultp->s_str = out_come;
}
}
}
break;
case CAPAID_PLUS:
{
extern Problem_t* FirstProblem_p;
extern Problem_t* LexiProblem_p;
Problem_t* problem;
int num_char,pin;
errCode = 0;
if (argc==1) {
switch( FIRST_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT: num_char=FIRST_ARGINT(argp); break;
case R_VAR: case R_CONSTANT: errCode = 1; break;
case S_VAR: case S_CONSTANT: errCode = 1; break;
}
} else {
switch( SECOND_ARGTYPE(argp) ) {
case I_VAR: case I_CONSTANT: num_char=SECOND_ARGINT(argp); break;
case R_VAR: case R_CONSTANT: errCode = 1; break;
case S_VAR: case S_CONSTANT: errCode = 1; break;
}
}
if( errCode == 0 ) {
if ( FirstProblem_p ) {
problem=FirstProblem_p;
} else {
problem=LexiProblem_p;
}
if (!(problem->capaidplus)) capa_mfree(problem->capaidplus);
if (-1==(tmpInt=which_set(argc-1,argp,resultp))) break;
pin=capa_PIN(Parse_student_number,tmpInt,0);
problem->capaidplus = capa_id_plus(Parse_student_number,
tmpInt,num_char);
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave(problem->capaidplus);
} else {
resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<INCORRECT ARGS TO CAPAID_PLUS>>");
}
}
break;
case SEAT_NUMBER:
{
int filenum;
double filedoub;
char *filename;
if ( argc == 1 ) {
switch( FIRST_ARGTYPE(argp)) {
case I_VAR: case I_CONSTANT: filenum=FIRST_ARGINT(argp);
filename=capa_malloc(TMP_LINE_LENGTH,1);
sprintf(filename,"%d",filenum);
break;
case R_VAR: case R_CONSTANT: filedoub=FIRST_ARGREAL(argp);
filename=capa_malloc(TMP_LINE_LENGTH,1);
sprintf(filename,"%f",filedoub);
break;
case S_VAR: case S_CONSTANT:
filename=strsave(FIRST_ARGSTR(argp)); break;
}
} else {
filename=NULL;
}
resultp->s_type = S_CONSTANT;
resultp->s_str = capa_get_seat(Parse_student_number,filename);
if ( filename != NULL ) capa_mfree(filename);
break;
}
case DURATION: { resultp->s_type = I_CONSTANT;
resultp->s_int=capa_get_duration(Parse_student_number,
Parse_section,Parse_set);
} break;
case MANAGERMODE_F: { resultp->s_type = I_CONSTANT;
resultp->s_int=managermode;
}break;
case CORRECT_F: {
}break;
case TRIES_F: {
}break;
case GRADE_F: {
}break;
case MIS_ARG_COUNT:
{ resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<ARG COUNT>>");
sprintf(tmpS,"%s()'s arg. count is not correct.\n",
FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
} break;
case UNKNOWN_F:
default: { resultp->s_type = S_CONSTANT;
resultp->s_str = strsave("<<UNKNOWN FUNCTION>>");
sprintf(tmpS,"%s() unknown.\n",FuncStack[Func_idx].s_name);
capa_msg(MESSAGE_ERROR,tmpS);
} break;
}
return (resultp);
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to capaFunction.c CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / pProj