Nothing
#' gdal_cmd_builder
#'
#' Helper function for building GDAL commands.
#'
#' @param executable Character. The GDAL command to use (e.g. "gdal_translate")
#' @param parameter_variables List. A list of parameter names, organized by type.
#' @param parameter_values List. A list of the parameters names/values.
#' @param parameter_order Character. The order of the parameters for the GDAL command.
#' @param parameter_noflags Character. Parameters which do not have a flag.
#' @param parameter_doubledash Character. Parameters which should have a double dash "--".
#' @param parameter_noquotes Character. Parameters which should not be wrapped in quotes (vector parameters only, at present).
#' @param gdal_installation_id Numeric. The ID of the GDAL installation to use. Defaults to 1.
#' @param python_util Logical. Is the utility a python utility? Default = FALSE.
#' @param verbose Logical. Enable verbose execution? Default is FALSE.
#' @return Formatted GDAL command for use with system() calls.
#' @author Jonathan A. Greenberg (\email{gdalUtils@@estarcion.net})
#'
#' @details This function takes the executable name (e.g. "gdal_translate"),
#' a list of parameter names organized by logical, vector,
#' scalar, character, repeatable, a list of values of these parameters,
#' the order they should be used in the GDAL command, and a list of
#' parameters that should not have a flag, and returns a properly
#' formatted GDAL command (with the full path-to-executable) that
#' should work with a system() call.
#'
#' Sometimes, a user may not want to use the most recent GDAL install
#' (gdal_installation_id=1), so the gdal_installation_id can be used
#' to set a different install. This is often used with gdal_chooseInstallation
#' if, for instance, the particular GDAL installation required needs
#' a specific driver that may not be available in all installations.
#'
#' In general, an end user shouldn't need to use this function -- it
#' is used by many of the GDAL wrappers within gdalUtils.
#'
#' @references \url{http://www.gdal.org/gdal_translate.html}
#' @examples \dontrun{
#' # This builds a gdal_translate command.
#' executable <- "gdal_translate"
#'
#' parameter_variables <- list(
#' logical = list(
#' varnames <- c("strict","unscale","epo",
#' "eco","q","sds","stats")),
#' vector = list(
#' varnames <- c("outsize","scale","srcwin",
#' "projwin","a_ullr","gcp")),
#' scalar = list(
#' varnames <- c("a_nodata")),
#' character = list(
#' varnames <- c("ot","of","mask","expand","a_srs",
#' "src_dataset","dst_dataset")),
#' repeatable = list(
#' varnames <- c("b","mo","co")))
#'
#' parameter_order <- c(
#' "strict","unscale","epo","eco","q","sds","stats",
#' "outsize","scale","srcwin","projwin","a_ullr","gcp",
#' "a_nodata",
#' "ot","of","mask","expand","a_srs",
#' "b","mo","co",
#' "src_dataset","dst_dataset")
#'
#' parameter_noflags <- c("src_dataset","dst_dataset")
#'
#' # Now assign some parameters:
#' parameter_values = list(
#' src_dataset = "input.tif",
#' dst_dataset = "output.envi",
#' of = "ENVI",
#' strict = TRUE
#' )
#'
#' cmd <- gdal_cmd_builder(
#' executable=executable,
#' parameter_variables=parameter_variables,
#' parameter_values=parameter_values,
#' parameter_order=parameter_order,
#' parameter_noflags=parameter_noflags)
#'
#' cmd
#' system(cmd,intern=TRUE)
#' }
#' @export
#TODO: additional commands
#TODO: work without parameters (executable only)
#TODO: command aliases (e.g. for commands with a hyphen,
# since R doesn't allow that in variable naming).
gdal_cmd_builder <- function(executable,parameter_variables=c(),
parameter_values=c(),parameter_order=c(),parameter_noflags=c(),
parameter_doubledash=c(),
parameter_noquotes=c(),
gdal_installation_id=1,
python_util=FALSE,
verbose=FALSE)
{
if(verbose) message("Checking installation...")
# path to executable check in here?
gdal_setInstallation()
if(is.null(getOption("gdalUtils_gdalPath"))) return()
executable <- normalizePath(list.files(
getOption("gdalUtils_gdalPath")[[gdal_installation_id]]$path,
executable,full.names=TRUE))
if(!file.exists(executable) && !file.exists(paste0(executable,".exe")))
{
stop(paste0(executable," does not exist on your system. Please check your installation."))
}
parameter_variables_types <- names(parameter_variables)
# print(sapply(parameter_values,function(X) class(X)))
defined_variables <- names(parameter_values)[sapply(parameter_values,function(X) class(X)[1] != "name")]
if(verbose) message("Setting up logical variables...")
if(any("logical" %in% parameter_variables_types))
{
parameter_variables_logical <- parameter_variables$logical[[1]]
parameter_variables_logical_defined <- defined_variables[defined_variables %in% parameter_variables_logical]
# Only set the flag if TRUE
# browser()
if(length(parameter_variables_logical_defined)>0)
{
# browser()
parameter_variables_logical_defined_true <- sapply(parameter_variables_logical_defined,
function(X,parameter_values)
{
return(parameter_values[[which(names(parameter_values)==X)]])
},parameter_values=parameter_values)
# parameter_variables_logical_defined_true <- parameter_variables_logical_defined_true[parameter_variables_logical_defined_true==T]
# browser()
parameter_variables_logical_strings <- sapply(parameter_variables_logical_defined,
function(X,parameter_doubledash)
{
if(X %in% parameter_noflags)
{
flag=NULL
} else
{
if(X %in% parameter_doubledash)
{
flag=paste("--",X," ",sep="")
} else
{
flag=paste("-",X," ",sep="")
}
}
return(flag)
},parameter_doubledash=parameter_doubledash)
names(parameter_variables_logical_strings) <- names(parameter_variables_logical_defined_true)
# Get rid of ones you don't need:
parameter_variables_logical_strings <- parameter_variables_logical_strings[parameter_variables_logical_defined_true==T]
} else
{
parameter_variables_logical_strings <- NULL
}
}
if(verbose) message("Setting up vector variables...")
if(any("vector" %in% parameter_variables_types))
{
parameter_variables_vector <- parameter_variables$vector[[1]]
parameter_variables_vector_defined <- defined_variables[defined_variables %in% parameter_variables_vector]
if(length(parameter_variables_vector_defined)>0)
{
parameter_variables_vector_strings <- sapply(parameter_variables_vector_defined,
function(X,parameter_values,parameter_doubledash)
{
if(X %in% parameter_noflags)
{
flag=NULL
} else
{
if(X %in% parameter_doubledash)
{
flag=paste("--",X," ",sep="")
} else
{
flag=paste("-",X," ",sep="")
}
}
if(X %in% parameter_noquotes)
{
parameter_variables_vector_string <- paste(flag,
paste(parameter_values[[which(names(parameter_values)==X)]],collapse=" "),
sep="")
} else
{
parameter_variables_vector_string <- paste(flag,
qm(paste(parameter_values[[which(names(parameter_values)==X)]],collapse=" ")),
sep="")
}
return(parameter_variables_vector_string)
},parameter_values=parameter_values,parameter_doubledash=parameter_doubledash)
} else
{
parameter_variables_vector_strings <- NULL
}
} else
{
parameter_variables_vector_strings <- NULL
}
if(verbose) message("Setting up scalar variables...")
if(any("scalar" %in% parameter_variables_types))
{
parameter_variables_scalar <- parameter_variables$scalar[[1]]
parameter_variables_scalar_defined <- defined_variables[defined_variables %in% parameter_variables_scalar]
if(length(parameter_variables_scalar_defined)>0)
{
parameter_variables_scalar_strings <- sapply(parameter_variables_scalar_defined,
function(X,parameter_values,parameter_doubledash)
{
if(X %in% parameter_noflags)
{
flag=NULL
} else
{
if(X %in% parameter_doubledash)
{
flag=paste("--",X," ",sep="")
} else
{
flag=paste("-",X," ",sep="")
}
}
parameter_variables_scalar_string <- paste(flag,
qm(parameter_values[[which(names(parameter_values)==X)]]),
sep="")
return(parameter_variables_scalar_string)
},parameter_values=parameter_values,parameter_doubledash=parameter_doubledash)
} else
{
parameter_variables_scalar_strings <- NULL
}
} else
{
parameter_variables_scalar_strings <- NULL
}
if(verbose) message("Setting up character variables...")
if(any("character" %in% parameter_variables_types))
{
# Do we need to embed quotes in the command?
parameter_variables_character <- parameter_variables$character[[1]]
parameter_variables_character_defined <- defined_variables[defined_variables %in% parameter_variables_character]
if(length(parameter_variables_character_defined)>0)
{
parameter_variables_character_strings <- sapply(parameter_variables_character_defined,
function(X,parameter_values,parameter_noflags,parameter_doubledash)
{
if(X %in% parameter_noflags)
{
flag=NULL
} else
{
if(X %in% parameter_doubledash)
{
flag=paste("--",X," ",sep="")
} else
{
flag=paste("-",X," ",sep="")
}
}
parameter_variables_character_string <- paste(flag,
qm(parameter_values[[which(names(parameter_values)==X)]]),
sep="")
return(parameter_variables_character_string)
},parameter_values=parameter_values,parameter_noflags=parameter_noflags,parameter_doubledash=parameter_doubledash)
} else
{
parameter_variables_character_strings <- NULL
}
} else
{
parameter_variables_character_strings <- NULL
}
if(verbose) message("Setting up repeatable variables...")
if(any("repeatable" %in% parameter_variables_types))
{
parameter_variables_repeatable <- parameter_variables$repeatable[[1]]
parameter_variables_repeatable_defined <- defined_variables[defined_variables %in% parameter_variables_repeatable]
if(length(parameter_variables_repeatable_defined)>0)
{
parameter_variables_repeatable_strings <- sapply(parameter_variables_repeatable_defined,
function(X,parameter_values,parameter_doubledash)
{
# if(X == "gcp") browser()
if(X %in% parameter_noflags)
{
flag=NULL
} else
{
if(X %in% parameter_doubledash)
{
flag=paste("--",X," ",sep="")
} else
{
flag=paste("-",X," ",sep="")
}
}
if(X %in% parameter_noquotes)
{
parameter_variables_repeatable_string <- paste(
paste(flag,
(parameter_values[[which(names(parameter_values)==X)]]),
sep=""),
collapse=" ")
} else
{
parameter_variables_repeatable_string <- paste(
paste(flag,
qm(parameter_values[[which(names(parameter_values)==X)]]),
sep=""),
collapse=" ")
}
return(parameter_variables_repeatable_string)
},parameter_values=parameter_values,parameter_doubledash=parameter_doubledash)
} else
{
parameter_variables_repeatable_strings <- NULL
}
} else
{
parameter_variables_repeatable_strings <- NULL
}
if(verbose) message("Setting up noflag variables...")
if(!is.null(parameter_noflags))
{
# parameter_variables_noflag <- parameter_variables$noflag[[1]]
# parameter_variables_noflag_defined <- defined_variables[defined_variables %in% parameter_variables_noflag]
# if(length(parameter_variables_noflag_defined)>0)
# {
parameter_variables_noflag_strings <- sapply(parameter_noflags,
function(X,parameter_values)
{
parameter_variables_noflag_string <- paste(
parameter_values[[which(names(parameter_values)==X)]],
sep="")
return(parameter_variables_noflag_string)
},parameter_values=parameter_values)
# } else
# {
# parameter_variables_noflag_strings <- NULL
# }
} else
{
parameter_variables_noflag_strings <- NULL
}
if(verbose) message("Putting them all together...")
parameter_vector <- c(
parameter_variables_logical_strings,
parameter_variables_vector_strings,
parameter_variables_scalar_strings,
parameter_variables_character_strings,
parameter_variables_repeatable_strings,
parameter_variables_noflag_strings
)
# Reorder the parameters if neccessary
if(!missing(parameter_order))
{
parameter_order_defined <- parameter_order[which(parameter_order %in% names(parameter_vector))]
parameter_vector <- parameter_vector[parameter_order_defined]
}
# Collapse multiple parameter entries:
parameter_vector <- sapply(parameter_vector,function(x) paste(x,collapse=" "))
cmd <- paste(c(qm(executable),parameter_vector),collapse=" ")
# if(python_util)
# {
# py_check <- py_available(initialize=T)
# if(!py_check) stop("Python not available, please fix.")
# cmd <- paste(py_config()$python,cmd)
# }
return(cmd)
}
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.