# The following code was lifted from Alex Couture-Beil <rjson_pkg at mofo.ca>'s
# rjson package (version 0.2.15) The C-code was removed and only native
# R code retained
toJSON <- function(x){
#convert factors to characters
if( is.factor( x ) == TRUE ) {
tmp_names <- names( x )
x = as.character( x )
names( x ) <- tmp_names
}
if( !is.vector(x) && !is.null(x) && !is.list(x) ) {
x <- as.list( x )
warning("JSON only supports vectors and lists - But I'll try anyways")
}
if( is.null(x) )
return( "null" )
#treat named vectors as lists
if( is.null( names( x ) ) == FALSE ) {
x <- as.list( x )
}
#named lists only
if( is.list(x) && !is.null(names(x)) ) {
if( any(duplicated(names(x))) )
stop( "A JSON list must have unique names" );
str = "{"
first_elem = TRUE
for( n in names(x) ) {
if( first_elem )
first_elem = FALSE
else
str = paste(str, ',', sep="")
str = paste(str, deparse(n), ":", toJSON(x[[n]]), sep="")
}
str = paste( str, "}", sep="" )
return( str )
}
#treat lists without names as JSON array
if( length(x) != 1 || is.list(x) ) {
if( !is.null(names(x)) )
return( toJSON(as.list(x)) ) #vector with names - treat as JSON list
str = "["
first_elem = TRUE
for( val in x ) {
if( first_elem )
first_elem = FALSE
else
str = paste(str, ',', sep="")
str = paste(str, toJSON(val), sep="")
}
str = paste( str, "]", sep="" )
return( str )
}
if( is.nan(x) )
return( "\"NaN\"" )
if( is.na(x) )
return( "\"NA\"" )
if( is.infinite(x) )
return( ifelse( x == Inf, "\"Inf\"", "\"-Inf\"" ) )
if( is.logical(x) )
return( ifelse(x, "true", "false") )
if( is.character(x) )
return( gsub("\\/", "\\\\/", deparse(x)) )
if( is.numeric(x) )
return( as.character(x) )
stop( "shouldnt make it here - unhandled type not caught" )
}
fromJSON <- function( json_str, file, unexpected.escape = "error" ){
if( missing( json_str ) ) {
if( missing( file ) )
stop( "either json_str or file must be supplied to fromJSON")
json_str <- paste(readLines( file, warn=FALSE ),collapse="")
} else {
if( missing( file ) == FALSE ) {
stop( "only one of json_str or file must be supplied to fromJSON")
}
}
return( .fromJSON_R( json_str ) )
}
.fromJSON_R <- function( json_str ){
if( !is.character(json_str) )
stop( "JSON objects must be a character string" )
chars = strsplit(json_str, "")[[1]]
tmp <- .parseValue( chars, 1)
if( is.null( tmp$incomplete ) )
return( tmp$val )
else
return( NULL )
}
.parseValue <- function( chars, i ){
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
ch = chars[i]
if( ch == "{" ) {
return( .parseObj( chars, i ) )
}
if( ch == "[" ) {
return( .parseArray( chars, i ) )
}
if( ch == "\"" ) {
return( .parseString( chars, i ) )
}
if( any(grep("[0-9\\-]", ch)) ) {
return( .parseNumber( chars, i ) )
}
if( ch == "t" ) {
return( .parseTrue( chars, i ) )
}
if( ch == "f" ) {
return( .parseFalse( chars, i ) )
}
if( ch == "n" ) {
return( .parseNull( chars, i ) )
}
#stop("shouldnt reach end of parseValue")
err <- paste( "unexpected data:", paste( chars[ i:length(chars)], collapse = "" ) )
stop( err )
}
.parseObj <- function( chars, i ){
obj <- list()
if( chars[i] != "{" ) stop("error - no openning tag")
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
first_pass <- TRUE
while( TRUE ) {
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
#look out for empty lists
if( chars[i] == "}" && first_pass == TRUE ) {
i = i + 1
break
}
first_pass <- FALSE
#get key
str = .parseString( chars, i )
if( is.null( str$incomplete ) == FALSE ) return( str )
key = str$val
i = str$size
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
#verify seperater
if( chars[i] != ":" ) stop("error - no seperator")
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
#get value
val = .parseValue( chars, i )
if( is.null( val$incomplete ) == FALSE ) return( val )
obj[key] <- list(val$val)
i = val$size
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
if( chars[i] == "}" ) {
i = i + 1
break
}
if( chars[i] != "," ){
stop("error - no closing tag")
}
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
return( list(val=obj, size=i) )
}
.parseArray <- function( chars, i ){
useVect <- TRUE
arr <- list()
if( chars[i] != "[" ) stop("error - no openning tag")
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
while( TRUE ) {
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
#look out for empty arrays
if( chars[i] == "]" ) {
i = i + 1
useVect <- FALSE #force an empty list instead of NULL (i.e. value = vector("list",0))
break
}
#get value
val = .parseValue( chars, i )
if( is.null( val$incomplete ) == FALSE ) return( val )
arr[length(arr)+1] <- list(val$val)
if( is.list(val$val) || length(val$val) > 1 || is.null(val$val) )
useVect <- FALSE
i = val$size
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
#ignore whitespace
while( chars[i] == " " || chars[i] == "\t" || chars[i] == "\n" ) {
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
if( chars[i] == "]" ) {
i = i + 1
break
}
if( chars[i] != "," ){
stop("error - no closing tag")
}
i = i + 1
if( i > length( chars ) )
return( list( "incomplete" = TRUE ) )
}
if( useVect )
arr <- unlist(arr)
return( list(val=arr, size=i) )
}
.parseString <- function( chars, i ){
str_start = i
if( chars[i] != "\"") stop("error")
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
while( TRUE ) {
while( chars[i] != "\\" && chars[i] != "\"" ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
if( chars[i] == "\\" ) {
i = i + 2 #skip the next char
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
else
break
}
str_end = i
i = i + 1
return(list(
val=eval(parse( text=paste(chars[str_start:str_end], collapse="") )),
size=i ))
}
.parseNumber <- function( chars, i ){
str_start = i
if( chars[i] == "-" )
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
if( chars[i] == "0" ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
if( any(grep("[1-9]", chars[i])) ) stop("JSON specs don't allow a number like \"012\"")
} else if( any(grep("[1-9]", chars[i])) ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
while( any(grep("[0-9]", chars[i])) ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
} else {
stop( "doesn't look like a valid JSON number" )
}
if( chars[i] == "." ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
while( any(grep("[0-9]", chars[i])) ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
}
if( chars[i] == "e" || chars[i] == "E" ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
if( chars[i] == "-" || chars[i] == "+" )
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
while( any(grep("[0-9]", chars[i])) ) {
i = i + 1
if( i > length( chars ) ) return( list( "incomplete" = TRUE ) )
}
}
str_end = i-1
return(list(
val=eval(parse( text=paste(chars[str_start:str_end], collapse="") )),
size=i ))
}
.parseTrue <- function( chars, i ){
if( paste(chars[i:(i+3)], collapse="") == "true" )
return( list(val=TRUE,size=i+4) )
stop("error parsing true value (maybe the word starts with t but isnt true)")
}
.parseFalse <- function( chars, i ){
if( paste(chars[i:(i+4)], collapse="") == "false" )
return( list(val=FALSE,size=i+5) )
stop("error parsing false value (maybe the word starts with f but isnt false)")
}
.parseNull <- function( chars, i ){
if( paste(chars[i:(i+3)], collapse="") == "null" )
return( list(val=NULL,size=i+4) )
stop("error parsing null value (maybe the word starts with n but isnt null)")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.