INT16 dlm_cholfC(COMPLEX64* Z, const COMPLEX64* A, INT32 nXD) {
integer info = 0;
integer n = (integer) nXD;
char uplo[1] = { 'U' };
#ifdef __MAX_TYPE_32BIT
extern int clacpy_(char*,integer*,integer*,complex*,integer*,complex*,integer *ldb);
extern int cpotrf_(char*,integer*,complex*,integer*,integer*);
#else
extern int zlacpy_(char*,integer*,integer*,doublecomplex*,integer*,doublecomplex*,integer *ldb);
extern int zpotrf_(char*,integer*,doublecomplex*,integer*,integer*);
#endif
/* Declare variables */
DLPASSERT(Z != A); /* Assert input is not output */
DLPASSERT(dlp_size(Z) >= nXD * nXD * sizeof(FLOAT64)); /* Check size of output buffer */
DLPASSERT(dlp_size(A) >= nXD * nXD * sizeof(FLOAT64)); /* Check size of input buffer */
/* ... computation ... *//* --------------------------------- */
#ifdef __MAX_TYPE_32BIT
cpotrf_(uplo, &n, (complex*)A, &n, &info);
clacpy_(uplo, &n, &n, (complex*)A, &n, (complex*)Z, &n);
#else
zpotrf_(uplo, &n, (doublecomplex*)A, &n, &info);
zlacpy_(uplo, &n, &n, (doublecomplex*)A, &n, (doublecomplex*)Z, &n);
#endif
return (info == 0) ? O_K : NOT_EXEC; /* All done successfully */
}
/**
* Computes the complex (inverse) fast Fourier transform.
*
* @param RE
* Pointer to an array containing the real part of the input, will be
* overwritten with real part of output.
* @param IM
* Pointer to an array containing the imaginary part of the input, will
* be overwritten with imaginary part of output.
* @param nXL
* Length of signals, must be a power of 2 (otherwise the function will
* return an <code>ERR_MDIM</code> error)
* @param bInv
* If non-zero the function computes the inverse complex Fourier
* transform
* @return <code>O_K</code> if successfull, a (begative) error code otherwise
*
* <h4>Remarks</h4>
* <ul>
* <li>The function creates the tables by its own, stores them in static arrays and
* reuses them for all subsequent calls with the same value of <code>nXL</code>.</li>
* </ul>
*/
INT16 dlm_fft
(
FLOAT64* RE,
FLOAT64* IM,
INT32 nXL,
INT16 bInv
)
{
extern int ifft(FLOAT64*,FLOAT64*,const int);
extern int fft(FLOAT64*,FLOAT64*,const int);
INT16 order;
/* Initialize */ /* --------------------------------- */
order = (INT16)dlm_log2_i(nXL); /* Compute FFT order */
if (order<=0) return ERR_MDIM; /* nXL is not power of 2 --> :// */
#ifndef __NOXALLOC
DLPASSERT(dlp_size(RE)>=nXL*sizeof(FLOAT64)); /* Assert RE has the right length */
DLPASSERT(dlp_size(IM)>=nXL*sizeof(FLOAT64)); /* Assert IM has the right length */
#endif
if(bInv) {
if(ifft(RE,IM,nXL) != 0) return NOT_EXEC;
} else {
if(fft(RE,IM,nXL) != 0) return NOT_EXEC;
}
return O_K; /* All done */
}
/**
* Composed state hash map node allocation function. Hash nodes are taken from
* a pool: {@link grany m_nGrany} nodes are allocated at a time to save memory
* allocations.
*/
hnode_t* CFst_Cps_HashAllocNode(void* lpContext)
{
CFst* _this = NULL;
INT32 nPool = 0;
INT32 nItem = 0;
hnode_t* lpRet = NULL;
/* Get this pointer and locate next hash node */
_this = (CFst*)lpContext;
nPool = _this->m_nCpsHnpoolSize / _this->m_nGrany;
nItem = _this->m_nCpsHnpoolSize - nPool*_this->m_nGrany;
/* Grow size of hash node pool table if necessary */
if (nPool>=(INT32)(dlp_size(_this->m_lpCpsHnpool)/sizeof(hnode_t*)))
_this->m_lpCpsHnpool =
(void**)dlp_realloc(_this->m_lpCpsHnpool,nPool+100,sizeof(hnode_t*));
/* Allocate a new hash node pool if necessary */
if (_this->m_lpCpsHnpool[nPool]==NULL)
((hnode_t**)_this->m_lpCpsHnpool)[nPool] =
(hnode_t*)dlp_calloc(_this->m_nGrany,sizeof(hnode_t));
/* Increment pool size and return pointer to new hash node */
_this->m_nCpsHnpoolSize++;
lpRet = &((hnode_t**)_this->m_lpCpsHnpool)[nPool][nItem];
return lpRet;
}
/**
* Addition operation of the symbol string semiring (longest common prefix).
*
* @param lpST Pointer to a string table data structure (returned by
* {@link Ssr_Init CFst_Ssr_Init})
* @param nS1 Index of first string
* @param nS2 Index of second string
* @return Index of result string or -1 if no matching prefixes
*/
FST_ITYPE CGEN_SPROTECTED CFst_Ssr_Add(FST_SST_TYPE* lpST, FST_ITYPE nS1, FST_ITYPE nS2)
{
INT32 nL1 = 0;
INT32 nL2 = 0;
INT32 nLr = 0;
if (nS1==nS2 ) return nS1; /* Args are identical */
if (nS1==-2 ) return nS2; /* Arg. 1 is the infinite string */
if (nS2==-2 ) return nS1; /* Arg. 2 is the infinite string */
if (nS1==-1 || nS2==-1) return -1; /* Either argument is the empty string */
nL1 = CFst_Ssr_Len(lpST,nS1);
nL2 = CFst_Ssr_Len(lpST,nS2);
for (nLr=0; nLr<nL1 && nLr<nL2; nLr++)
{
if (ST_LP(lpST,nS1)[nLr]!=ST_LP(lpST,nS2)[nLr]) break;
if (ST_LP(lpST,nS1)[nLr]==-1 || ST_LP(lpST,nS2)[nLr]==-1) break;
}
if (nLr==0) return -1;
if ((INT32)dlp_size(lpST->lpBuf)<nLr)
lpST->lpBuf=(FST_STYPE*)__dlp_realloc(lpST->lpBuf,nLr+lpST->nGrany,sizeof(FST_STYPE),__FILE__,__LINE__,"CFst","");
dlp_memmove(lpST->lpBuf,ST_LP(lpST,nS1),nLr);
lpST->lpBuf[nLr]=-1;
return CFst_Ssr_Store(lpST,lpST->lpBuf);
}
/**
* Updates the statistics with one vector. There are no checks performed!
*
* @param _this
* Pointer to this CStatistics instance
* @param lpX
* Pointer to a buffer containing the vector to update the statistics
* with (is expected to contain <i>N</i> = <code>{@link dat}.dim</code>
* double values)
* @param c
* Index of class this vector belongs to (0 ≤ <code>k</code> <
* <i>C</i> = <code>{@link dat}.nblock</code>)
*/
INT16 CGEN_PROTECTED CStatistics_UpdateVector
(
CStatistics* _this,
FLOAT64* lpX,
INT32 c,
FLOAT64 w
)
{
INT32 i = 0; /* Mixed sum index */
INT32 k = 0; /* Order loop counter (for k>2) */
INT32 n = 0; /* 1st dimension loop couner */
INT32 m = 0; /* 2nd dimension loop couner */
INT32 K = 0; /* Statistics order */
INT32 N = 0; /* Statistics dimensionality */
FLOAT64* lpSsz = NULL; /* Ptr. to class' c sample size */
FLOAT64* lpMin = NULL; /* Ptr. to class' c minimum vector */
FLOAT64* lpMax = NULL; /* Ptr. to class' c maximum vector */
FLOAT64* lpSum = NULL; /* Ptr. to class' c sum vector */
FLOAT64* lpMsm = NULL; /* Ptr. to class' c mixed sum matrix */
FLOAT64* lpKsm = NULL; /* Ptr. to class' c k-th ord.sum vec.*/
/* Validate */ /* --- DEBUG ONLY ------------------ */
DLPASSERT(_this); /* Check this pointer */
DLPASSERT(_this->m_idDat); /* Check statistics data table */
DLPASSERT((INT32)(dlp_size(lpX)/sizeof(FLOAT64)) == CStatistics_GetDim(_this)); /* Check update vector buffer */
DLPASSERT(c>=0 && c<CStatistics_GetNClasses(_this)); /* Check class index */
/* Initialize */ /* --------------------------------- */
K = CStatistics_GetOrder(_this); /* Get statistics order */
N = CStatistics_GetDim(_this); /* Get statistics dimensionality */
DLPASSERT((lpSsz = CStatistics_GetPtr(_this,c,STA_DAI_SSIZE))); /* Get ptr. to class' c sample size */
DLPASSERT((lpMin = CStatistics_GetPtr(_this,c,STA_DAI_MIN ))); /* Get ptr. to class' c min. vector */
DLPASSERT((lpMax = CStatistics_GetPtr(_this,c,STA_DAI_MAX ))); /* Get ptr. to class' c max. vector */
DLPASSERT((lpSum = CStatistics_GetPtr(_this,c,STA_DAI_SUM ))); /* Get ptr. to class' c sum vector */
DLPASSERT((lpMsm = CStatistics_GetPtr(_this,c,STA_DAI_MSUM ))); /* Get ptr. to class' c mix.sum.matr.*/
DLPASSERT((lpKsm = CStatistics_GetPtr(_this,c,STA_DAI_KSUM )) || K<=2); /* Get ptr. to class' c k-th ord.sum.*/
/* Update */ /* --------------------------------- */
(*lpSsz)+=w; /* Increment sample size */
for (n=0,i=0; n<N; n++) /* Loop over dimensions */
{ /* >> */
if (lpMin[n] > lpX[n]) lpMin[n] = lpX[n]; /* Track minimum */
if (lpMax[n] < lpX[n]) lpMax[n] = lpX[n]; /* Track maximum */
lpSum[n] += lpX[n]*w; /* Update sum */
for (m=0; m<N; m++,i++) lpMsm[i] += lpX[n]*lpX[m]*w; /* Update mixed sum */
for (k=3; k<=K; k++) lpKsm[(k-3)*N+n] += dlm_pow(lpX[n],k)*w; /* Update k-th order sums */
} /* << */
return O_K; /* Done */
}
/**
* Multiplication operation of the symbol string semiring (concatentation).
*
* @param lpST Pointer to a string table data structure (returned by
* {@link Ssr_Init CFst_Ssr_Init})
* @param nS1 Index of first (left) string
* @param nS2 Index of second (right) string
* @return Index of result string
*/
FST_ITYPE CGEN_SPROTECTED CFst_Ssr_Mult(FST_SST_TYPE* lpST, FST_ITYPE nS1, FST_ITYPE nS2)
{
INT32 nL1 = 0;
INT32 nL2 = 0;
if (nS1<0) return nS2;
if (nS2<0) return nS1;
nL1 = CFst_Ssr_Len(lpST,nS1);
nL2 = CFst_Ssr_Len(lpST,nS2);
if ((INT32)dlp_size(lpST->lpBuf)<nL1+nL2+1)
lpST->lpBuf=(FST_STYPE*)__dlp_realloc(lpST->lpBuf,nL1+nL2+lpST->nGrany,sizeof(FST_STYPE),__FILE__,__LINE__,"CFst","");
dlp_memmove( lpST->lpBuf ,ST_LP(lpST,nS1),nL1*sizeof(FST_STYPE));
dlp_memmove(&lpST->lpBuf[nL1],ST_LP(lpST,nS2),nL2*sizeof(FST_STYPE));
lpST->lpBuf[nL1+nL2]=-1;
return CFst_Ssr_Store(lpST,lpST->lpBuf);
}
/**
* Deletes auxiliary components created by CFst_Cps_AddSdAux from the state table.
*
* @param _this Pointer to automaton instance
* @see Cps_AddSdAux CFst_Cps_AddSdAux
* @see Cps_SetSdAux CFst_Cps_SetSdAux
* @see Cps_FindState CFst_Cps_FindState
*/
void CGEN_PRIVATE CFst_Cps_DelSdAux(CFst* _this)
{
INT32 i = 0;
/* Destroy composed state hash map */
/* NOTE: MUST be done before deleting auxiliary state components! */
hash_free_nodes((hash_t*)_this->m_lpCpsHash);
hash_destroy((hash_t*)_this->m_lpCpsHash);
_this->m_lpCpsHash = NULL;
/* Destroy hash node pool */
if (_this->m_lpCpsHnpool)
for (i=0; i<(INT32)(dlp_size(_this->m_lpCpsHnpool)/sizeof(hnode_t*)); i++)
dlp_free(_this->m_lpCpsHnpool[i]);
dlp_free(_this->m_lpCpsHnpool);
_this->m_lpCpsHnpool = NULL;
_this->m_nCpsHnpoolSize = 0;
/* Delete auxiliary components from state table */
CData_DeleteComps(AS(CData,_this->sd),_this->m_nIcSdAux,3);
_this->m_nIcSdAux = -1;
}
/**
* Difference (division) operation of the symbol string semiring (residual
* of longest common prefix).
*
* @param lpST Pointer to a string table data structure (returned by
* {@link Ssr_Init CFst_Ssr_Init})
* @param nS1 Index of first string
* @param nS2 Index of second string
* @return Index of result string or -1 if strings identical
*/
FST_ITYPE CGEN_SPROTECTED CFst_Ssr_Dif(FST_SST_TYPE* lpST, FST_ITYPE nS1, FST_ITYPE nS2)
{
FST_ITYPE nSs = -1;
INT32 nL1 = 0;
if (nS1==nS2 ) return -1; /* Args are identical */
if (nS1==-1 ) return -1; /* Arg. 1 is the empty string */
if (nS2==-1 ) return nS1; /* Arg. 2 is the empty string */
if (nS1==-2 || nS2==-2) return -1; /* Either arg. is the infinite string */
nL1 = CFst_Ssr_Len(lpST,nS1)+1;
if (nL1==0) return -1;
nSs = CFst_Ssr_Add(lpST,nS1,nS2);
if (nSs<0) return nS1;
if ((INT32)dlp_size(lpST->lpBuf)<nL1)
lpST->lpBuf=(FST_STYPE*)__dlp_realloc(lpST->lpBuf,nL1+lpST->nGrany,sizeof(FST_STYPE),__FILE__,__LINE__,"CFst","");
CFst_Ssr_Fetch(lpST,nS1,lpST->lpBuf,nL1);
return CFst_Ssr_Store(lpST,&lpST->lpBuf[CFst_Ssr_Len(lpST,nSs)]);
}
/**
* Copies the one field from iSrc to this instance
*
* @param _this This (destination) instance
* @param lpWord Pointer to a SWord structure identifying the field to copy
* @param iSrc The source instance to copy the field from
* @return O_K if successful, an error code otherwise
*
* HACK: This implementation copies simple types and strings only!!!
* TODO: Implement instance and pointer copying
*/
INT16 CDlpObject_CopyField(CDlpObject* _this, SWord* lpWord, CDlpObject* iSrc)
{
SWord* lpWordSrc = NULL;
/* Validate input */
CHECK_THIS_RV(NOT_EXEC);
if (!lpWord) return NOT_EXEC;
if (!iSrc ) return NOT_EXEC;
if (lpWord->nFlags & (FF_NONAUTOMATIC|FF_NOSAVE)) return NOT_EXEC;
/* Get source word */
lpWordSrc = CDlpObject_FindWord(iSrc,lpWord->lpName,WL_TYPE_FIELD);
DLPASSERT(lpWordSrc); /* Instance type? */
DLPASSERT(lpWord->nWordType ==lpWordSrc->nWordType ); /* Field overwritten? */
DLPASSERT(lpWord->ex.fld.nType==lpWordSrc->ex.fld.nType); /* Field overwritten? */
/*printf("\n Copy field %s.%s --> %s.%s",BASEINST(iSrc)->m_lpInstanceName,lpWord->lpName,BASEINST(_this)->m_lpInstanceName,lpWord->lpName);*/
/* Copy data */
switch (lpWord->ex.fld.nType)
{
case T_BOOL : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( BOOL)); return O_K;
case T_UCHAR : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( UINT8)); return O_K;
case T_CHAR : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( INT8)); return O_K;
case T_USHORT : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( UINT16)); return O_K;
case T_SHORT : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( INT16)); return O_K;
case T_UINT : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( UINT32)); return O_K;
case T_INT : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( INT32)); return O_K;
case T_ULONG : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( UINT64)); return O_K;
case T_LONG : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( INT64)); return O_K;
case T_FLOAT : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( FLOAT32)); return O_K;
case T_DOUBLE : dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof( FLOAT64)); return O_K;
case T_COMPLEX: dlp_memmove(lpWord->lpData,lpWordSrc->lpData,sizeof(COMPLEX64)); return O_K;
case T_STRING :
case T_CSTRING:
case T_TEXT :
dlp_free(*(char**)lpWord->lpData);
*(char**)lpWord->lpData = NULL;
if (*(char**)lpWordSrc->lpData)
{
*(char**)lpWord->lpData = (char*)dlp_malloc(dlp_size(*(char**)lpWordSrc->lpData));
dlp_strcpy(*(char**)lpWord->lpData,*(char**)lpWordSrc->lpData);
}
return O_K;
case T_INSTANCE:
if (*(CDlpObject**)lpWordSrc->lpData)
{
if (*(CDlpObject**)lpWord->lpData==NULL)
{
#ifdef __cplusplus
*(CDlpObject**)lpWord->lpData = CDlpObject_CreateInstanceOf(lpWordSrc->ex.fld.lpType,lpWordSrc->lpName);
#else
*(CDlpObject**)lpWord->lpData = *(CDlpObject**)CDlpObject_CreateInstanceOf(lpWordSrc->ex.fld.lpType,lpWordSrc->lpName);
#endif
if (!*(CDlpObject**)lpWord->lpData)
IERROR(_this,ERR_CREATEINSTANCE,lpWord->lpName,0,0);
else
(*(CDlpObject**)lpWord->lpData)->m_lpContainer=lpWord;
}
#ifdef __cplusplus
return (*(CDlpObject**)lpWord->lpData)->Copy(*(CDlpObject**)lpWordSrc->lpData);
#else
return (*(CDlpObject**)lpWord->lpData)->Copy(*(CDlpObject**)lpWord->lpData,*(CDlpObject**)lpWordSrc->lpData);
#endif
}
else if (*(CDlpObject**)lpWord->lpData)
{
IDESTROY((*(CDlpObject**)lpWord->lpData));
}
default:
if (lpWord->ex.fld.nType>0 && lpWord->ex.fld.nType<=255)
{
dlp_memmove(lpWord->lpData,lpWordSrc->lpData,lpWord->ex.fld.nType);
return O_K;
}
return NOT_EXEC;
}
}
