示例#1
0
文件: edit.cpp 项目: cran/magick
// [[Rcpp::export]]
Rcpp::RawVector magick_image_write( XPtrImage input, Rcpp::CharacterVector format, Rcpp::IntegerVector quality,
                                    Rcpp::IntegerVector depth, Rcpp::CharacterVector density, Rcpp::CharacterVector comment){
  if(!input->size())
    return Rcpp::RawVector(0);
  XPtrImage image = copy(input);
#if MagickLibVersion >= 0x691
  //suppress write warnings see #74 and #116
  image->front().quiet(true);
#endif
  if(format.size())
    for_each ( image->begin(), image->end(), Magick::magickImage(std::string(format[0])));
  if(quality.size())
    for_each ( image->begin(), image->end(), Magick::qualityImage(quality[0]));
  if(depth.size())
    for_each ( image->begin(), image->end(), Magick::depthImage(depth[0]));
  if(density.size()){
    for_each ( image->begin(), image->end(), Magick::resolutionUnitsImage(Magick::PixelsPerInchResolution));
    for_each ( image->begin(), image->end(), Magick::densityImage(Point(density[0])));
  }
  if(comment.size())
    for_each ( image->begin(), image->end(), Magick::commentImage(std::string(comment.at(0))));
  Magick::Blob output;
  writeImages( image->begin(), image->end(),  &output );
  Rcpp::RawVector res(output.length());
  std::memcpy(res.begin(), output.data(), output.length());
  return res;
}
示例#2
0
//' @rdname convert
//' @keywords internal manip
// [[Rcpp::export]]
Rcpp::List icd9ShortToPartsCpp(const Rcpp::CharacterVector icd9Short, const Rcpp::String minorEmpty) {

	Rcpp::CharacterVector major(icd9Short.size());
	Rcpp::CharacterVector minor(icd9Short.size());

	for (int i = 0; i < icd9Short.size(); ++i) {
		Rcpp::String thisShort = icd9Short[i];
		if (thisShort == NA_STRING) { // .is_na() is private?
			minor[i] = NA_STRING; // I think set_na() might be an alternative.
			continue;
		}

		std::string s(thisShort.get_cstring()); // TODO maybe better to use as?
		s = strimCpp(s); // in place or rewrite?
		std::string::size_type sz = s.size();

		if (icd9IsASingleE(s.c_str())) { // E code
			switch (sz) {
			case 2:
			case 3:
			case 4:
				major[i] = s.substr(0, sz);
				minor[i] = minorEmpty;
				break;
			case 5:
				major[i] = s.substr(0, 4);
				minor[i] = s.substr(4, 1);
				break;
			default:
				major[i] = NA_STRING;
				minor[i] = NA_STRING;
				continue;
			}
		} else { // not an E code
			switch (sz) {
			case 1:
			case 2:
			case 3:
				major[i] = s.substr(0, sz);
				minor[minorEmpty];
				continue;
			case 4:
			case 5:
				major[i] = s.substr(0, 3);
				minor[i] = s.substr(3, sz - 3);
				continue;
			default:
				major[i] = NA_STRING;
				minor[i] = NA_STRING;
				continue;
			}
		}

	} // for

	return icd9MajMinToParts(icd9AddLeadingZeroesMajor(major), minor);
}
示例#3
0
文件: gdal.cpp 项目: rundel/sfr
// [[Rcpp::export]]
Rcpp::List CPL_sfc_from_wkt(Rcpp::CharacterVector wkt) {
	std::vector<OGRGeometry *> g(wkt.size());
	OGRGeometryFactory f;
	for (int i = 0; i < wkt.size(); i++) {
		char *wkt_str = wkt(i);
#if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR <= 2
		handle_error(f.createFromWkt(&wkt_str, NULL, &(g[i])));
#else
		handle_error(f.createFromWkt( (const char*) wkt_str, NULL, &(g[i])));
#endif
	}
	return sfc_from_ogr(g, true);
}
示例#4
0
文件: gdal.cpp 项目: rundel/sfr
std::vector<char *> create_options(Rcpp::CharacterVector lco, bool quiet) {
	if (lco.size() == 0)
		quiet = true; // nothing to report
	if (! quiet)
		Rcpp::Rcout << "options:        "; // #nocov
	std::vector<char *> ret(lco.size() + 1);
	for (int i = 0; i < lco.size(); i++) {
		ret[i] = (char *) (lco[i]);
		if (! quiet)
			Rcpp::Rcout << ret[i] << " "; // #nocov
	}
	ret[lco.size()] = NULL;
	if (! quiet)
		Rcpp::Rcout << std::endl;         // #nocov
	return ret;
}
示例#5
0
文件: api.cpp 项目: ahtealeb/dplyr
    DataFrameJoinVisitors::DataFrameJoinVisitors(const Rcpp::DataFrame& left_, const Rcpp::DataFrame& right_, Rcpp::CharacterVector names_left, Rcpp::CharacterVector names_right, bool warn_ ) :
        left(left_), right(right_),
        visitor_names_left(names_left),
        visitor_names_right(names_right),
        nvisitors(names_left.size()),
        visitors(nvisitors),
        warn(warn_)
    {
        std::string name_left, name_right ;

        IntegerVector indices_left  = Language( "match", names_left,  RCPP_GET_NAMES(left)  ).fast_eval() ;
        IntegerVector indices_right = Language( "match", names_right, RCPP_GET_NAMES(right) ).fast_eval() ;

        for( int i=0; i<nvisitors; i++){
            name_left  = names_left[i] ;
            name_right = names_right[i] ;

            if( indices_left[i] == NA_INTEGER ){
              stop( "'%s' column not found in lhs, cannot join" ) ;
            }
            if( indices_right[i] == NA_INTEGER ){
              stop( "'%s' column not found in rhs, cannot join" ) ;
            }

            visitors[i] = join_visitor( left[indices_left[i]-1], right[indices_right[i]-1], name_left, name_right, warn ) ;

        }
    }
示例#6
0
SEXP rawSymmetricMatrixToDist(SEXP object)
{
BEGIN_RCPP
	Rcpp::S4 rawSymmetric = object;
	Rcpp::NumericVector levels = Rcpp::as<Rcpp::NumericVector>(rawSymmetric.slot("levels"));
	Rcpp::CharacterVector markers = Rcpp::as<Rcpp::CharacterVector>(rawSymmetric.slot("markers"));
	Rcpp::RawVector data = Rcpp::as<Rcpp::RawVector>(rawSymmetric.slot("data"));
	R_xlen_t size = markers.size(), levelsSize = levels.size();

	Rcpp::NumericVector result(size*(size - 1)/2, 0);
	int counter = 0;
	for(R_xlen_t row = 0; row < size; row++)
	{
		for(R_xlen_t column = row+1; column < size; column++)
		{
			int byte = data(column * (column + (R_xlen_t)1)/(R_xlen_t)2 + row);
			if(byte == 255) result(counter) = std::numeric_limits<double>::quiet_NaN();
			else result(counter) = levels(byte);
			counter++;
		}
	}
	result.attr("Size") = (int)size;
	result.attr("Labels") = markers;
	result.attr("Diag") = false;
	result.attr("Upper") = false;
	result.attr("class") = "dist";
	return result;
END_RCPP
}
示例#7
0
SEXP hclustThetaMatrix(SEXP mpcrossRF_, SEXP preClusterResults_)
{
BEGIN_RCPP
	Rcpp::List preClusterResults = preClusterResults_;
	bool noDuplicates;
	R_xlen_t preClusterMarkers = countPreClusterMarkers(preClusterResults_, noDuplicates);
	if(!noDuplicates)
	{
		throw std::runtime_error("Duplicate marker indices in call to hclustThetaMatrix");
	}

	Rcpp::S4 mpcrossRF = mpcrossRF_;
	Rcpp::S4 rf = mpcrossRF.slot("rf");

	Rcpp::S4 theta = rf.slot("theta");
	Rcpp::RawVector data = theta.slot("data");
	Rcpp::NumericVector levels = theta.slot("levels");
	Rcpp::CharacterVector markers = theta.slot("markers");
	if(markers.size() != preClusterMarkers)
	{
		throw std::runtime_error("Number of markers in precluster object was inconsistent with number of markers in mpcrossRF object");
	}
	R_xlen_t resultDimension = preClusterResults.size();
	//Allocate enough storage. This symmetric matrix stores the *LOWER* triangular part, in column-major storage. Excluding the diagonal. 
	Rcpp::NumericVector result(((resultDimension-(R_xlen_t)1)*resultDimension)/(R_xlen_t)2);
	for(R_xlen_t column = 0; column < resultDimension; column++)
	{
		Rcpp::IntegerVector columnMarkers = preClusterResults(column);
		for(R_xlen_t row = column + 1; row < resultDimension; row++)
		{
			Rcpp::IntegerVector rowMarkers = preClusterResults(row);
			double total = 0;
			R_xlen_t counter = 0;
			for(R_xlen_t columnMarkerCounter = 0; columnMarkerCounter < columnMarkers.size(); columnMarkerCounter++)
			{
				R_xlen_t marker1 = columnMarkers[columnMarkerCounter]-(R_xlen_t)1;
				for(R_xlen_t rowMarkerCounter = 0; rowMarkerCounter < rowMarkers.size(); rowMarkerCounter++)
				{
					R_xlen_t marker2 = rowMarkers[rowMarkerCounter]-(R_xlen_t)1;
					R_xlen_t column = std::max(marker1, marker2);
					R_xlen_t row = std::min(marker1, marker2);
					Rbyte thetaDataValue = data((column*(column+(R_xlen_t)1))/(R_xlen_t)2 + row);
					if(thetaDataValue != 0xFF)
					{
						total += levels(thetaDataValue);
						counter++;
					}
				}
			}
			if(counter == 0) total = 0.5;
			else total /= counter;
			result(((resultDimension-(R_xlen_t)1)*resultDimension)/(R_xlen_t)2 - ((resultDimension - column)*(resultDimension-column-(R_xlen_t)1))/(R_xlen_t)2 + row-column-(R_xlen_t)1) = total;
		}
	}
	return result;
END_RCPP
}
示例#8
0
文件: parse.cpp 项目: cran/RcppTOML
SEXP collapsedList(Rcpp::List ll) {
    if (ll.length() == 0) return R_NilValue;
    Rcpp::List::iterator it = ll.begin(); 
    switch(TYPEOF(*it)) {
        case REALSXP: {
            Rcpp::NumericVector v(ll.begin(), ll.end());
            Rcpp::RObject ro = ll[0];
            if (ro.hasAttribute("class")) {
                Rcpp::CharacterVector cv = ro.attr("class");
                if ((cv.size() == 1) && std::string(cv[0]) == "Date") {
                    Rcpp::DateVector dv(v);
                    return dv;
                }
                if ((cv.size() == 2) && std::string(cv[1]) == "POSIXt") {
                    Rcpp::DatetimeVector dtv(v);
                    return dtv;
                }
            }
            return v;
            break;              // not reached ...
        }
        case INTSXP: {
            Rcpp::IntegerVector v(ll.begin(), ll.end());
            return v;
            break;              // not reached ...
        }
        case LGLSXP: {
            Rcpp::LogicalVector v(ll.begin(), ll.end());
            return v;
            break;              // not reached ...
        }
        case STRSXP: {              // minor code smell that this is different :-/
            int n = ll.size();
            Rcpp::CharacterVector v(n);
            for (int i=0; i<n; i++) {
                std::string s = Rcpp::as<std::string>(ll[i]);
                v[i] = s;
            }
            return v;
            break;              // not reached ...
        }
    }
    return ll;
}
示例#9
0
文件: edit.cpp 项目: cran/magick
// [[Rcpp::export]]
XPtrImage magick_image_readpath(Rcpp::CharacterVector paths, Rcpp::CharacterVector density, Rcpp::IntegerVector depth, bool strip = false){
  XPtrImage image = create();
#if MagickLibVersion >= 0x689
  Magick::ReadOptions opts = Magick::ReadOptions();
#if MagickLibVersion >= 0x690
  opts.quiet(1);
#endif
  if(density.size())
    opts.density(std::string(density.at(0)).c_str());
  if(depth.size())
    opts.depth(depth.at(0));
  for(int i = 0; i < paths.size(); i++)
    Magick::readImages(image.get(), std::string(paths[i]), opts);
#else
  for(int i = 0; i < paths.size(); i++)
    Magick::readImages(image.get(), std::string(paths[i]));
#endif
  if(strip)
    for_each (image->begin(), image->end(), Magick::stripImage());
  return image;
}
示例#10
0
// [[Rcpp::export]]
Rcpp::CharacterVector icd9MajMinToShort(const Rcpp::CharacterVector major,
		const Rcpp::CharacterVector minor) {
#ifdef ICD9_DEBUG_TRACE
  Rcpp::Rcout << "icd9MajMinToShort: major.size() = " << major.size()
			<< " and minor.size() = " << minor.size() << "\n";
#endif
	if ((major.size() != 1 && major.size() != minor.size())
			|| (major.size() == 1 && minor.size() == 0)) {
		Rcpp::stop(
				"icd9MajMinToShort, length of majors and minors must be equal, unless majors length is one.");
	}
	if (major.size() == 1) {
#ifdef ICD9_DEBUG_TRACE
	  Rcpp::Rcout << "icd9MajMinToShort: major.size() = 1\n";
#endif
		Rcpp::CharacterVector newmajor(minor.size(), major[0]);
		return icd9MajMinToCode(newmajor, minor, true);
	}
	return icd9MajMinToCode(major, minor, true);
}
示例#11
0
SEXP constructDissimilarityMatrix(SEXP object, SEXP clusters_)
{
BEGIN_RCPP
	Rcpp::S4 rawSymmetric = object;
	Rcpp::NumericVector levels = Rcpp::as<Rcpp::NumericVector>(rawSymmetric.slot("levels"));
	Rcpp::CharacterVector markers = Rcpp::as<Rcpp::CharacterVector>(rawSymmetric.slot("markers"));
	Rcpp::RawVector data = Rcpp::as<Rcpp::RawVector>(rawSymmetric.slot("data"));
	int nMarkers = markers.size();
	std::vector<double> levelsCopied = Rcpp::as<std::vector<double> >(levels);
	
	std::vector<int> permutation(nMarkers);
	for(int i = 0; i < nMarkers; i++) permutation[i] = i;
	return constructDissimilarityMatrixInternal(&(data(0)), levelsCopied, nMarkers, clusters_, 0, permutation);
END_RCPP
}
示例#12
0
文件: edit.cpp 项目: cran/magick
// [[Rcpp::export]]
XPtrImage magick_image_readbin(Rcpp::RawVector x, Rcpp::CharacterVector density, Rcpp::IntegerVector depth, bool strip = false){
  XPtrImage image = create();
#if MagickLibVersion >= 0x689
  Magick::ReadOptions opts = Magick::ReadOptions();
#if MagickLibVersion >= 0x690
  opts.quiet(1);
#endif
  if(density.size())
    opts.density(std::string(density.at(0)).c_str());
  if(depth.size())
    opts.depth(depth.at(0));
  Magick::readImages(image.get(), Magick::Blob(x.begin(), x.length()), opts);
#else
  Magick::readImages(image.get(), Magick::Blob(x.begin(), x.length()));
#endif
  if(strip)
    for_each (image->begin(), image->end(), Magick::stripImage());
  return image;
}
示例#13
0
文件: api.cpp 项目: ahtealeb/dplyr
    DataFrameSubsetVisitors::DataFrameSubsetVisitors( const Rcpp::DataFrame& data_, const Rcpp::CharacterVector& names ) :
        data(data_),
        visitors(),
        visitor_names(names),
        nvisitors(visitor_names.size())
    {

        std::string name ;
        int n = names.size() ;
        IntegerVector indices  = Language( "match", names,  RCPP_GET_NAMES(data)  ).fast_eval() ;

        for( int i=0; i<n; i++){
            int pos = indices[i] ;
            if( pos == NA_INTEGER ){
                name = (String)names[i] ;
                stop( "unknown column '%s' ", name ) ;
            }
            visitors.push_back(subset_visitor( data[pos-1] )) ;
        }
    }
示例#14
0
// [[Rcpp::export]]
void write_fasta( Rcpp::CharacterVector seq,
                  std::string seqname, 
                  std::string filename, 
                  int rowlength=80,
                  int verbose=1) {
//  rowlength=rowlength-1;
  FILE * pFile;
//  pFile=fopen(filename.c_str(),"wt");
  pFile=fopen(filename.c_str(),"at");
  int i = 0;
//  unsigned int i = 0;
  
  if(verbose == 1){
    Rcpp::Rcout << "Processing sample: " << seqname << "\n";
  }

  putc ('>' , pFile);
  for(i=0; (unsigned)i<seqname.size(); i++){
    putc (seqname[i] , pFile);
  }
  putc ('\n' , pFile);

  putc (Rcpp::as< char >(seq[0]) , pFile);
  for(i=1; i<seq.size(); i++){
    Rcpp::checkUserInterrupt();
//    putc (seq[i][0] , pFile);
    if( i % rowlength == 0){
      putc('\n', pFile);
    }
    putc (Rcpp::as< char >(seq[i]) , pFile);
    if(i % nreport == 0 && verbose == 1){
      Rcpp::Rcout << "\rNucleotide " << i << " processed";
    }
  }
  putc('\n', pFile);
  fclose (pFile);
  if(verbose == 1){
    Rcpp::Rcout << "\rNucleotide " << i << " processed\n";
  }
//  return 0;
}
示例#15
0
文件: api.cpp 项目: Aprilara/dplyr
    DataFrameJoinVisitors::DataFrameJoinVisitors(const Rcpp::DataFrame& left_, const Rcpp::DataFrame& right_, Rcpp::CharacterVector names_left, Rcpp::CharacterVector names_right, bool warn_ ) :
        left(left_), right(right_),
        visitor_names_left(names_left),
        visitor_names_right(names_right),
        nvisitors(names_left.size()),
        visitors(nvisitors),
        warn(warn_)
    {
        std::string name_left, name_right ;
        for( int i=0; i<nvisitors; i++){
            name_left  = names_left[i] ;
            name_right = names_right[i] ;

            try{
                visitors[i] = join_visitor( left[name_left], right[name_right], name_left, name_right, warn ) ;
            } catch( const std::exception& ex ){
                stop( "cannot join on columns '%s' x '%s': %s ", name_left, name_right, ex.what() ) ;
            } catch( ... ){
                stop( "cannot join on columns '%s' x '%s'", name_left, name_right ) ;
            }
        }
    }
示例#16
0
SEXP hclustCombinedMatrix(SEXP mpcrossRF_, SEXP preClusterResults_)
{
BEGIN_RCPP
	bool noDuplicates;
	R_xlen_t preClusterMarkers = countPreClusterMarkers(preClusterResults_, noDuplicates);
	if(!noDuplicates)
	{
		throw std::runtime_error("Duplicate marker indices in call to hclustThetaMatrix");
	}

	Rcpp::List preClusterResults = preClusterResults_;
	Rcpp::S4 mpcrossRF = mpcrossRF_;
	Rcpp::S4 rf = mpcrossRF.slot("rf");

	Rcpp::RObject lodObject = rf.slot("lod");
	if(lodObject.isNULL())
	{
		throw std::runtime_error("Slot mpcrossRF@rf@lod cannot be NULL if clusterBy is equal to \"combined\"");
	}
	Rcpp::S4 lod = Rcpp::as<Rcpp::S4>(lodObject);
	Rcpp::S4 theta = rf.slot("theta");
	Rcpp::RawVector data = theta.slot("data");
	Rcpp::NumericVector levels = theta.slot("levels");
	Rcpp::CharacterVector markers = theta.slot("markers");
	Rcpp::NumericVector lodData = lod.slot("x");
	if(markers.size() != preClusterMarkers || lodData.size() != (preClusterMarkers*(preClusterMarkers+(R_xlen_t)1))/(R_xlen_t)2)
	{
		throw std::runtime_error("Number of markers in precluster object was inconsistent with number of markers in mpcrossRF object");
	}
	R_xlen_t resultDimension = preClusterResults.size();
	//Work out minimum difference between recombination levels
	double minDifference = 1;
	for(int i = 0; i < levels.size()-1; i++)
	{
		minDifference = std::min(minDifference, levels[i+1] - levels[i]);
	}
	double maxLod = *std::max_element(lodData.begin(), lodData.end());
	double lodMultiplier = minDifference/maxLod;
	//Allocate enough storage. This symmetric matrix stores the *LOWER* triangular part, in column-major storage. Excluding the diagonal. 
	Rcpp::NumericVector result(((resultDimension-(R_xlen_t)1)*resultDimension)/(R_xlen_t)2);
	for(R_xlen_t column = 0; column < resultDimension; column++)
	{
		Rcpp::IntegerVector columnMarkers = preClusterResults(column);
		for(R_xlen_t row = column + (R_xlen_t)1; row < resultDimension; row++)
		{
			Rcpp::IntegerVector rowMarkers = preClusterResults(row);
			double total = 0;
			R_xlen_t counter = 0;
			for(int columnMarkerCounter = 0; columnMarkerCounter < columnMarkers.size(); columnMarkerCounter++)
			{
				R_xlen_t marker1 = columnMarkers[columnMarkerCounter]-(R_xlen_t)1;
				for(int rowMarkerCounter = 0; rowMarkerCounter < rowMarkers.size(); rowMarkerCounter++)
				{
					R_xlen_t marker2 = rowMarkers[rowMarkerCounter]-(R_xlen_t)1;
					R_xlen_t column = std::max(marker1, marker2);
					R_xlen_t row = std::min(marker1, marker2);
					Rbyte thetaDataValue = data((column*(column+(R_xlen_t)1))/(R_xlen_t)2 + row);
					double currentLodDataValue = lodData((column*(column+(R_xlen_t)1))/(R_xlen_t)2 + row);
					if(thetaDataValue != 0xFF && currentLodDataValue != NA_REAL && currentLodDataValue == currentLodDataValue)
					{
						total += levels(thetaDataValue) + (maxLod - currentLodDataValue) *lodMultiplier;
						counter++;
					}
				}
			}
			if(counter == 0) total = 0.5 + minDifference;
			else total /= counter;
			result(((resultDimension-1)*resultDimension)/(R_xlen_t)2 - ((resultDimension - column)*(resultDimension-column-(R_xlen_t)1))/(R_xlen_t)2 + row-column-(R_xlen_t)1) = total;
		}
	}
	return result;
END_RCPP
}
	bool isUndirectedGraphNEL(SEXP graph_sexp)
	{
		Rcpp::S4 graph_s4;
		try
		{
			graph_s4 = Rcpp::as<Rcpp::S4>(graph_sexp);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Input graph must be an S4 object");
		}
		if(Rcpp::as<std::string>(graph_s4.attr("class")) != "graphNEL")
		{
			throw std::runtime_error("Input graph must have class graphNEL");
		}
		
		Rcpp::RObject nodes_obj;
		try
		{
			nodes_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("nodes"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot nodes");
		}

		Rcpp::RObject edges_obj;
		try
		{
			edges_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("edgeL"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot edgeL");
		}

		Rcpp::CharacterVector nodeNames;
		try
		{
			nodeNames = Rcpp::as<Rcpp::CharacterVector>(nodes_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot nodes of input graph must be a character vector");
		}
		{
			std::vector<std::string> uniqueNodeNames = Rcpp::as<std::vector<std::string> >(nodeNames);
			std::sort(uniqueNodeNames.begin(), uniqueNodeNames.end());
			uniqueNodeNames.erase(std::unique(uniqueNodeNames.begin(), uniqueNodeNames.end()), uniqueNodeNames.end());
			if((std::size_t)uniqueNodeNames.size() != (std::size_t)nodeNames.size())
			{
				throw std::runtime_error("Node names of input graph were not unique");
			}
		}
		int nVertices = nodeNames.size();

		Rcpp::List edges_list;
		try
		{
			edges_list = Rcpp::as<Rcpp::List>(edges_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot edgeL of input graph must be a list");
		}
		Rcpp::CharacterVector edges_list_names = Rcpp::as<Rcpp::CharacterVector>(edges_list.attr("names"));

		Context::inputGraph graphRef = Context::inputGraph(nVertices);
		for(int i = 0; i < edges_list.size(); i++)
		{
			int nodeIndex = std::distance(nodeNames.begin(), std::find(nodeNames.begin(), nodeNames.end(), edges_list_names(i)));
			Rcpp::List subList;
			Rcpp::CharacterVector subListNames;
			try
			{
				subList = Rcpp::as<Rcpp::List>(edges_list(i));
				subListNames = Rcpp::as<Rcpp::CharacterVector>(subList.attr("names"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			if(std::find(subListNames.begin(), subListNames.end(), "edges") == subListNames.end())
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			Rcpp::NumericVector targetIndicesThisNode;
			try
			{
				targetIndicesThisNode = Rcpp::as<Rcpp::NumericVector>(subList("edges"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			for(int j = 0; j < targetIndicesThisNode.size(); j++)
			{
				boost::add_edge((std::size_t)nodeIndex, (std::size_t)((int)targetIndicesThisNode(j)-1), graphRef);
			}
		}
		Context::inputGraph::edge_iterator current, end;
		boost::tie(current, end) = boost::edges(graphRef);
		for(; current != end; current++)
		{
			int source = boost::source(*current, graphRef), target = boost::target(*current, graphRef);
			if(!boost::edge(target, source, graphRef).second)
			{
				return false;
			}
		}
		return true;
	}
	void convertGraphNEL(SEXP graph_sexp, context::inputGraph& graphRef)
	{
		Rcpp::S4 graph_s4;
		try
		{
			graph_s4 = Rcpp::as<Rcpp::S4>(graph_sexp);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Input graph must be an S4 object");
		}
		if(Rcpp::as<std::string>(graph_s4.attr("class")) != "graphNEL")
		{
			throw std::runtime_error("Input graph must have class graphNEL");
		}
		
		Rcpp::RObject nodes_obj;
		try
		{
			nodes_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("nodes"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot nodes");
		}

		Rcpp::RObject edges_obj;
		try
		{
			edges_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("edgeL"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot edgeL");
		}

		Rcpp::CharacterVector nodeNames;
		try
		{
			nodeNames = Rcpp::as<Rcpp::CharacterVector>(nodes_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot nodes of input graph must be a character vector");
		}
		{
			std::vector<std::string> uniqueNodeNames = Rcpp::as<std::vector<std::string> >(nodeNames);
			std::sort(uniqueNodeNames.begin(), uniqueNodeNames.end());
			uniqueNodeNames.erase(std::unique(uniqueNodeNames.begin(), uniqueNodeNames.end()), uniqueNodeNames.end());
			if((std::size_t)uniqueNodeNames.size() != (std::size_t)nodeNames.size())
			{
				throw std::runtime_error("Node names of input graph were not unique");
			}
		}
		int nVertices = nodeNames.size();

		Rcpp::List edges_list;
		try
		{
			edges_list = Rcpp::as<Rcpp::List>(edges_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot edgeL of input graph must be a list");
		}
		Rcpp::CharacterVector edges_list_names = Rcpp::as<Rcpp::CharacterVector>(edges_list.attr("names"));

		graphRef = context::inputGraph(nVertices);
		int edgeIndexCounter = 0;
		for(int i = 0; i < edges_list.size(); i++)
		{
			int nodeIndex = std::distance(nodeNames.begin(), std::find(nodeNames.begin(), nodeNames.end(), edges_list_names(i)));
			Rcpp::List subList;
			Rcpp::CharacterVector subListNames;
			try
			{
				subList = Rcpp::as<Rcpp::List>(edges_list(i));
				subListNames = Rcpp::as<Rcpp::CharacterVector>(subList.attr("names"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			if(std::find(subListNames.begin(), subListNames.end(), "edges") == subListNames.end())
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			Rcpp::NumericVector targetIndicesThisNode;
			try
			{
				targetIndicesThisNode = Rcpp::as<Rcpp::NumericVector>(subList("edges"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			for(int j = 0; j < targetIndicesThisNode.size(); j++)
			{
				boost::add_edge((std::size_t)nodeIndex, (std::size_t)((int)targetIndicesThisNode(j)-1), edgeIndexCounter, graphRef);
				edgeIndexCounter++;
			}
		}
	}
示例#19
0
//' rcpp_lines_as_network
//'
//' Return OSM data in Simple Features format
//'
//' @param sf_lines An sf collection of LINESTRING objects
//' @param pr Rcpp::DataFrame containing the weighting profile
//'
//' @return Rcpp::List objects of OSM data
//'
//' @noRd
// [[Rcpp::export]]
Rcpp::List rcpp_lines_as_network (const Rcpp::List &sf_lines,
        Rcpp::DataFrame pr)
{
    std::map <std::string, float> profile;
    Rcpp::StringVector hw = pr [1];
    Rcpp::NumericVector val = pr [2];
    for (int i = 0; i != hw.size (); i ++)
        profile.insert (std::make_pair (std::string (hw [i]), val [i]));

    Rcpp::CharacterVector nms = sf_lines.attr ("names");
    if (nms [nms.size () - 1] != "geometry")
        throw std::runtime_error ("sf_lines have no geometry component");
    if (nms [0] != "osm_id")
        throw std::runtime_error ("sf_lines have no osm_id component");
    int one_way_index = -1;
    int one_way_bicycle_index = -1;
    int highway_index = -1;
    for (int i = 0; i < nms.size (); i++)
    {
        if (nms [i] == "oneway")
            one_way_index = i;
        if (nms [i] == "oneway.bicycle")
            one_way_bicycle_index = i;
        if (nms [i] == "highway")
            highway_index = i;
    }
    Rcpp::CharacterVector ow = NULL;
    Rcpp::CharacterVector owb = NULL;
    Rcpp::CharacterVector highway = NULL;
    if (one_way_index >= 0)
        ow = sf_lines [one_way_index];
    if (one_way_bicycle_index >= 0)
        owb = sf_lines [one_way_bicycle_index];
    if (highway_index >= 0)
        highway = sf_lines [highway_index];
    if (ow.size () > 0)
    {
        if (ow.size () == owb.size ())
        {
            for (unsigned i = 0; i != ow.size (); ++ i)
                if (ow [i] == "NA" && owb [i] != "NA")
                    ow [i] = owb [i];
        } else if (owb.size () > ow.size ())
            ow = owb;
    }

    Rcpp::List geoms = sf_lines [nms.size () - 1];
    std::vector<bool> isOneWay (geoms.length ());
    std::fill (isOneWay.begin (), isOneWay.end (), false);
    // Get dimension of matrix
    size_t nrows = 0;
    int ngeoms = 0;
    for (auto g = geoms.begin (); g != geoms.end (); ++g)
    {
        // Rcpp uses an internal proxy iterator here, NOT a direct copy
        Rcpp::NumericMatrix gi = (*g);
        int rows = gi.nrow () - 1;
        nrows += rows;
        if (ngeoms < ow.size ())
        {
            if (!(ow [ngeoms] == "yes" || ow [ngeoms] == "-1"))
            {
                nrows += rows;
                isOneWay [ngeoms] = true;
            }
        }
        ngeoms ++;
    }

    Rcpp::NumericMatrix nmat = Rcpp::NumericMatrix (Rcpp::Dimension (nrows, 6));
    Rcpp::CharacterMatrix idmat = Rcpp::CharacterMatrix (Rcpp::Dimension (nrows,
                3));

    nrows = 0;
    ngeoms = 0;
    int fake_id = 0;
    for (auto g = geoms.begin (); g != geoms.end (); ++ g)
    {
        Rcpp::NumericMatrix gi = (*g);
        std::string hway = std::string (highway [ngeoms]);
        float hw_factor = profile [hway];
        if (hw_factor == 0.0) hw_factor = 1e-5;
        hw_factor = 1.0 / hw_factor;

        Rcpp::List ginames = gi.attr ("dimnames");
        Rcpp::CharacterVector rnms;
        if (ginames.length () > 0)
            rnms = ginames [0];
        else
        {
            rnms = Rcpp::CharacterVector (gi.nrow ());
            for (int i = 0; i < gi.nrow (); i ++)
                rnms [i] = fake_id ++;
        }
        if (rnms.size () != gi.nrow ())
            throw std::runtime_error ("geom size differs from rownames");

        for (int i = 1; i < gi.nrow (); i ++)
        {
            float d = haversine (gi (i-1, 0), gi (i-1, 1), gi (i, 0),
                    gi (i, 1));
            nmat (nrows, 0) = gi (i-1, 0);
            nmat (nrows, 1) = gi (i-1, 1);
            nmat (nrows, 2) = gi (i, 0);
            nmat (nrows, 3) = gi (i, 1);
            nmat (nrows, 4) = d;
            nmat (nrows, 5) = d * hw_factor;
            idmat (nrows, 0) = rnms (i-1);
            idmat (nrows, 1) = rnms (i);
            idmat (nrows, 2) = hway;
            nrows ++;
            if (isOneWay [ngeoms])
            {
                nmat (nrows, 0) = gi (i, 0);
                nmat (nrows, 1) = gi (i, 1);
                nmat (nrows, 2) = gi (i-1, 0);
                nmat (nrows, 3) = gi (i-1, 1);
                nmat (nrows, 4) = d;
                nmat (nrows, 5) = d * hw_factor;
                idmat (nrows, 0) = rnms (i);
                idmat (nrows, 1) = rnms (i-1);
                idmat (nrows, 2) = hway;
                nrows ++;
            }
        }
        ngeoms ++;
    }

    Rcpp::List res (2);
    res [0] = nmat;
    res [1] = idmat;

    return res;
}
示例#20
0
//[[Rcpp::export]]
Rcpp::List checkTreeCpp(Rcpp::S4 obj, Rcpp::List opts) {
  
    std::string err, wrn;
    Rcpp::IntegerMatrix ed = obj.slot("edge");
    int nrow = ed.nrow();
    Rcpp::IntegerVector ances = getAnces(ed);
    //Rcpp::IntegerVector desc = getDesc(ed);
    int nroots = nRoots(ances);
    bool rooted = nroots > 0;
    Rcpp::NumericVector edLength = obj.slot("edge.length");
    Rcpp::CharacterVector edLengthNm = edLength.names();
    Rcpp::CharacterVector label = obj.slot("label");
    Rcpp::CharacterVector labelNm = label.names();
    Rcpp::CharacterVector edLabel = obj.slot("edge.label");
    Rcpp::CharacterVector edLabelNm = edLabel.names();
    Rcpp::IntegerVector allnodesSafe = getAllNodesSafe(ed);
    Rcpp::IntegerVector allnodesFast = getAllNodesFast(ed, rooted);
    int nEdLength = edLength.size();
    int nLabel = label.size();
    int nEdLabel = edLabel.size();
    int nEdges = nrow;
    bool hasEdgeLength = !all_naC(edLength);

    // check tips
    int ntipsSafe = nTipsSafe(ances);
    int ntipsFast = nTipsFastCpp(ances);
    bool testnTips = ntipsFast == ntipsSafe;
    if (! testnTips) {
	err.append("Tips incorrectly labeled. ");
    }

    //check internal nodes
    bool testNodes = Rcpp::all(allnodesSafe == allnodesFast).is_true() && // is both ways comparison needed?
    	Rcpp::all(allnodesFast == allnodesSafe).is_true();
    if (! testNodes) {
    	err.append("Nodes incorrectly labeled. ");
    }

    // check edge lengths
    if (hasEdgeLength) {	
    	if (nEdLength != nEdges) {
    	    err.append("Number of edge lengths do not match number of edges. ");
    	}
    	// if (nb_naC(edLength) > nroots) { // not enough!  -- best done in R
    	//     err.append("Only the root should have NA as an edge length. ");
    	// }
    	if (getRange(edLength, TRUE)[0] < 0) {
    	    err.append("Edge lengths must be non-negative. ");
    	}
    	Rcpp::CharacterVector edgeLblSupp = edgeIdCpp(ed, "all");
	Rcpp::CharacterVector edgeLblDiff = Rcpp::setdiff(edLengthNm, edgeLblSupp);
    	if ( edgeLblDiff.size() != 0 ) {
    	    err.append("Edge lengths incorrectly labeled. ");
    	}	    
    }
    
    // check label names
    Rcpp::CharacterVector chrLabelNm = Rcpp::as<Rcpp::CharacterVector>(allnodesFast);
    int j = 0;
    while (j < nroots) { //remove root(s)
    	chrLabelNm.erase(0); 
    	j++;
    }
    bool testLabelNm = isLabelName(labelNm, chrLabelNm);
    if (!testLabelNm) {
    	err.append("Tip and node labels must be a named vector, the names must match the node IDs. ");
    	err.append("Use tipLabels<- and/or nodeLabels<- to update them. ");
    }
    
    // check that tips have labels
    Rcpp::CharacterVector tiplabel(ntipsFast);
    std::copy (label.begin(), label.begin()+ntipsFast, tiplabel.begin());
    bool emptyTipLabel = is_true(any(Rcpp::is_na(tiplabel)));
    if ( emptyTipLabel ) {
    	err.append("All tips must have a label.");
    }

    // check edgeLabels
    Rcpp::CharacterVector chrEdgeLblNm = edgeIdCpp(ed, "all");
    bool testEdgeLblNm = isLabelName(edLabelNm, chrEdgeLblNm);
    if (!testEdgeLblNm) {
    	err.append("Edge labels are not labelled correctly. Use the function edgeLabels<- to update them. ");
    }

    // make sure that tips and node labels are unique
    if (hasDuplicatedLabelsCpp(label)) {
	std::string labOpt = opts["allow.duplicated.labels"];
	if (labOpt == "fail") {
	    err.append("Labels are not unique. ");
	}
	if (labOpt == "warn") {
	    wrn.append("Labels are not unique. ");
	}
    }

    // check for polytomies
    if (hasPolytomy(ances)) {
	std::string msgPoly = "Tree includes polytomies. ";
	std::string polyOpt = opts["poly"];
	if (polyOpt == "fail") {
	    err.append(msgPoly);
	}
	if (polyOpt == "warn") {
	    wrn.append(msgPoly);
	}
    }

    // check number of roots
    if (nroots > 1) {
	std::string msgRoot = "Tree has more than one root. ";
	std::string rootOpt = opts["multiroot"];
	if (rootOpt == "fail") {
	    err.append(msgRoot);
	}
	if (rootOpt == "warn") {
	    wrn.append(msgRoot);
	}
    }

    // check for singletons
    if (hasSingleton(ances)) {
	std::string msgSing = "Tree contains singleton nodes. ";
	std::string singOpt = opts["singleton"];
	if (singOpt == "fail") {
	    err.append(msgSing);
	}
	if (singOpt == "warn") {
	    wrn.append(msgSing);
	}
    }

    return Rcpp::List::create(err, wrn);
}
示例#21
0
//[[Rcpp::export]]
bool isLabelName(Rcpp::CharacterVector lblToCheck,
		 Rcpp::CharacterVector lbl ) {

    Rcpp::CharacterVector noLbl = Rcpp::setdiff(lblToCheck, lbl);
    return noLbl.size() == 0;
}
示例#22
0
// [[Rcpp::export]]
Rcpp::CharacterVector icd9MajMinToCode(const Rcpp::CharacterVector major,
		const Rcpp::CharacterVector minor, bool isShort) {
#ifdef ICD9_DEBUG_TRACE
  Rcpp::Rcout << "icd9MajMinToCode: major.size() = " << major.size()
			<< " and minor.size() = " << minor.size() << "\n";
#endif

	if (major.size() != minor.size())
		Rcpp::stop("major and minor lengths differ");

#ifdef ICD9_DEBUG_TRACE
	Rcpp::Rcout << "major and minor are the same?\n";
#endif

	Rcpp::CharacterVector out; // wish I could reserve space for this
	Rcpp::CharacterVector::const_iterator j = major.begin();
	Rcpp::CharacterVector::const_iterator n = minor.begin();

	for (; j != major.end() && n != minor.end(); ++j, ++n) {
		Rcpp::String mjrelem = *j;
		if (mjrelem == NA_STRING) {
			out.push_back(NA_STRING);
			continue;
		}
		// work around Rcpp bug with push_front: convert to string just for this
		// TODO: try to do this with C string instead
		const char* smj_c = mjrelem.get_cstring();
		std::string smj = std::string(smj_c);
		switch (strlen(smj_c)) {
		case 0:
			out.push_back(NA_STRING);
			continue;
		case 1:
			if (!icd9IsASingleVE(smj_c)) {
				smj.insert(0, "00");
			}
			break;
		case 2:
			if (!icd9IsASingleVE(smj_c)) {
				smj.insert(0, "0");
			} else {
				smj.insert(1, "0");
			}
			// default: // major is 3 (or more) chars already
		}
		Rcpp::String mnrelem = *n;
		if (mnrelem == NA_STRING) {
			//out.push_back(mjrelem);
			out.push_back(smj);
			continue;
		}
		// this can probably be done more quickly:
		//std::string smj(mjrelem);
		if (!isShort && mnrelem != "") {
			smj.append(".");
		}
		smj.append(mnrelem);
		out.push_back(smj);

	}
	// ?slow step somewhere around here, with use of Rcpp::String, maybe in the wrapping? Maybe in the multiple push_back calls

	//return wrap(out);
	return out;
}