view release on metacpan or  search on metacpan

lib/Statistics/NiceR/DataConvert/PDL.c.tmpl  view on Meta::CPAN

	/* TODO support more types */
	switch(r_type) {
{{{
for my $type (qw(PDL_D PDL_L)) {
	$OUT .= qq%
	case $pdl_to_r->{$type}{sexptype}:
	datad_$type = ($pdl_to_r->{$type}{ctype} *) p->data;
	badv_$type = PDL->get_pdl_badvalue(p);
	memcpy( $pdl_to_r->{$type}{r_macro}(r_array), datad_$type, sizeof($pdl_to_r->{$type}{ctype}) * nelems );
	if( p->state & PDL_BADVAL ) {
		for( elem_i = 0; elem_i < nelems; elem_i++ ) {
			if(datad_${type}[elem_i] == badv_$type) {
				$pdl_to_r->{$type}{r_macro}(r_array)[elem_i] = $pdl_to_r->{$type}{r_NA};
			}
		}

	}
	break;
	%;
}
}}}
	}

	UNPROTECT(1); /* r_dims */

	return r_array;
}

pdl* make_pdl_array( SEXP r_array ) {
	SEXP r_dims;
	size_t ndims;
	PDL_Indx* dims;
	pdl* p;
	int dim_i, elem_i;
	PDL_Indx nelems = 1;
{{{
	# TODO cover all types
	for my $type (qw(PDL_D PDL_L)) {
		$OUT .= qq%
		$pdl_to_r->{$type}{ctype} *datad_$type;
		$pdl_to_r->{$type}{ctype}  badv_$type;
		%;
	}
}}}
	int datatype;

	r_dims = getAttrib(r_array, R_DimSymbol);
	ndims = Rf_length(r_dims);

	Newx(dims, ndims, PDL_Indx);
	for( dim_i = 0; dim_i < ndims; dim_i++ ) {
		dims[dim_i] = INTEGER(r_dims)[dim_i];
		nelems *= dims[dim_i];
	}

	datatype = R_to_PDL_type(TYPEOF(r_array)); /* TODO : R_to_PDL_type */

	p = PDL->pdlnew();
	PDL->setdims (p, dims, ndims);  /* set dims */
	p->datatype = datatype;         /* and data type */
	PDL->allocdata (p);             /* allocate the data chunk */

	Safefree(dims);

	switch(datatype) {
{{{
for my $type (qw(PDL_D PDL_L)) {
	$OUT .= qq%
	case $type:
	datad_$type = ($pdl_to_r->{$type}{ctype} *) p->data;
	badv_$type = PDL->get_pdl_badvalue(p);
	memcpy( datad_$type, $pdl_to_r->{$type}{r_macro}(r_array), sizeof($pdl_to_r->{$type}{ctype}) * nelems );
	for( elem_i = 0; elem_i < nelems; elem_i++ ) {
		if( ISNA( $pdl_to_r->{$type}{r_macro}(r_array)[elem_i] ) ) {
			p->state |= PDL_BADVAL;
			datad_${type}[elem_i] = badv_$type;
		}
	}
	break;
	%;
}
}}}

	}

	return p;
}

pdl* make_pdl_vector( SEXP r_vector, int flat ) {
	size_t ndims;
	PDL_Indx* dims;
	pdl* p;
	int elem_i;
	PDL_Indx nelems = 1;
{{{
	# TODO cover all types
	for my $type (qw(PDL_D PDL_L)) {
		$OUT .= qq%
		$pdl_to_r->{$type}{ctype} *datad_$type;
		$pdl_to_r->{$type}{ctype}  badv_$type;
		%;
	}
}}}
	int datatype;

	ndims = 1;
	Newx(dims, ndims, PDL_Indx);
	dims[0] = nelems = Rf_length(r_vector);
	if( dims[0] == 1 && flat ) {
		/* if there is a single value, treat it as a scalar instead of
		 * as a vector.
		 */
		ndims = 0;
		dims[0] = 0;
	}

	datatype = R_to_PDL_type(TYPEOF(r_vector)); /* TODO : R_to_PDL_type */

	p = PDL->pdlnew();
	PDL->setdims (p, dims, ndims);  /* set dims */
	p->datatype = datatype;         /* and data type */
	PDL->allocdata (p);             /* allocate the data chunk */

	Safefree(dims);

	switch(datatype) {
{{{
for my $type (qw(PDL_D PDL_L)) {
	$OUT .= qq%
	case $type:
	datad_$type = ($pdl_to_r->{$type}{ctype} *) p->data;
	badv_$type = PDL->get_pdl_badvalue(p);
	memcpy( datad_$type, $pdl_to_r->{$type}{r_macro}(r_vector), sizeof($pdl_to_r->{$type}{ctype}) * nelems );
	for( elem_i = 0; elem_i < nelems; elem_i++ ) {
		if( ISNA( $pdl_to_r->{$type}{r_macro}(r_vector)[elem_i] ) ) {
			p->state |= PDL_BADVAL;
			datad_${type}[elem_i] = badv_$type;
		}
	}
	break;
	%;
}
}}}

	}

	return p;
}