Nothing
# Arguments:
# x - an R object. If a list, it will be searched for non-list elements
# FUN - an optional function to perform on the non-list elements of x
# fargs - additional arguments to FUN (removed until I can get it to work)
# max - whether to search for minimal or maximal values of FUN (or elements of x)
# retval - a list of three components (see below)
# Return value:
# The final value of the list retval
# indx - a vector of the list indices of the element of x with the extreme value
# element - the element of x with the extreme value
# value - the extreme value of the first element of x or of FUN applied to x
# listCrawler descends an R list until it encounters a non-list element.
# it then returns either the first value of that element, or if FUN is not NULL,
# the result of applying FUN to the element plus the element itself
listCrawler<-function(x,FUN=NULL,maxval=TRUE,
retval=list(indx=vector("numeric",0),element=NULL,value=NA)) {
if(is.list(x)) {
thisindx<-retindx<-1
for(lindex in 1:length(x)) {
# recursively run through the elements of this list
newretval<-listCrawler(x[[lindex]],FUN=FUN,maxval=maxval,retval=retval)
# grab the first element and value in case the latter is the extreme
if(is.na(retval$value[1])) {
retval$element<-newretval$element
retval$value<-newretval$value
}
# maxval signals whether to look for a max or min in the first element of
# the value returned as it might be a vector
selectcond<-
ifelse(maxval,newretval$value[1]>retval$value[1],newretval$value[1]<retval$value[1])
if(selectcond) {
# insert the new extreme value and element and
# grab the current index and lower ones
retval$value<-newretval$value
retval$element<-newretval$element
retindx<-newretval$indx
thisindx<-lindex
}
}
# now concatenate the current index for the extremum and lower ones
retval$indx<-c(thisindx,retindx)
return(retval)
}
else {
if(is.null(FUN)) {
# just use the first element of x as value and x as element
retval$value<-x[1]
retval$element<-x
}
else {
# if there is something to do, do it
retval$value<-do.call(FUN,list(x))
retval$element<-x
}
}
return(retval)
}
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.