[BACK]Return to capaFunction.c CVS log [TXT] [DIR] Up to [LON-CAPA] / capa / capa51 / pProj

Diff for /capa/capa51/pProj/capaFunction.c between versions 1.8 and 1.13

version 1.8, 2000/07/07 18:33:03 version 1.13, 2000/12/13 17:15:54
Line 2 Line 2
    Copyright (C) 1992-2000 Michigan State University     Copyright (C) 1992-2000 Michigan State University
   
    The CAPA system is free software; you can redistribute it and/or     The CAPA system is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public License as     modify it under the terms of the GNU General Public License as
    published by the Free Software Foundation; either version 2 of the     published by the Free Software Foundation; either version 2 of the
    License, or (at your option) any later version.     License, or (at your option) any later version.
   
    The CAPA system is distributed in the hope that it will be useful,     The CAPA system is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of     but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.     General Public License for more details.
   
    You should have received a copy of the GNU Library General Public     You should have received a copy of the GNU General Public
    License along with the CAPA system; see the file COPYING.  If not,     License along with the CAPA system; see the file COPYING.  If not,
    write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,     write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
    Boston, MA 02111-1307, USA.     Boston, MA 02111-1307, USA.
Line 66  match_function(func, argc) char *func; i Line 66  match_function(func, argc) char *func; i
 {  {
   if( !strcmp(func,"random") )         return (((argc==2 || argc==3)? RANDOM_F : MIS_ARG_COUNT));    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_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_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_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_poisson") )        return ((argc==4)? RANDOM_POISSON_F : MIS_ARG_COUNT);
Line 783  ArgNode_t  *argp; Line 784  ArgNode_t  *argp;
               resultp->s_int  = 0;                resultp->s_int  = 0;
             } break;              } break;
    /* generate random numbers according to a pre-defined distributions and a seed */     /* 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_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_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_GAMMA_F: /* random_gamma(return_array,item_cnt,seed,a,r) */
Line 1006  ArgNode_t  *argp; Line 1161  ArgNode_t  *argp;
                      break;                       break;
               } /* end second switch */                } /* end second switch */
             } break;              } break;
    case ARRAY_MOMENTS_F: /*  */     case ARRAY_MOMENTS_F: /*  array_moments(output,input) */
             {               { 
               char       *tmp_input;                char       *tmp_input;
               Symbol     *r_p;                Symbol     *r_p;
Line 1456  ArgNode_t  *argp; Line 1611  ArgNode_t  *argp;
                                 sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n",FuncStack[Func_idx].s_name);                                  sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n",FuncStack[Func_idx].s_name);
                                 capa_msg(MESSAGE_ERROR,tmpS);                                  capa_msg(MESSAGE_ERROR,tmpS);
                               } else {                                } else {
                                 if( FIRST_ARGINT(argp) <= 20 ) {                                  if( FIRST_ARGINT(argp) <= 13 ) {
                                   resultp->s_type =  I_CONSTANT;                                    resultp->s_type =  I_CONSTANT;
                                   l_fac = 1;                                    l_fac = 1;
                                   for(ii=2; ii <= FIRST_ARGINT(argp); ii++) { l_fac *= ii;  }                                    for(ii=2; ii <= FIRST_ARGINT(argp); ii++) { l_fac *= ii;  }
Line 1479  ArgNode_t  *argp; Line 1634  ArgNode_t  *argp;
                                 sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n", FuncStack[Func_idx].s_name);                                  sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n", FuncStack[Func_idx].s_name);
                                 capa_msg(MESSAGE_ERROR,tmpS);                                  capa_msg(MESSAGE_ERROR,tmpS);
                               } else {                                } else {
                                 if( FIRST_ARGREAL(argp) <= 20.0 ) {                                  if( FIRST_ARGREAL(argp) <= 13.0 ) {
                                   resultp->s_type =  I_CONSTANT;                                    resultp->s_type =  I_CONSTANT;
                                   l_fac = 1;                                    l_fac = 1;
                                   for(ii=2; ii <= FIRST_ARGREAL(argp); ii++)  { l_fac *= ii; }                                    for(ii=2; ii <= FIRST_ARGREAL(argp); ii++)  { l_fac *= ii; }
Removed from v.1.8  
changed lines
  Added in v.1.13

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>