├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R └── vectorwindow.R ├── README.md └── src └── vecwindows.c /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: vectorwindow 2 | Title: Simple Views Into Existing Vectors Via ALTREP 3 | Version: 0.0-1 4 | Author: Gabriel Becker 5 | Description: A simple implementation of views into existing vectors 6 | Maintainer: Gabriel Becker 7 | License: Artistic 2.0 8 | ByteCompile: yes 9 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Refer to all C routines by their name prefixed by C_ 2 | useDynLib(vectorwindow, .registration = TRUE, .fixes = "C_") 3 | 4 | export(vector_window) -------------------------------------------------------------------------------- /R/vectorwindow.R: -------------------------------------------------------------------------------- 1 | 2 | vector_window <- function(parent, start, len) { 3 | ## no sneaky integer vectors allowed 4 | stopifnot(mode(parent) == "numeric") 5 | start <- as.numeric(start) 6 | len <- as.numeric(len) 7 | start_len <- c(start - 1, # C is 0 indexed 8 | len) 9 | .Call("make_window_real", 10 | parent, 11 | start_len, 12 | PACKAGE = "vectorwindow") 13 | } 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # vectorwindow 2 | An Example ALTREP package which implements vectors as windows/views on other vectors without duplication. 3 | 4 | A simple ALTREP package developed for presentation to the Bioconductor Developer Forum on Nov 19, 2020. 5 | 6 | This package impements (currently only for REALSXP vectors) the concept of constructing a view into a 7 | contiguous range of elements within the data of another existing vector (e.g., elements 100-199 of a 8 | vector with 1M elements). 9 | -------------------------------------------------------------------------------- /src/vecwindows.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | 8 | /* 9 | ALTREP objects which provide a "window" into an existing 10 | (standard) vector without 11 | 12 | a) duplicating data 13 | b) violating Copy-On-Write 14 | */ 15 | 16 | 17 | static R_altrep_class_t window_real_class; 18 | 19 | /* windows are ALTREPS with data fields 20 | 21 | data1: VECSXP (list) length 2 22 | 1: (ExternalPtr canary (parent in Protected slot) 23 | 2: REALSXP (start, length)) 24 | data2: Expanded data SEXP (initialized to R_NilValue) 25 | 26 | 27 | If data2 (expanded SEXP) is ever not R_NilValue (R's NULL), all methods 28 | must hit that, as it means a writeable dataptr has been given out. 29 | 30 | The canary lets us ensure the reference to parent gets decremented on destruction 31 | of the altrep IF THIS STILL NEEDS TO OCCUR. 32 | 33 | If a writable dataptr is retrieved, we populate data2 (expanded SEXP), then 34 | we set the reference to parent in canary ('protected' field) to R_NilValue, 35 | THEN clear the canary external pointer. 36 | 37 | If the canary is still uncleared upon finalization, we do the cleanup then 38 | which takes care of recovering the reference count automatically. 39 | 40 | 41 | */ 42 | 43 | 44 | #define VWINDOW_PARENT(x) R_ExternalPtrProtected(VECTOR_ELT(R_altrep_data1(x), 0)) 45 | /* We always want to do this as a unit! */ 46 | #define FULL_CLEAR_EXTPTR(x) do { \ 47 | R_SetExternalPtrProtected(x, R_NilValue); \ 48 | R_ClearExternalPtr(x); \ 49 | } while(0) 50 | 51 | /* this decrements the reference count for parent and then */ 52 | /* clear's the canary */ 53 | #define VWINDOW_UNSET_PARENT(x) FULL_CLEAR_EXTPTR(VECTOR_ELT(R_altrep_data1(x), 0)) 54 | #define VWINDOW_START(x) ((R_xlen_t) REAL_ELT(VECTOR_ELT(R_altrep_data1(x), 1), 0)) 55 | #define VWINDOW_LENGTH(x) ((R_xlen_t) REAL_ELT(VECTOR_ELT(R_altrep_data1(x), 1), 1)) 56 | #define VWINDOW_EXPANDED(x) R_altrep_data2(x) 57 | #define VWINDOW_SET_EXPANDED(x, v) R_set_altrep_data2(x, v) 58 | 59 | void canary_finalizer(SEXP x) { 60 | int *canary = (int *) R_ExternalPtrAddr(x); 61 | /* check if our canary is still tweeting and hopping about */ 62 | if(canary) { 63 | FULL_CLEAR_EXTPTR(x); 64 | } 65 | } 66 | 67 | SEXP make_window_real(SEXP parent, SEXP start_len) { 68 | /* carry around a pointer to parent that we can put a finalizer on 69 | so we're not accumulating reference count that cant be 70 | decremented. 71 | */ 72 | 73 | #ifndef SWITCH_TO_REFCNT 74 | /* NAMED wouldn't be decremented so in NAMED world just mark parent 75 | not mutable for safety */ 76 | MARK_NOT_MUTABLE(parent); 77 | #endif 78 | int *canarydata = malloc(sizeof(int)); 79 | /* there was a bug in R_MakeExternalPtr which didn't increment ref counts of Prot, 80 | but setter did. Fixed already in R-devel and R-patched but initializing to 81 | R_NilValue then setting it works backwards-compatibly. */ 82 | SEXP canary = R_MakeExternalPtr(canarydata, R_NilValue, R_NilValue); 83 | R_SetExternalPtrProtected(canary, parent); 84 | R_RegisterCFinalizerEx(canary, canary_finalizer, TRUE); 85 | SEXP mdata = PROTECT(allocVector(VECSXP, 2)); 86 | SET_VECTOR_ELT(mdata, 0, canary); 87 | SET_VECTOR_ELT(mdata, 1, start_len); 88 | R_altrep_class_t cls = window_real_class; 89 | SEXP ans = R_new_altrep(cls, mdata, R_NilValue); 90 | UNPROTECT(1); /* mdata */ 91 | return ans; 92 | } 93 | 94 | 95 | static SEXP vwindow_Serialized_state(SEXP x) { 96 | /* 97 | * no serializing windows as altreps, 98 | * will be converted to std vec 99 | */ 100 | warning("Not serializing window vector as ALTREP, duplicating data"); 101 | return NULL; 102 | } 103 | 104 | 105 | 106 | Rboolean vwindow_Inspect(SEXP x, int pre, int deep, int pvec, 107 | void (*inspect_subtree)(SEXP, int, int, int)) 108 | { 109 | Rprintf(" window %s", type2char(TYPEOF(x))); 110 | if(VWINDOW_EXPANDED(x) != R_NilValue) 111 | Rprintf(" [ expanded ]\n"); 112 | else 113 | Rprintf(" [par %p strt: %ld len: %ld]\n", 114 | (void *) VWINDOW_PARENT(x), 115 | VWINDOW_START(x) + 1, /* so that it is in R indexing */ 116 | VWINDOW_LENGTH(x)); 117 | return TRUE; 118 | } 119 | 120 | 121 | 122 | static R_xlen_t vwindow_Length(SEXP x) 123 | { 124 | return VWINDOW_LENGTH(x); 125 | } 126 | 127 | static void *vwindow_Dataptr(SEXP x, Rboolean writeable) 128 | { 129 | SEXP exp = VWINDOW_EXPANDED(x); 130 | if(exp != R_NilValue) { 131 | /* 132 | * we already lost our ALTREPness, no sense in pretending 133 | * otherwise now, just operate on the expanded version 134 | */ 135 | return REAL(exp); 136 | } 137 | R_xlen_t len = VWINDOW_LENGTH(x), 138 | start = VWINDOW_START(x), 139 | ncopy; 140 | if(!writeable) { 141 | /* 142 | * no reason to expand things and get all upset about it, 143 | * for read-only case shifted pointer to parent is ok 144 | */ 145 | return REAL_RO(VWINDOW_PARENT(x)) + start; 146 | } 147 | 148 | /* 149 | * here they want a writing pointer, that means expanding 150 | * the altrep, copying the data, the whole shebang 151 | */ 152 | SEXP ans = PROTECT(allocVector(REALSXP, len)); 153 | double *buff = REAL(ans); 154 | 155 | ncopy = REAL_GET_REGION(VWINDOW_PARENT(x), start, len, buff); 156 | if(ncopy != len) 157 | error("Retrieving data pointer appears to have failed"); 158 | VWINDOW_SET_EXPANDED(x, ans); 159 | VWINDOW_UNSET_PARENT(x); 160 | UNPROTECT(1); 161 | return REAL(ans); 162 | } 163 | 164 | static const void *vwindow_Dataptr_or_null(SEXP x) 165 | { 166 | /* already expanded, so just do that */ 167 | SEXP exp = VWINDOW_EXPANDED(x); 168 | if(exp != R_NilValue) { 169 | return REAL_RO(exp); 170 | } 171 | 172 | /* no thanks I like being an ALTREP */ 173 | return NULL; 174 | } 175 | 176 | static double vwindow_real_Elt(SEXP x, R_xlen_t i) { 177 | 178 | SEXP vec; 179 | SEXP exp = VWINDOW_EXPANDED(x); 180 | if(exp != R_NilValue) { 181 | /* super bummer I'm not special anymore */ 182 | vec = exp; 183 | } else { 184 | vec = VWINDOW_PARENT(x); 185 | i = i + VWINDOW_START(x); 186 | } 187 | return REAL_ELT(vec, i); 188 | } 189 | 190 | static 191 | R_xlen_t vwindow_real_Get_region(SEXP sx, R_xlen_t i, R_xlen_t n, double *buff) { 192 | SEXP exp = VWINDOW_EXPANDED(sx); 193 | if(exp != R_NilValue) { 194 | /* I miss being a window :( */ 195 | return REAL_GET_REGION(exp, i, n, buff); 196 | } 197 | /* this could be VWINDOW_LENGTH but general XLENGTH is better */ 198 | R_xlen_t xlen = XLENGTH(sx); 199 | R_xlen_t ncopy = xlen - i > n ? n : xlen - i; 200 | R_xlen_t offset = VWINDOW_START(sx) + i; 201 | double *parentptr = REAL(VWINDOW_PARENT(sx)); 202 | for(R_xlen_t j = 0; j < ncopy; j++) 203 | buff[j] = parentptr[offset + j]; 204 | return ncopy; 205 | } 206 | 207 | static int vwindow_real_Is_sorted(SEXP x) { 208 | int ans; 209 | if(VWINDOW_EXPANDED(x) != R_NilValue) 210 | ans = UNKNOWN_SORTEDNESS; 211 | else 212 | ans = REAL_IS_SORTED(VWINDOW_PARENT(x)); 213 | 214 | return ans; 215 | } 216 | 217 | static int vwindow_real_No_NA(SEXP x) { 218 | int ans; 219 | if(VWINDOW_EXPANDED(x) != R_NilValue) { 220 | ans = 0; 221 | } else { 222 | ans = REAL_NO_NA(x); 223 | } 224 | return ans; 225 | } 226 | 227 | static void InitVWindowRealClass(DllInfo *dll) 228 | { 229 | R_altrep_class_t cls = 230 | R_make_altreal_class("vwindow_real", "vectorwindow", dll); 231 | 232 | window_real_class = cls; 233 | 234 | /* note the differences after R_set_ below */ 235 | 236 | /* ALTREP methods */ 237 | R_set_altrep_Inspect_method(cls, vwindow_Inspect); 238 | R_set_altrep_Length_method(cls, vwindow_Length); 239 | R_set_altrep_Serialized_state_method(cls, vwindow_Serialized_state); 240 | 241 | /* ALTVEC methods */ 242 | R_set_altvec_Dataptr_method(cls, vwindow_Dataptr); 243 | R_set_altvec_Dataptr_or_null_method(cls, vwindow_Dataptr_or_null); 244 | 245 | /* ALTREAL methods */ 246 | R_set_altreal_Elt_method(cls, vwindow_real_Elt); 247 | R_set_altreal_Get_region_method(cls, vwindow_real_Get_region); 248 | R_set_altreal_Is_sorted_method(cls, vwindow_real_Is_sorted); 249 | R_set_altreal_No_NA_method(cls, vwindow_real_No_NA); 250 | } 251 | 252 | /* 253 | * Shared Library Initialization and Finalization 254 | */ 255 | 256 | static const R_ExternalMethodDef ExtEntries[] = { 257 | {"make_window_real", (DL_FUNC) &make_window_real, -1}, 258 | {NULL, NULL, 0} 259 | }; 260 | 261 | void R_init_vectorwindow(DllInfo *dll) 262 | { 263 | InitVWindowRealClass(dll); 264 | 265 | R_registerRoutines(dll, NULL, NULL, NULL, ExtEntries); 266 | } 267 | 268 | 269 | 270 | --------------------------------------------------------------------------------