Nothing
# Copyright (c) 2014, Stephen B. Weston
#
# This is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
# USA
ireadDouble <- function(con, buflen=16*1024, where=0) {
opened <- if (is.character(con)) {
con <- file(con, open='rb')
TRUE
} else {
if (! isOpen(con, 'r') || summary(con)$test != 'binary') {
stop('con must be opened for reading in binary mode')
}
FALSE
}
if (where > 0) {
if (! isSeekable(con)) {
stop('where cannot be specified unless con is seekable')
}
seek(con, where=where, origin='start')
}
ibuf <- 0
buffer <- NULL
it <- ireadBin(con, what='double', n=buflen)
isstopped <- FALSE
nextEl <- function() {
# Check if we've already stopped
if (isstopped)
stop('StopIteration', call.=FALSE)
if (ibuf >= length(buffer)) {
# Refill our buffer
ibuf <<- 0
tryCatch({
buffer <<- nextElem(it)
},
error=function(e) {
# Clean up regardless of the error
buffer <<- NULL
it <<- NULL
isstopped <<- TRUE
if (opened)
close(con)
stop(e) # rethrow the error
})
}
ibuf <<- ibuf + 1
buffer[ibuf]
}
object <- list(nextElem=nextEl)
class(object) <- c('abstractiter', 'iter')
object
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.