T* GetParAs( SizeT pIx) { BaseGDL* p = GetParDefined( pIx); if( p->Type() == T::t) return static_cast<T*>( p); // T* res = dynamic_cast<T*>( p); // if( res != NULL) return res; T* res = static_cast<T*>( p->Convert2( T::t, BaseGDL::COPY)); this->DeleteAtExit( res); return res; }
T* IfDefGetKWAs( SizeT ix) { BaseGDL* p = GetKW( ix); if( p == NULL) return NULL; if( p->Type() == T::t) return static_cast<T*>( p); // T* res = dynamic_cast<T*>( p); // if( res != NULL) return res; T* res = static_cast<T*>( p->Convert2( T::t, BaseGDL::COPY)); this->DeleteAtExit( res); return res; }
T* GetKWAs( SizeT ix) { BaseGDL* p = GetKW( ix); if( p == NULL) Throw( "Keyword is undefined: "+GetString( ix)); if( p->Type() == T::t) return static_cast<T*>( p); // T* res = dynamic_cast<T*>( p); // if( res != NULL) return res; T* res = static_cast<T*>( p->Convert2( T::t, BaseGDL::COPY)); this->DeleteAtExit( res); return res; }
/*****************************************convol_fun*********************************************************/ BaseGDL* convol_fun( EnvT* e) { SizeT nParam=e->NParam( 2); /************************************Checking_parameters************************************************/ BaseGDL* p0 = e->GetNumericParDefined( 0); if( p0->Rank() == 0) e->Throw( "Expression must be an array in this context: "+ e->GetParString(0)); BaseGDL* p1 = e->GetNumericParDefined( 1); if( p1->Rank() == 0) e->Throw( "Expression must be an array in this context: "+ e->GetParString(1)); if( p0->N_Elements() < p1->N_Elements()) e->Throw( "Incompatible dimensions for Array and Kernel."); // rank 1 for kernel works always if( p1->Rank() != 1) { SizeT rank = p0->Rank(); if( rank != p1->Rank()) e->Throw( "Incompatible dimensions for Array and Kernel."); for( SizeT r=0; r<rank; ++r) if( p0->Dim( r) < p1->Dim( r)) e->Throw( "Incompatible dimensions for Array and Kernel."); } /***************************************Preparing_matrices*************************************************/ // convert kernel to array type Guard<BaseGDL> p1Guard; if( p0->Type() == GDL_BYTE) { if( p1->Type() != GDL_INT) { p1 = p1->Convert2( GDL_INT, BaseGDL::COPY); p1Guard.Reset( p1); } } else if( p0->Type() != p1->Type()) { p1 = p1->Convert2( p0->Type(), BaseGDL::COPY); p1Guard.Reset( p1); } BaseGDL* scale; Guard<BaseGDL> scaleGuard; if( nParam > 2) { scale = e->GetParDefined( 2); if( scale->Rank() > 0) e->Throw( "Expression must be a scalar in this context: "+ e->GetParString(2)); // p1 here handles GDL_BYTE case also if( p1->Type() != scale->Type()) { scale = scale->Convert2( p1->Type(),BaseGDL::COPY); scaleGuard.Reset( scale); } } else { scale = p1->New( dimension(), BaseGDL::ZERO); } /********************************************Arguments_treatement***********************************/ bool center = true; static int centerIx = e->KeywordIx( "CENTER"); if( e->KeywordPresent( centerIx)) { DLong c; e->AssureLongScalarKW( centerIx, c); center = (c != 0); } // overrides EDGE_TRUNCATE static int edge_wrapIx = e->KeywordIx( "EDGE_WRAP"); bool edge_wrap = e->KeywordSet( edge_wrapIx); static int edge_truncateIx = e->KeywordIx( "EDGE_TRUNCATE"); bool edge_truncate = e->KeywordSet( edge_truncateIx); static int edge_zeroIx = e->KeywordIx( "EDGE_ZERO"); bool edge_zero = e->KeywordSet( edge_zeroIx); int edgeMode = 0; if( edge_wrap) edgeMode = 1; else if( edge_truncate) edgeMode = 2; else if( edge_zero) edgeMode = 3; // p0, p1 and scale have same type // p1 has rank of 1 or same rank as p0 with each dimension smaller than p0 // scale is a scalar /***********************************Parameter_BIAS**************************************/ static int biasIx = e->KeywordIx("BIAS"); bool statusBias = e->KeywordPresent( biasIx ); // DLong bias=0; BaseGDL* bias; if(statusBias) { bias=e->GetKW( biasIx); if( p0->Type() != bias->Type()) { bias = bias->Convert2( p0->Type(), BaseGDL::COPY); } } else bias=p1->New( 1,BaseGDL::ZERO); /***********************************Parameter_Normalize**********************************/ static int normalIx = e->KeywordIx( "NORMALIZE"); bool normalize = e->KeywordPresent( normalIx); /***********************************Parameter NAN****************************************/ static int nanIx = e->KeywordIx( "NAN"); bool doNan = e->KeywordPresent( nanIx); /***********************************Parameter MISSING************************************/ static int missingIx = e->KeywordIx("MISSING"); bool doMissing = e->KeywordPresent( missingIx ); BaseGDL* missing; if (p0->Type() != GDL_BYTE) { if (doMissing) { missing = e->GetKW(missingIx); if (p0->Type() != missing->Type()) { missing = missing->Convert2(p0->Type(), BaseGDL::COPY); } } else missing = p1->New(1, BaseGDL::ZERO); } else { if (doMissing) { missing = e->GetKW(missingIx); } else missing = p1->New(1, BaseGDL::ZERO); missing = missing->Convert2(GDL_LONG, BaseGDL::COPY); } /***********************************Parameter INVALID************************************/ static int invalidIx = e->KeywordIx("INVALID"); bool doInvalid = e->KeywordPresent( invalidIx ); BaseGDL* invalid; if (p0->Type() != GDL_BYTE) { if (doInvalid) { invalid = e->GetKW(invalidIx); if (p0->Type() != invalid->Type()) { invalid = invalid->Convert2(p0->Type(), BaseGDL::COPY); } } else invalid = p1->New(1, BaseGDL::ZERO); } else { if (doInvalid) { invalid = e->GetKW(invalidIx); } else invalid = p1->New(1, BaseGDL::ZERO); invalid = invalid->Convert2(GDL_LONG, BaseGDL::COPY); } if (!doNan && !doInvalid) doMissing=false; if (!doMissing && (p0->Type()==GDL_FLOAT ||p0->Type()==GDL_COMPLEX)) missing = SysVar::Values()->GetTag(SysVar::Values()->Desc()->TagIndex("F_NAN"), 0); if (!doMissing && (p0->Type()==GDL_DOUBLE ||p0->Type()==GDL_COMPLEXDBL)) missing = SysVar::Values()->GetTag(SysVar::Values()->Desc()->TagIndex("D_NAN"), 0); return p0->Convol( p1, scale, bias, center, normalize, edgeMode, doNan, missing, doMissing, invalid,doInvalid); } //end of convol_fun
BaseGDL* _GDL_OBJECT_OverloadBracketsRightSide( EnvUDT* e) { // // debug/check // std::cout << "_GDL_OBJECT_OverloadBracketsRightSide called" << std::endl; SizeT nParam = e->NParam(); // number of parameters actually given // int envSize = e->EnvSize(); // number of parameters + keywords 'e' (pro) has defined if( nParam < 3) // consider implicit SELF ThrowFromInternalUDSub( e, "At least 2 parameters are needed: ISRANGE, SUB1 [, ...]."); // default behavior: Exact like scalar indexing BaseGDL* isRange = e->GetKW(1); if( isRange == NULL) ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) is undefined."); if( isRange->Rank() == 0) ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) must be an array in this context: " + e->Caller()->GetString(e->GetKW(1))); SizeT nIsRange = isRange->N_Elements(); if( nIsRange > (nParam - 2)) //- SELF and ISRANGE ThrowFromInternalUDSub( e, "Parameter 1 (ISRANGE) must have "+i2s(nParam-2)+" elements."); Guard<DLongGDL> isRangeLongGuard; DLongGDL* isRangeLong; if( isRange->Type() == GDL_LONG) isRangeLong = static_cast<DLongGDL*>( isRange); else { try{ isRangeLong = static_cast<DLongGDL*>( isRange->Convert2( GDL_LONG, BaseGDL::COPY)); } catch( GDLException& ex) { ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); } isRangeLongGuard.Reset( isRangeLong); } ArrayIndexVectorT ixList; // IxExprListT exprList; try { for( int p=0; p<nIsRange; ++p) { BaseGDL* parX = e->GetKW( p + 2); // implicit SELF, ISRANGE, par1..par8 if( parX == NULL) ThrowFromInternalUDSub( e, "Parameter is undefined: " + e->Caller()->GetString(e->GetKW( p + 2))); DLong isRangeX = (*isRangeLong)[p]; if( isRangeX != 0 && isRangeX != 1) { ThrowFromInternalUDSub( e, "Value of parameter 1 (ISRANGE["+i2s(p)+"]) is out of allowed range."); } if( isRangeX == 1) { if( parX->N_Elements() != 3) { ThrowFromInternalUDSub( e, "Range vector must have 3 elements: " + e->Caller()->GetString(e->GetKW( p + 2))); } DLongGDL* parXLong; Guard<DLongGDL> parXLongGuard; if( parX->Type() != GDL_LONG) { try{ parXLong = static_cast<DLongGDL*>( parX->Convert2( GDL_LONG, BaseGDL::COPY)); parXLongGuard.Reset( parXLong); } catch( GDLException& ex) { ThrowFromInternalUDSub( e, ex.ANTLRException::getMessage()); } } else { parXLong = static_cast<DLongGDL*>( parX); } // negative end ix is fine -> CArrayIndexRangeS can handle [b:*:s] ([b,-1,s]) ixList.push_back(new CArrayIndexRangeS( (*parXLong)[0], (*parXLong)[1], (*parXLong)[2])); } else // non-range { // ATTENTION: These two grab c1 (all others don't) // a bit unclean, but for maximum efficiency if( parX->Rank() == 0) ixList.push_back( new CArrayIndexScalar( parX->Dup())); else ixList.push_back( new CArrayIndexIndexed( parX->Dup())); } } // for } catch( GDLException& ex) { ixList.Destruct(); // ixList is not valid afterwards, but as we throw this is ok throw ex; } ArrayIndexListT* aL; MakeArrayIndex( &ixList, &aL, NULL); // important to get the non-NoAssoc ArrayIndexListT // because only they clean up ixList on destruction Guard< ArrayIndexListT> aLGuard( aL); IxExprListT ixL; return aL->Index( e->GetKW( 0), ixL); // index SELF }
BaseGDL* rk4_fun(EnvT* e) { SizeT nParam = e->NParam(); if( nParam != 5) e->Throw(" Invalid Number of arguments in RK4 "); //----------------------------- ACQUISITION DES PARAMETRES ------------------// //"Y" input array a vector of values for Y at X value //DDoubleGDL* Yvals = new DDoubleGDL(e->GetParAs<DDoubleGDL>(0)->N_Elements(),BaseGDL::NOZERO); DDoubleGDL* Yvals = e->GetParAs<DDoubleGDL>(0); if(e->GetParDefined(0)->Type() == GDL_COMPLEX || e->GetParDefined(0)->Type() == GDL_COMPLEXDBL) cout<<" If RK4 is complex then only the real part is used for the computation "<< endl; //"dydx" input value or array //DDoubleGDL* dydxvals = new DDoubleGDL(e->GetParAs<DDoubleGDL>(1)->N_Elements(),BaseGDL::NOZERO); DDoubleGDL* dydxvals = e->GetParAs<DDoubleGDL>(1); if(e->GetParDefined(1)->Type() == GDL_COMPLEX || e->GetParDefined(1)->Type() == GDL_COMPLEXDBL) cout<<" If RK4 is complex then only the real part is used for the computation "<< endl; if(dydxvals->N_Elements()!=Yvals->N_Elements())e->Throw(" Y and DYDX dimensions have to match "); // "X" input value DDoubleGDL* X = e->GetParAs<DDoubleGDL>(2); if(e->GetParDefined(2)->Type() == GDL_COMPLEX || e->GetParDefined(2)->Type() == GDL_COMPLEXDBL) cout<<" If RK4 is complex then only the real part is used for the computation "<< endl; // "H" input value DDoubleGDL* H = e->GetParAs<DDoubleGDL>(3); if(e->GetParDefined(3)->Type() == GDL_COMPLEX || e->GetParDefined(3)->Type() == GDL_COMPLEXDBL) cout<<" If RK4 is complex then only the real part is used for the computation "<< endl; // Differentiate User's Function string name DStringGDL* init = e->GetParAs<DStringGDL>(4); if(e->GetParDefined(4)->Type() != GDL_STRING ) e->Throw(" Fifth value must be a function name string "); //-------------------------------- Allocation -----------------------------------// BaseGDL *Steptwo,*Stepthree,*Stepfour; SizeT i; DDoubleGDL *HH,*H6,*XplusH,*Ytampon,*XH,*Yout,* dym,* dyt; Ytampon = new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO); Yout = new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO); HH = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO); H6 = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO); XH = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO); BaseGDL* XHO=static_cast<BaseGDL*>(XH); XplusH = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO); BaseGDL* XplusHO=static_cast<BaseGDL*>(XplusH); dym= new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO); dyt= new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO); //-------------------------------- Init FIRST STEP -----------------------------------// (*HH)[0]=(*H)[0]*0.50000; (*H6)[0]=(*H)[0]/6.00000; (*XH)[0] = (*X)[0] + (*HH)[0]; // marc: probably an error // XplusH[0] = (*X)[0] + (*H)[0]; (*XplusH)[0] = (*X)[0] + (*H)[0]; //dym=static_cast<DDoubleGDL*>(dymO); //dyt=static_cast<DDoubleGDL*>(dytO); //---------------------------- Init Call function -------------------------------------// DString RK_Diff; e->AssureScalarPar<DStringGDL>( 4, RK_Diff); // this is a function name -> convert to UPPERCASE RK_Diff = StrUpCase( RK_Diff); // first search library funcedures int funIx=LibFunIx( RK_Diff); StackGuard<EnvStackT> guard( e->Interpreter()->CallStack()); if( funIx != -1) { e->Throw(" String function name is intrinsic function name please change it "); } else { // Search in user proc and function funIx = GDLInterpreter::GetFunIx(RK_Diff ); //-----------------FIRST STEP-------------------// for (i=0;i<Yvals->N_Elements();++i) (*Ytampon)[i]=(*Yvals)[i]+(*HH)[0]*(*dydxvals)[i]; BaseGDL* Ytmp=static_cast<BaseGDL*>(Ytampon); // 1st CALL to user function "differentiate" PushNewEnvRK(e, funList[ funIx],&XHO,&Ytmp); EnvUDT* newEnv = static_cast<EnvUDT*>(e->Interpreter()->CallStack().back()); StackGuard<EnvStackT> guard1 ( e->Interpreter()->CallStack()); BaseGDL* Steptwo = e->Interpreter()->call_fun(static_cast<DSubUD*>(newEnv->GetPro())->GetTree()); //Conversion BaseGDL*-> DDoubleGDL* in order to use the RK_Diff function result. dyt= static_cast<DDoubleGDL*>(Steptwo->Convert2(GDL_DOUBLE,BaseGDL::CONVERT)); //-------------SECOND STEP-------------------// for (i=0;i<Yvals->N_Elements();++i) (*Ytampon)[i]=(*Yvals)[i]+(*HH)[0]*(*dyt)[i]; // 2nd CALL to user function "differentiate" PushNewEnvRK(e, funList[ funIx],&XHO,&Ytmp); StackGuard<EnvStackT> guard2 ( newEnv->Interpreter()->CallStack()); BaseGDL* Stepthree = e->Interpreter()->call_fun(static_cast<DSubUD*>(newEnv->GetPro())->GetTree()); //Conversion BaseGDL*-> DDoubleGDL* in order to use the RK_Diff function result. dym = static_cast<DDoubleGDL*>(Stepthree->Convert2(GDL_DOUBLE,BaseGDL::CONVERT)); //--------------THIRD STEP-------------------// for (i=0;i<Yvals->N_Elements();++i) { (*Ytampon)[i]=(*Yvals)[i]+ (*H)[0]*(*dym)[i]; (*dym)[i] += (*dyt)[i]; } // 3rd CALL to user function "differentiate" PushNewEnvRK(e, funList[ funIx],&XplusHO,&Ytmp); StackGuard<EnvStackT> guard3 ( newEnv->Interpreter()->CallStack()); BaseGDL* Stepfour = e->Interpreter()->call_fun(static_cast<DSubUD*>(newEnv->GetPro())->GetTree()); dyt= static_cast<DDoubleGDL*>(Stepfour->Convert2(GDL_DOUBLE,BaseGDL::CONVERT)); //--------------FOURTH STEP-------------------// for (i=0;i<Yvals->N_Elements();++i) (*Yout)[i]= (*Yvals)[i] + (*H6)[0] * ( (*dydxvals)[i]+(*dyt)[i]+ 2.00000*(*dym)[i] ); static DInt doubleKWIx = e->KeywordIx("DOUBLE"); //if need, convert things back if( !e->KeywordSet(doubleKWIx)) return Yout->Convert2(GDL_FLOAT,BaseGDL::CONVERT); else return Yout; } assert( false); }// RK4_fun