// [[Rcpp::export]] XPtrImage magick_image_readbitmap_raster2(Rcpp::CharacterMatrix x){ std::vector<rcolor> y(x.size()); for(size_t i = 0; i < y.size(); i++) y[i] = R_GE_str2col(x[i]); Rcpp::IntegerVector dims(x.attr("dim")); return magick_image_bitmap(y.data(), Magick::CharPixel, 4, dims[1], dims[0]); }
// [[Rcpp::export]] Rcpp::DataFrame gt_to_popsum(Rcpp::DataFrame var_info, Rcpp::CharacterMatrix gt) { // Calculate popgen summaries for the sample. // var_info should contain columns named 'CHROM', 'POS', 'mask' and possibly others. Rcpp::LogicalVector mask = var_info["mask"]; Rcpp::IntegerVector nsample(mask.size()); Rcpp::StringVector allele_counts(mask.size()); Rcpp::NumericVector Hes(mask.size()); Rcpp::NumericVector Nes(mask.size()); int i = 0; int j = 0; int k = 0; for(i=0; i < gt.nrow(); i++){ // Iterate over variants (rows) if(mask[i] == TRUE){ std::vector<int> myalleles (1,0); for(j=0; j < gt.ncol(); j++){ // Iterate over samples (columns) if(gt(i, j) != NA_STRING){ nsample[i]++; // Increment sample count. // Count alleles per sample. std::vector < int > intv = gtsplit(as<std::string>(gt(i, j))); for(k=0; k<intv.size(); k++){ while(myalleles.size() - 1 < intv[k]){ // We have more alleles than exist in the vector myalleles. myalleles.push_back(0); } myalleles[intv[k]]++; } } } // Concatenate allele counts into a comma delimited string. int n; char buffer [50]; n = sprintf (buffer, "%d", myalleles[0]); for(j=1; j < myalleles.size(); j++){ n=sprintf (buffer, "%s,%d", buffer, myalleles[j]); } allele_counts[i] = buffer; // Sum all alleles. int nalleles = myalleles[0]; for(j=1; j < myalleles.size(); j++){ nalleles = nalleles + myalleles[j]; } // Stats. double He = 1; He = He - pow(double(myalleles[0])/double(nalleles), myalleles.size()); for(j=1; j < myalleles.size(); j++){ He = He - pow(double(myalleles[j])/double(nalleles), myalleles.size()); } Hes[i] = He; Nes[i] = 1/(1-He); } else { // Missing variant (row=NA) nsample[i] = NA_INTEGER; } } return Rcpp::DataFrame::create(var_info, _["n"]=nsample, _["Allele_counts"]=allele_counts, _["He"]=Hes, _["Ne"]=Nes ); }
// [[Rcpp::export]] void write_vcf_body( Rcpp::CharacterMatrix fix, Rcpp::CharacterMatrix gt, std::string filename, int mask=0 ) { // http://stackoverflow.com/a/5649224 // int verbose = 0; // int verbose = 1; if( verbose == 1 ){ Rcpp::Rcout << "Made it into the function!\n"; } int i = 0; // Rows int j = 0; // Columns std::string tmpstring; // Assemble each line before writing // Initialize filehandle. gzFile fi; // Initialize file. // Note that gzfile does not tolerate initializing an empty file. // Use ofstream instead. if ( ! std::ifstream( filename ) ){ if( verbose == 1 ){ Rcpp::Rcout << "File does not exist." << std::endl; } std::ofstream myfile; myfile.open (filename, std::ios::out | std::ios::binary); myfile.close(); // This should make valgrind hang. // Or not??? // fi = gzopen( filename.c_str(), "ab" ); // gzclose(fi); } // In order for APPEND=TRUE to work the header // should not be printed here. if( verbose == 1 ){ Rcpp::Rcout << "Matrix fix has " << fix.nrow() << " rows (variants).\n"; } // Manage body if( fix.nrow() >= 1 ){ if( verbose == 1 ){ Rcpp::Rcout << "Processing the body (variants).\n"; } // There is at least one variant. fi = gzopen( filename.c_str(), "ab" ); if (! fi) { Rcpp::Rcerr << "gzopen of " << filename << " failed: " << strerror (errno) << ".\n"; } for(i = 0; i < fix.nrow(); i++){ Rcpp::checkUserInterrupt(); if(mask == 1 && fix(i,6) != "PASS" ){ // Don't print variant. } else { // Print variant. j = 0; tmpstring = fix(i,j); for(j = 1; j < fix.ncol(); j++){ if(fix(i,j) == NA_STRING){ tmpstring = tmpstring + "\t" + "."; } else { tmpstring = tmpstring + "\t" + fix(i,j); } } // gt portion for(j = 0; j < gt.ncol(); j++){ if(gt(i, j) == NA_STRING){ tmpstring = tmpstring + "\t" + "./."; } else { tmpstring = tmpstring + "\t" + gt(i, j); } } gzwrite(fi, tmpstring.c_str(), tmpstring.size()); gzwrite(fi,"\n",strlen("\n")); } } if( verbose == 1 ){ Rcpp::Rcout << "Finished processing the body (variants).\n"; } gzclose(fi); } else { if( verbose == 1 ){ Rcpp::Rcout << "No rows (variants).\n"; } } // return void; }
//' @export // [[Rcpp::export(name=".gt_to_popsum")]] Rcpp::DataFrame gt_to_popsum(Rcpp::DataFrame var_info, Rcpp::CharacterMatrix gt) { // Calculate popgen summaries for the sample. // var_info should contain columns named 'CHROM', 'POS', 'mask' and possibly others. Rcpp::LogicalVector mask = var_info["mask"]; Rcpp::IntegerVector nsample(mask.size()); Rcpp::StringVector allele_counts(mask.size()); Rcpp::NumericVector Hes(mask.size()); Rcpp::NumericVector Nes(mask.size()); int i = 0; int j = 0; // unsigned int j = 0; unsigned int k = 0; for(i=0; i < gt.nrow(); i++){ // Iterate over variants (rows) if(mask[i] == TRUE){ std::vector<int> myalleles (1,0); for(j=0; j < gt.ncol(); j++){ // Iterate over samples (columns) if(gt(i, j) != NA_STRING){ nsample[i]++; // Increment sample count. // Rcout << "gt: " << gt(i, j) << "\n"; // Count alleles per sample. int unphased_as_na = 0; // 0 == FALSE std::vector < std::string > gt_vector; std::string gt2 = as<std::string>(gt(i,j)); vcfRCommon::gtsplit( gt2, gt_vector, unphased_as_na ); // Rcout << "gt_vector.size: " << gt_vector.size() << "\n"; for(k=0; k<gt_vector.size(); k++){ int myAllele = std::stoi(gt_vector[k]); // Rcout << " " << myAllele; // // If this genotype had an allele we did not previously observe // we'll have to grow the vector. while(myalleles.size() - 1 < myAllele){ myalleles.push_back(0); } myalleles[myAllele]++; } // Rcout << "\n\n"; } } // Concatenate allele counts into a comma delimited string. char buffer [50]; // int n; // n=sprintf(buffer, "%d", myalleles[0]); sprintf(buffer, "%d", myalleles[0]); for(j=1; (unsigned)j < myalleles.size(); j++){ // n=sprintf (buffer, "%s,%d", buffer, myalleles[j]); sprintf (buffer, "%s,%d", buffer, myalleles[j]); } allele_counts[i] = buffer; // Sum all alleles. int nalleles = myalleles[0]; for(j=1; (unsigned)j < myalleles.size(); j++){ nalleles = nalleles + myalleles[j]; } // Stats. double He = 1; He = He - pow(double(myalleles[0])/double(nalleles), myalleles.size()); for(j=1; (unsigned)j < myalleles.size(); j++){ He = He - pow(double(myalleles[j])/double(nalleles), myalleles.size()); } Hes[i] = He; Nes[i] = 1/(1-He); } else { // Missing variant (row=NA) nsample[i] = NA_INTEGER; } } return Rcpp::DataFrame::create(var_info, _["n"]=nsample, _["Allele_counts"]=allele_counts, _["He"]=Hes, _["Ne"]=Nes ); }