Nothing
##
# Copyright (c) 2018 LabKey Corporation
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
##
labkey.experiment.SAMPLE_DERIVATION_PROTOCOL <- "Sample Derivation Protocol"
## Create an ExpData object
##
labkey.experiment.createData <- function(config, dataClassId = NULL, dataClassName = NULL, dataFileUrl = NULL)
{
## check required parameters
if (missing(config))
stop (paste("A list of ExpObject config params must be specified in the config parameter."))
data <- config
if (!is.null(dataFileUrl))
data$dataFileURL = dataFileUrl
if (!is.null(dataClassId) || !is.null(dataClassName))
{
dataClass <- list()
if (!is.null(dataClassId))
dataClass$id = dataClassId
if (!is.null(dataClassName))
dataClass$name = dataClassName
data$dataClass = dataClass
}
return (data)
}
## Create an ExpMaterial object
##
labkey.experiment.createMaterial <- function(config, sampleSetId = NULL, sampleSetName = NULL)
{
## check required parameters
if (missing(config))
stop (paste("A list of ExpObject config params must be specified in the config parameter."))
material <- config
if (!is.null(sampleSetId) || !is.null(sampleSetName))
{
sampleSet <- list()
if (!is.null(sampleSetId))
sampleSet$id = sampleSetId
if (!is.null(sampleSetName))
sampleSet$name = sampleSetName
material$sampleSet = sampleSet
}
return (material)
}
## Create an ExpRun object
##
labkey.experiment.createRun <- function(config, dataInputs = NULL, dataOutputs = NULL, dataRows = NULL, materialInputs = NULL, materialOutputs = NULL)
{
## check required parameters
if (missing(config))
stop (paste("A list of ExpObject config params must be specified in the config parameter."))
run <- config
if (!is.null(dataInputs))
{
if (!is.list(dataInputs))
stop (paste("dataInputs must be a list of data objects, see labkey.experiment.createData."))
## ensure dataInputs is serialized as an array of objects
run$dataInputs = ensureNestedList(dataInputs)
}
if (!is.null(dataOutputs))
{
if (!is.list(dataOutputs))
stop (paste("dataOutputs must be a list of data objects, see labkey.experiment.createData."))
run$dataOutputs = ensureNestedList(dataOutputs)
}
if (!is.null(materialInputs))
{
if (!is.list(materialInputs))
stop (paste("materialInputs must be a list of material objects, see labkey.experiment.createMaterial."))
run$materialInputs = ensureNestedList(materialInputs)
}
if (!is.null(materialOutputs))
{
if (!is.list(materialOutputs))
stop (paste("materialOutputs must be a list of material objects, see labkey.experiment.createMaterial."))
run$materialOutputs = ensureNestedList(materialOutputs)
}
if (!is.null(dataRows))
{
if (!is.data.frame(dataRows))
stop (paste("dataRows must be a data frame."))
## build Assay object tree based on R lists
nrows <- nrow(dataRows)
ncols <- ncol(dataRows)
cnames <- colnames(dataRows)
rowsVector <- vector(mode="list", length=nrows)
for (j in 1:nrows)
{
cvalues <- as.list(dataRows[j,])
names(cvalues) <- cnames
rowsVector[[j]] <- cvalues
}
run$dataRows <- rowsVector
}
return (run)
}
## Helper to ensure the passed object is serialized to JSON as an array of objects
##
ensureNestedList <- function(data)
{
if (is.null(names(data)))
data
else
data <- list(data)
return (data)
}
labkey.experiment.saveBatch <- function(baseUrl=NULL, folderPath, assayConfig = NULL, protocolName = NULL, batchPropertyList = NULL, runList)
{
baseUrl=labkey.getBaseUrl(baseUrl)
## Validate required parameters
if (missing(folderPath)) stop (paste("A value must be specified for folderPath."))
if (missing(runList)) stop (paste("A value must be specified for runList."))
if (is.null(assayConfig) && is.null(protocolName))
stop (paste("Either an assay config list or protocolName must be specified. The assay configuration must contain either an assayId or both assayName and providerName"))
## normalize the folder path
folderPath <- encodeFolderPath(folderPath)
## Now post form with batch object filled out
url <- paste(baseUrl, "assay", folderPath, "saveAssayBatch.api", sep="")
if (!is.null(assayConfig))
params = assayConfig
else if (!is.null(protocolName))
{
params = list()
params$protocolName = protocolName
}
params$batch = c(batchPropertyList, list(runs = ensureNestedList(runList)))
response <- labkey.post(url, toJSON(params, auto_unbox=TRUE))
return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE))
}
labkey.experiment.saveRuns <- function(baseUrl=NULL, folderPath, protocolName, runList)
{
baseUrl=labkey.getBaseUrl(baseUrl)
## Validate required parameters
if (missing(folderPath)) stop (paste("A value must be specified for folderPath."))
if (missing(protocolName)) stop (paste("A value must be specified for protocolName."))
if (missing(runList)) stop (paste("A value must be specified for runList."))
## normalize the folder path
folderPath <- encodeFolderPath(folderPath)
## Now post form with runs object filled out
url <- paste(baseUrl, "assay", folderPath, "saveAssayRuns.api", sep="")
if (!is.null(runList))
{
params = list()
params$protocolName = protocolName
}
params$runs = ensureNestedList(runList)
response <- labkey.post(url, toJSON(params, auto_unbox=TRUE))
return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE))
}
## Get lineage parent/child relationships and information for exp objects by LSID(s)
##
## Optional parameters (passed via options) include:
## parents: (boolean) include parent objects in the lineage
## children: (boolean) include child objects in the lineage
## depth: (integer) the depth of the lineage to retrieve
## expType: the type of experiment objects to retrieve lineage for
## cpasType: the type of CPAS object to retrieve lineage for
## runProtocolLsid: the LSID of the run protocol to retrieve lineage for
## includeProperties: (boolean) include properties in the lineage response
## includeInputsAndOutputs: (boolean) include inputs and outputs in the lineage response
## includeRunSteps: (boolean) include run steps in the lineage response
##
labkey.experiment.lineage <- function(baseUrl=NULL, folderPath, lsids, options = NULL)
{
baseUrl=labkey.getBaseUrl(baseUrl)
## check required parameters
if (missing(folderPath))
stop (paste("A value must be specified for folderPath."))
if (missing(lsids))
stop (paste("A value must be specified for lsids."))
if (!missing(lsids) & !(is.vector(lsids) && is.atomic(lsids)))
stop (paste("The lsids parameter must be a vector data structure."))
if (!missing(options) & !is.list(options))
stop (paste("The options parameter must be a list data structure."))
params <- list(lsids=lsids)
if (!missing(options))
params <- c(params, options)
## normalize the folder path
folderPath <- encodeFolderPath(folderPath)
url <- paste(baseUrl, "experiment", folderPath, "lineage.api", sep="")
response <- labkey.post(url, toJSON(params, auto_unbox=TRUE))
return (fromJSON(response, simplifyVector=FALSE, simplifyDataFrame=FALSE))
}
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.