double quadform(double *x, double *A, int N, int incx, int LDA)
{
//quadform2 seems to be faster
return( quadform2(x, A, N, incx, LDA) );
int Nsqr = N*N,info,i=0,j=0;
double *B = Calloc(Nsqr,double);
//double one=1;
//double zero=0;
double sumSq=0;
double y[N];
int iOne=1;
for(i=0;i<N;i++){
y[i] = x[i*incx];
}
for(i=0;i<N;i++){
Memcpy(&B[i*N],&A[i*LDA],N);
}
F77_NAME(dpotrf)("U", &N, B, &N, &info);
F77_NAME(dtrmv)("U","N","N", &N, B, &N, y, &iOne);
for(i=0;i<N;i++){
sumSq += y[i]*y[i];
}
Free(B);
return(sumSq);
}
VertexBufferPtr D3D9VideoBufferManager::CreateVertexBuffer(
int size, int stride, USAGE usage, bool cpuAccess, const void * initData)
{
d_assert (size > 0);
HRESULT hr;
DWORD D3DUsage = D3D9Mapping::GetD3DUsage(usage);
D3DPOOL D3DPool = D3D9Mapping::GetD3DPool(usage);
IDirect3DVertexBuffer9 * pD3DVB;
hr = mD3D9Device->CreateVertexBuffer(size, D3DUsage, 0, D3DPool, &pD3DVB, NULL);
if (FAILED(hr))
{
EXCEPTION("D3D Error: CreateVertexBuffer failed, desc: " + D3D9Mapping::GetD3DErrorDescription(hr));
}
D3D9VertexBuffer * pVB = new D3D9VertexBuffer(mD3D9Device);
pVB->mD3D9VertexBuffer = pD3DVB;
pVB->mSize = size;
pVB->mStride = stride;
pVB->mUsage = usage;
mVertexBuffers.PushBack(pVB);
if (initData != NULL)
{
void * data = pVB->Lock(0, 0, LOCK_DISCARD);
Memcpy(data, initData, size);
pVB->Unlock();
}
return VertexBufferPtr(pVB);
}
static
double* check_gv(SEXP gr, SEXP hs, SEXP rho, int n, double *gv, double *hv)
{
SEXP gval = PROTECT(coerceVector(eval(gr, rho), REALSXP));
if (LENGTH(gval) != n)
error(_("gradient function must return a numeric vector of length %d"), n);
Memcpy(gv, REAL(gval), n);
for (int i = 0; i < n; i++)
if(ISNAN(gv[i])) error("NA/NaN gradient evaluation");
if (hv) {
SEXP hval = PROTECT(eval(hs, rho));
SEXP dim = getAttrib(hval, R_DimSymbol);
int i, j, pos;
double *rhval = REAL(hval);
if (!isReal(hval) || LENGTH(dim) != 2 ||
INTEGER(dim)[0] != n || INTEGER(dim)[1] != n)
error(_("Hessian function must return a square numeric matrix of order %d"),
n);
for (i = 0, pos = 0; i < n; i++) /* copy lower triangle row-wise */
for (j = 0; j <= i; j++) {
hv[pos] = rhval[i + j * n];
if(ISNAN(hv[pos])) error("NA/NaN Hessian evaluation");
pos++;
}
UNPROTECT(1);
}
UNPROTECT(1);
return gv;
}
void CopyVertex(PolygonGroup *srcGroup, uint32 srcPos, PolygonGroup *dstGroup, uint32 dstPos)
{
int32 srcFormat = srcGroup->GetFormat();
int32 dstFormat = dstGroup->GetFormat();
int32 copyFormat = srcFormat&dstFormat; //most common format;
uint8 *srcData = srcGroup->meshData+srcPos*GetVertexSize(srcFormat);
uint8 *dstData = dstGroup->meshData+dstPos*GetVertexSize(dstFormat);
for (uint32 mask = EVF_LOWER_BIT; mask <= EVF_HIGHER_BIT; mask = mask << 1)
{
int32 vertexAttribSize = GetVertexSize(mask);
if (mask©Format)
Memcpy(dstData, srcData, vertexAttribSize);
if (mask&srcFormat)
srcData+=vertexAttribSize;
if (mask&dstFormat)
dstData+=vertexAttribSize;
copyFormat&=~mask;
}
/*unsupported stream*/
DVASSERT((copyFormat == 0)&&"Unsupported attribute stream in copy");
}
UINT CMemFile::Read(void* lpBuf, UINT nCount)
{
ASSERT_VALID(this);
if (nCount == 0)
return 0;
ASSERT(lpBuf != NULL);
ASSERT(AfxIsValidAddress(lpBuf, nCount));
if (m_nPosition > m_nFileSize)
return 0;
UINT nRead;
if (m_nPosition + nCount > m_nFileSize)
nRead = (UINT)(m_nFileSize - m_nPosition);
else
nRead = nCount;
Memcpy((BYTE*)lpBuf, (BYTE*)m_lpBuffer + m_nPosition, nRead);
m_nPosition += nRead;
ASSERT_VALID(this);
return nRead;
}
void CD3DDevice::UpdateBuffer( IGfxBuffer* pBuffer, void* pData, uint nSize )
{
D3D11_MAPPED_SUBRESOURCE pMappedBuffer;
m_pContext->Map( ((CD3DBuffer*)pBuffer)->m_pBuffer, 0, D3D11_MAP_WRITE_DISCARD, 0, &pMappedBuffer );
Memcpy( pMappedBuffer.pData, pData, nSize );
m_pContext->Unmap( ((CD3DBuffer*)pBuffer)->m_pBuffer, 0 );
}
int32
cache_writesector(
IN tcache_t * pcache,
IN int32 addr,
IN ubyte * ptr)
{
int16 secindex;
int32 ret;
ret = CACHE_OK;
if (!pcache->use_cache) {
return HAI_readsector(pcache->hdev, addr, ptr);
}
if (!_find_in_list(pcache, addr, &secindex)) {
if ((secindex = _do_cache_miss(pcache, secindex, addr)) < 0) {
ret = secindex;
}
}
else {
_do_cache_hint(pcache, secindex);
}
if (ret >= 0) {
Memcpy(pcache->secbufs[secindex].secbuf, ptr, pcache->sector_size);
pcache->secbufs[secindex].is_dirty = 1;
}
return ret;
}
// Compute determinant of an N by N positive definite matrix A
double matrixDet(double *A, int N, int LDA, int doLog, int *info)
{
//SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
int i=0;
double B[N*N], logDet=0;
//Memcpy(B,A,N*N);
for(i=0;i<N;i++){
Memcpy(&B[i*N],&A[i*LDA],N);
}
F77_CALL(dpotrf)("U", &N, B, &N, info);
if(*info){
Rprintf("Cholesky decomposition in matrixDet() returned nonzero info %d.\n",info);
}
for(i=0;i<N;i++)
{
logDet += 2 * log(B[i*N+i]);
}
if(doLog){
return(logDet);
}else{
return(exp(logDet));
}
}
// Modified version of Tim Davis's cs_qr_mex.c file for MATLAB (in CSparse)
// Usage: [V,beta,p,R,q] = cs_qr(A) ;
SEXP dgCMatrix_QR(SEXP Ap, SEXP order)
{
CSP A = AS_CSP__(Ap), D;
int io = INTEGER(order)[0];
Rboolean verbose = (io < 0);
int m = A->m, n = A->n, ord = asLogical(order) ? 3 : 0, *p;
R_CheckStack();
if (m < n) error(_("A must have #{rows} >= #{columns}")) ;
SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("sparseQR")));
int *dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
dims[0] = m; dims[1] = n;
css *S = cs_sqr(ord, A, 1); /* symbolic QR ordering & analysis*/
if (!S) error(_("cs_sqr failed"));
if(verbose && S->m2 > m) // in ./cs.h , m2 := # of rows for QR, after adding fictitious rows
Rprintf("Symbolic QR(): Matrix structurally rank deficient (m2-m = %d)\n",
S->m2 - m);
csn *N = cs_qr(A, S); /* numeric QR factorization */
if (!N) error(_("cs_qr failed")) ;
cs_dropzeros(N->L); /* drop zeros from V and sort */
D = cs_transpose(N->L, 1); cs_spfree(N->L);
N->L = cs_transpose(D, 1); cs_spfree(D);
cs_dropzeros(N->U); /* drop zeros from R and sort */
D = cs_transpose(N->U, 1); cs_spfree(N->U) ;
N->U = cs_transpose(D, 1); cs_spfree(D);
m = N->L->m; /* m may be larger now */
// MM: m := S->m2 also counting the ficticious rows (Tim Davis, p.72, 74f)
p = cs_pinv(S->pinv, m); /* p = pinv' */
SET_SLOT(ans, install("V"),
Matrix_cs_to_SEXP(N->L, "dgCMatrix", 0));
Memcpy(REAL(ALLOC_SLOT(ans, install("beta"),
REALSXP, n)), N->B, n);
Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_pSym,
INTSXP, m)), p, m);
SET_SLOT(ans, install("R"),
Matrix_cs_to_SEXP(N->U, "dgCMatrix", 0));
if (ord)
Memcpy(INTEGER(ALLOC_SLOT(ans, install("q"),
INTSXP, n)), S->q, n);
else
ALLOC_SLOT(ans, install("q"), INTSXP, 0);
cs_nfree(N);
cs_sfree(S);
cs_free(p);
UNPROTECT(1);
return ans;
}
/**
Copy cholmod_triplet to an R_alloc()ed version of it
*/
static void chTr2Ralloc(CHM_TR dest, CHM_TR src)
{
int nnz;
/* copy all the (non-pointer) characteristics of src to dest */
memcpy(dest, src, sizeof(cholmod_triplet));
/* R_alloc the vector storage for dest and copy the contents from src */
nnz = src->nnz;
dest->i = (void*) Memcpy((int*)R_alloc(nnz, sizeof(int)),
(int*)(src->i), nnz);
dest->j = (void*) Memcpy((int*)R_alloc(nnz, sizeof(int)),
(int*)(src->j), nnz);
if(src->xtype)
dest->x = (void*) Memcpy((double*)R_alloc(nnz, sizeof(double)),
(double*)(src->x), nnz);
}
SEXP dtCMatrix_sparse_solve(SEXP a, SEXP b)
{
SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dgCMatrix")));
CSP A = AS_CSP(a), B = AS_CSP(b);
int *xp = INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, (B->n) + 1)),
xnz = 10 * B->p[B->n]; /* initial estimate of nnz in x */
int *ti = Calloc(xnz, int), k, lo = uplo_P(a)[0] == 'L', pos = 0;
double *tx = Calloc(xnz, double);
double *wrk = Alloca(A->n, double);
int *xi = Alloca(2*A->n, int); /* for cs_reach */
R_CheckStack();
if (A->m != A->n || B->n < 1 || A->n < 1 || A->n != B->m)
error(_("Dimensions of system to be solved are inconsistent"));
slot_dup(ans, b, Matrix_DimSym);
SET_DimNames(ans, b);
xp[0] = 0;
for (k = 0; k < B->n; k++) {
int top = cs_spsolve (A, B, k, xi, wrk, (int *)NULL, lo);
int nz = A->n - top, p;
xp[k + 1] = nz + xp[k];
if (xp[k + 1] > xnz) {
while (xp[k + 1] > xnz) xnz *= 2;
ti = Realloc(ti, xnz, int);
tx = Realloc(tx, xnz, double);
}
if (lo) /* increasing row order */
for(p = top; p < A->n; p++, pos++) {
ti[pos] = xi[p];
tx[pos] = wrk[xi[p]];
}
else /* decreasing order, reverse copy */
for(p = A->n - 1; p >= top; p--, pos++) {
ti[pos] = xi[p];
tx[pos] = wrk[xi[p]];
}
}
xnz = xp[B->n];
Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, xnz)), ti, xnz);
Memcpy( REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, xnz)), tx, xnz);
Free(ti); Free(tx);
UNPROTECT(1);
return ans;
}
/*parse the response message and manipulate the send message*/
static int handlemessage(struct dhcp_msg*rmsg,struct dhcp_msg*smsg)
{
int i,j,p;
/*find DNS info*/
if(getdns){
p=messagefindoption(rmsg,OPT_DNS_SERVER);
if(p>=0){
for(i=0;i<rmsg->msg_opt[p].opt_dns_server.num_dns;i++)
addaddr(dnsservers,rmsg->msg_opt[p].opt_dns_server.addr[i]);
}
p=messagefindoption(rmsg,OPT_DNS_NAME);
if(p>=0){
for(i=0;i<rmsg->msg_opt[p].opt_dns_name.num_dns;i++)
adddomain(rmsg->msg_opt[p].opt_dns_name.namelist[i]);
}
}
/*find PREFIX info*/
if(getprefix){
p=messagefindoption(rmsg,OPT_IAPD);
if(p>=0)
for(i=0;i<rmsg->msg_opt[p].opt_numopts;i++)
if(rmsg->msg_opt[p].subopt[i].opt_type==OPT_IAPREFIX){
j=addaddr(prefixes,rmsg->msg_opt[p].subopt[i].opt_iaprefix.prefix);
if(j>=0)
prefixlens[j]=rmsg->msg_opt[p].subopt[i].opt_iaprefix.prefixlen;
}
}
/*find IANA info*/
if(getaddress){
p=messagefindoption(rmsg,OPT_IANA);
if(p>=0)
for(i=0;i<rmsg->msg_opt[p].opt_numopts;i++)
if(rmsg->msg_opt[p].subopt[i].opt_type==OPT_IAADDR)
addaddr(addresses,rmsg->msg_opt[p].subopt[i].opt_iaaddress.addr);
}
/*copy server address*/
Memcpy(&dhcpserver,&rmsg->msg_peer.sin6_addr,16);
/*check for rapid commit or type=REPLY; if so: tell caller it can stop now*/
if(rmsg->msg_type==MSG_REPLY)return 0;
if(messagefindoption(rmsg,OPT_RAPIDCOMMIT)>=0)return 0;
/*otherwise we need to continue*/
/*correct message type & id*/
clearrecvfilter();
if(getprefix||getaddress){
addrecvfilter(MSG_REPLY);
smsg->msg_type=MSG_REQUEST;
}else{
addrecvfilter(MSG_REPLY);
smsg->msg_type=MSG_IREQUEST;
}
smsg->msg_id++; /*elapsed time continues to count*/
/*rapid commit is no longer applicable*/
messageremoveoption(smsg,OPT_RAPIDCOMMIT);
/*append server ID*/
p=messagefindoption(rmsg,OPT_SERVERID);
if(p>=0)messageappendopt(smsg,&rmsg->msg_opt[p]);
return 1;
}
/**
Copy cholmod_sparse, to an R_alloc()ed version of it
*/
static void chm2Ralloc(CHM_SP dest, CHM_SP src)
{
int np1, nnz;
/* copy all the characteristics of src to dest */
memcpy(dest, src, sizeof(cholmod_sparse));
/* R_alloc the vector storage for dest and copy the contents from src */
np1 = src->ncol + 1;
nnz = (int) cholmod_nnz(src, &c);
dest->p = (void*) Memcpy((int*)R_alloc(np1, sizeof(int)),
(int*)(src->p), np1);
dest->i = (void*) Memcpy((int*)R_alloc(nnz, sizeof(int)),
(int*)(src->i), nnz);
if(src->xtype)
dest->x = (void*) Memcpy((double*)R_alloc(nnz, sizeof(double)),
(double*)(src->x), nnz);
}
/* TODO(gauravsh): This could easily be integrated into KeyBlockCreate()
* since the code is almost a mirror - I have kept it as such to avoid changing
* the existing interface. */
VbKeyBlockHeader* KeyBlockCreate_external(const VbPublicKey* data_key,
const char* signing_key_pem_file,
uint64_t algorithm,
uint64_t flags,
const char* external_signer) {
VbKeyBlockHeader* h;
uint64_t signed_size = sizeof(VbKeyBlockHeader) + data_key->key_size;
uint64_t block_size = (signed_size + SHA512_DIGEST_SIZE +
siglen_map[algorithm]);
uint8_t* data_key_dest;
uint8_t* block_sig_dest;
uint8_t* block_chk_dest;
VbSignature *sigtmp;
/* Allocate key block */
h = (VbKeyBlockHeader*)malloc(block_size);
if (!h)
return NULL;
if (!signing_key_pem_file || !data_key || !external_signer)
return NULL;
data_key_dest = (uint8_t*)(h + 1);
block_chk_dest = data_key_dest + data_key->key_size;
block_sig_dest = block_chk_dest + SHA512_DIGEST_SIZE;
Memcpy(h->magic, KEY_BLOCK_MAGIC, KEY_BLOCK_MAGIC_SIZE);
h->header_version_major = KEY_BLOCK_HEADER_VERSION_MAJOR;
h->header_version_minor = KEY_BLOCK_HEADER_VERSION_MINOR;
h->key_block_size = block_size;
h->key_block_flags = flags;
/* Copy data key */
PublicKeyInit(&h->data_key, data_key_dest, data_key->key_size);
PublicKeyCopy(&h->data_key, data_key);
/* Set up signature structs so we can calculate the signatures */
SignatureInit(&h->key_block_checksum, block_chk_dest,
SHA512_DIGEST_SIZE, signed_size);
SignatureInit(&h->key_block_signature, block_sig_dest,
siglen_map[algorithm], signed_size);
/* Calculate checksum */
sigtmp = CalculateChecksum((uint8_t*)h, signed_size);
SignatureCopy(&h->key_block_checksum, sigtmp);
free(sigtmp);
/* Calculate signature */
sigtmp = CalculateSignature_external((uint8_t*)h, signed_size,
signing_key_pem_file, algorithm,
external_signer);
SignatureCopy(&h->key_block_signature, sigtmp);
free(sigtmp);
/* Return the header */
return h;
}
void CMemFile::Write( const void *lpBuf, UINT nCount )
/****************************************************/
{
if( m_nPosition + nCount >= m_nFileSize ) {
m_nFileSize = m_nPosition + nCount;
GrowFile( m_nFileSize );
}
Memcpy( m_lpBuffer + m_nPosition, (const BYTE *)lpBuf, nCount );
m_nPosition += nCount;
}
void* HcpNI::Memcpy(void* pDest, const void* pSource, const hcp_Size_t Length, void* pContext) {
void* result = NULL;
if (pContext != NULL) {
auto hni = static_cast<HcpNI*>(pContext);
result = hni->Memcpy(pDest, pSource, Length);
}
return result;
}
/* dv7prm... applies reverse permutation to vector. */
void F77_NAME(dv7prm)(int *n, const int ip[], double x[])
{
/* permute x so that x[ip[i]] := x[i]. */
int i, nn = *n;
double *xcp = Calloc(nn, double);
for (i = 0; i < nn; i++) xcp[ip[i] - 1] = x[i]; /* ip contains 1-based indices */
Memcpy(x, xcp, nn);
Free(xcp);
}
void PropertyCellData::SetTriangles(int32 *newTriangles, int32 count)
{
DVASSERT(valueType == PROP_VALUE_DISTANCE);
SafeDeleteArray(triangles);
triangles = new int32[count];
Memcpy(triangles, newTriangles, count * sizeof(float32));
distanceCount = count;
}
int PublicKeyCopy(VbPublicKey *dest, const VbPublicKey *src)
{
if (dest->key_size < src->key_size)
return 1;
dest->key_size = src->key_size;
dest->algorithm = src->algorithm;
dest->key_version = src->key_version;
Memcpy(GetPublicKeyData(dest), GetPublicKeyDataC(src), src->key_size);
return 0;
}
/* coerce a vector to REAL and copy the result to freshly R_alloc'd memory */
static void *RallocedREAL(SEXP x)
{
SEXP rx = PROTECT(coerceVector(x, REALSXP));
int lx = LENGTH(rx);
/* We over-allocate the memory chunk so that it is never NULL. */
/* The CHOLMOD code checks for a NULL pointer even in the length-0 case. */
double *ans = Memcpy((double*)R_alloc(lx + 1, sizeof(double)),
REAL(rx), lx);
UNPROTECT(1);
return (void*)ans;
}
SEXP dgCMatrix_matrix_solve(SEXP Ap, SEXP b, SEXP give_sparse)
// FIXME: add 'keep_dimnames' as argument
{
Rboolean sparse = asLogical(give_sparse);
if(sparse) {
// FIXME: implement this
error(_("dgCMatrix_matrix_solve(.., sparse=TRUE) not yet implemented"));
/* Idea: in the for(j = 0; j < nrhs ..) loop below, build the *sparse* result matrix
* ----- *column* wise -- which is perfect for dgCMatrix
* --> build (i,p,x) slots "increasingly" [well, allocate in batches ..]
*
* --> maybe first a protoype in R
*/
}
SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(b)),
lu, qslot;
CSP L, U;
int *bdims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), *p, *q;
int j, n = bdims[0], nrhs = bdims[1];
double *x, *ax = REAL(GET_SLOT(ans, Matrix_xSym));
C_or_Alloca_TO(x, n, double);
if (isNull(lu = get_factors(Ap, "LU"))) {
install_lu(Ap, /* order = */ 1, /* tol = */ 1.0, /* err_sing = */ TRUE,
/* keep_dimnames = */ TRUE);
lu = get_factors(Ap, "LU");
}
qslot = GET_SLOT(lu, install("q"));
L = AS_CSP__(GET_SLOT(lu, install("L")));
U = AS_CSP__(GET_SLOT(lu, install("U")));
R_CheckStack();
if (U->n != n)
error(_("Dimensions of system to be solved are inconsistent"));
if(nrhs >= 1 && n >= 1) {
p = INTEGER(GET_SLOT(lu, Matrix_pSym));
q = LENGTH(qslot) ? INTEGER(qslot) : (int *) NULL;
for (j = 0; j < nrhs; j++) {
cs_pvec(p, ax + j * n, x, n); /* x = b(p) */
cs_lsolve(L, x); /* x = L\x */
cs_usolve(U, x); /* x = U\x */
if (q) /* r(q) = x , hence
r = Q' U{^-1} L{^-1} P b = A^{-1} b */
cs_ipvec(q, x, ax + j * n, n);
else
Memcpy(ax + j * n, x, n);
}
}
if(n >= SMALL_4_Alloca) Free(x);
UNPROTECT(1);
return ans;
}
/**
* Establish a fill-reducing permutation for the sparse symmetric
* matrix of order n represented by the column pointers Tp and row
* indices Ti.
*
* @param n order of the sparse symmetric matrix
* @param Tp column pointers (total length n + 1)
* @param Ti row indices (total length Tp[n])
* @param Perm array of length n to hold the permutation
* @param iPerm array of length n to hold the inverse permutation
*
*/
void ssc_metis_order(int n, const int Tp [], const int Ti [],
int Perm[], int iPerm[])
{
int j, num_flag = 0, options_flag = 0;
idxtype
*perm = Calloc(n, idxtype), /* in case idxtype != int */
*iperm = Calloc(n, idxtype),
*xadj = Calloc(n+1, idxtype),
*adj = Calloc(2 * (Tp[n] - n), idxtype);
/* check row indices for correct range */
for (j = 0; j < Tp[n]; j++)
if (Ti[j] < 0 || Ti[j] >= n)
error(_("row index Ti[%d] = %d is out of range [0,%d]"),
j, Ti[j], n - 1);
/* temporarily use perm to store lengths */
AZERO(perm, n);
for (j = 0; j < n; j++) {
int ip, p2 = Tp[j+1];
for (ip = Tp[j]; ip < p2; ip++) {
int i = Ti[ip];
if (i != j) {
perm[i]++;
perm[j]++;
}
}
}
xadj[0] = 0;
for (j = 0; j < n; j++) xadj[j+1] = xadj[j] + perm[j];
/* temporarily use perm to store pointers */
Memcpy(perm, xadj, n);
for (j = 0; j < n; j++) {
int ip, p2 = Tp[j+1];
for (ip = Tp[j]; ip < p2; ip++) {
int i = Ti[ip];
if (i != j) {
adj[perm[i]] = j;
adj[perm[j]] = i;
perm[i]++;
perm[j]++;
}
}
}
METIS_NodeND(&n, xadj, adj, &num_flag, &options_flag, perm, iperm);
for (j = 0; j < n; j++) {
Perm[j] = (int) perm[j];
iPerm[j] = (int) iperm[j];
}
Free(iperm);
Free(perm);
Free(xadj);
Free(adj);
}
SEXP dtrMatrix_as_matrix(SEXP from)
{
int *Dim = INTEGER(GET_SLOT(from, Matrix_DimSym));
int m = Dim[0], n = Dim[1];
SEXP val = PROTECT(allocMatrix(REALSXP, m, n));
make_d_matrix_triangular(Memcpy(REAL(val),
REAL(GET_SLOT(from, Matrix_xSym)), m * n),
from);
setAttrib(val, R_DimNamesSymbol, GET_SLOT(from, Matrix_DimNamesSym));
UNPROTECT(1);
return val;
}
SEXP R_zgeev(SEXP JOBVL, SEXP JOBVR, SEXP N,
SEXP A, SEXP LDA,
SEXP W, SEXP VL, SEXP LDVL, SEXP VR, SEXP LDVR,
SEXP WORK, SEXP LWORK, SEXP RWORK,
SEXP INFO){
int n = INTEGER(N)[0], total_length;
SEXP T;
char CS_JOBVL = CHARPT(JOBVL, 0)[0], CS_JOBVR = CHARPT(JOBVR, 0)[0];
/* Protect R objects. */
PROTECT(T = allocMatrix(CPLXSXP, n, n));
/* COpy A and B since zgges writes in place. */
total_length = n * n;
Memcpy(COMPLEX(T), COMPLEX(A), total_length);
/* Call Fortran. */
if(CS_JOBVL == 'V' && CS_JOBVR == 'V'){
F77_CALL(zgeev)("V", "V",
INTEGER(N), COMPLEX(T), INTEGER(LDA),
COMPLEX(W), COMPLEX(VL), INTEGER(LDVL),
COMPLEX(VR), INTEGER(LDVR), COMPLEX(WORK),
INTEGER(LWORK),
REAL(RWORK), INTEGER(INFO));
} else if(CS_JOBVL == 'N' && CS_JOBVR == 'V'){
F77_CALL(zgeev)("N", "V",
INTEGER(N), COMPLEX(T), INTEGER(LDA),
COMPLEX(W), COMPLEX(VL), INTEGER(LDVL),
COMPLEX(VR), INTEGER(LDVR), COMPLEX(WORK),
INTEGER(LWORK),
REAL(RWORK), INTEGER(INFO));
} else if(CS_JOBVL == 'V' && CS_JOBVR == 'N'){
F77_CALL(zgeev)("V", "N",
INTEGER(N), COMPLEX(T), INTEGER(LDA),
COMPLEX(W), COMPLEX(VL), INTEGER(LDVL),
COMPLEX(VR), INTEGER(LDVR), COMPLEX(WORK),
INTEGER(LWORK),
REAL(RWORK), INTEGER(INFO));
} else if(CS_JOBVL == 'N' && CS_JOBVR == 'N'){
F77_CALL(zgeev)("N", "N",
INTEGER(N), COMPLEX(T), INTEGER(LDA),
COMPLEX(W), COMPLEX(VL), INTEGER(LDVL),
COMPLEX(VR), INTEGER(LDVR), COMPLEX(WORK),
INTEGER(LWORK),
REAL(RWORK), INTEGER(INFO));
} else{
REprintf("Input (CHARACTER) types are not implemented.\n");
}
/* Return. */
UNPROTECT(1);
return(R_NilValue);
} /* End of R_zgeev(). */
static void Cd1fcn(int n, const double x[], double *g, function_info *state)
{
int ind;
if ((ind = FT_lookup(n, x, state)) < 0) { /* shouldn't happen */
fcn(n, x, g, state);
if ((ind = FT_lookup(n, x, state)) < 0) {
error(_("function value caching for optimization is seriously confused"));
}
}
Memcpy(g, state->Ftable[ind].grad, n);
}
/**
* random walk metropolis sampling for a vector of parameters
* of length d using multivariate normal proposal
*
* @param d the dimension of the parameter
* @param m current values of the parameter (also mean vector
* in the multivariate Normal)
* @param v covariance matrix in the proposal distribution
* @param sn simulated new vector
* @param myfunc user specified function to compute the log posterior
* @param data the struct used in myfunc
*
* @return a 0-1 integer: 0 means not accepted and 1 accepted
*
*/
int metrop_mvnorm_rw(int d, double *m, double *v, double *sn,
double (*myfunc)(double *x, void *data), void *data){
rmvnorm(d, m, v, sn) ;
/* determine whether to accept the sample */
double A = exp(myfunc(sn, data) - myfunc(m, data) ) ;
if (A < 1 && runif(0, 1) >= A){
Memcpy(sn, m, d) ;
return 0 ;
}
else return 1 ;
}
int read_recordtype_json_desc(void * root,void * record)
{
int ret;
void * data;
void * struct_template;
DB_RECORD * db_record=record;
DB_RECORD * struct_record;
struct struct_desc_record * struct_desc;
struct struct_recordtype * recordtype;
void * temp_node;
if(db_record->head.type <=0)
return -EINVAL;
struct_template=memdb_get_template(db_record->head.type,db_record->head.subtype);
if(struct_template==NULL)
return -EINVAL;
ret=Galloc0(&recordtype,sizeof(struct struct_recordtype));
if(ret<0)
return ret;
temp_node=json_find_elem("uuid",root);
if(temp_node==NULL)
return -EINVAL;
char * uuid_str=json_get_valuestr(temp_node);
if(!Isvaliduuid(uuid_str))
{
struct_record=memdb_find_byname(uuid_str,DB_STRUCT_DESC,0);
if(struct_record==NULL)
return -EINVAL;
Memcpy(recordtype->uuid,struct_record->head.uuid,DIGEST_SIZE);
ret=json_remove_node(temp_node);
}
ret=json_2_struct(root,recordtype,struct_template);
// namelist->elem_no=json_get_elemno(temp_node);
db_record->record=recordtype;
ret=memdb_comp_uuid(db_record);
if(ret<0)
return ret;
ret=memdb_store_record(db_record);
if(ret<0)
return ret;
ret=memdb_register_dynamicdb(recordtype->type,recordtype->subtype);
return ret;
}
SEXP dsyMatrix_as_matrix(SEXP from)
{
int n = INTEGER(GET_SLOT(from, Matrix_DimSym))[0];
SEXP val = PROTECT(allocMatrix(REALSXP, n, n));
make_symmetric(Memcpy(REAL(val),
REAL(GET_SLOT(from, Matrix_xSym)), n * n),
from, n);
setAttrib(val, R_DimNamesSymbol, GET_SLOT(from, Matrix_DimNamesSym));
UNPROTECT(1);
return val;
}
Image * Image::CreateFromData(uint32 width, uint32 height, PixelFormat format, const uint8 *data)
{
Image * image = Image::Create(width, height, format);
if(!image) return NULL;
if(data)
{
Memcpy(image->data, data, image->dataSize);
}
return image;
}
const void *StatefulMemcpy_r(MemcpyState *state, const void *src, uint64_t len)
{
if (state->overrun)
return NULL;
if (len > state->remaining_len) {
state->overrun = 1;
return NULL;
}
Memcpy(state->remaining_buf, src, len);
state->remaining_buf += len;
state->remaining_len -= len;
return src;
}
