#' @import R6
NULL
#' Create a new experiment
#'
#' Create a new experiment on Comet's servers. The return value is an [`Experiment`]
#' object that can be used to modify or get information about the experiment. Only one
#' experiment can be active at a time, so make sure to stop an experiment before creating
#' a new one (by calling the `stop()` method on the [`Experiment`] object).
#' @param experiment_name Experiment name.
#' @param project_name Project name (can also be specified using the `COMET_PROJECT_NAME`
#' parameter as an environment variable or in a comet config file).
#' @param workspace_name Workspace name (can also be specified using the `COMET_WORKSPACE`
#' parameter as an environment variable or in a comet config file).
#' @param api_key Comet API key (can also be specified using the `COMET_API_KEY`
#' parameter as an environment variable or in a comet config file).
#' @param keep_active If `TRUE`, automatically send Comet a status update every
#' few seconds until the experiment is stopped to mark the experiment as active on the
#' Comet web dashboard.
#' @param log_output If `TRUE`, all standard output will automatically be sent to
#' the Comet servers to display as message logs for the experiment. The output will still
#' be shown in the console as well.
#' @param log_error If `TRUE`, all output from 'stderr' (which includes errors,
#' warnings, and messages) will be redirected to the Comet servers to display as message
#' logs for the experiment. Note that unlike `auto_log_output`, if this option is on then
#' these messages will not be shown in the console and instead they will only be logged
#' to the Comet experiment. This option is set to `FALSE` by default because of this
#' behavior.
#' @param log_code If `TRUE`, log the source code of the R script that was called
#' to Comet as the associated code of this experiment. This only works if the you run
#' a script using the `Rscript` tool and will not work in interactive sessions.
#' @param log_system_details If `TRUE`, automatically log the system details to
#' Comet when the experiment is created.
#' @param log_git_info If `TRUE`, log information about the active git repository.
#' Requires the `git2r` package to be installed.
#' @return An [`Experiment`] object.
#'
#' @examples
#' \dontrun{
#' library(cometr)
#' # Assuming you have COMET_API_KEY, COMET_WORKSPACE, COMET_PROJECT_NAME variables defined
#' exp <- create_experiment()
#' exp$get_key()
#' exp$get_metadata()
#' exp$add_tags(c("test", "tag2"))
#' exp$get_tags()
#' exp$log_metric("metric1", 5)
#' exp$get_metric("metric1")
#' exp$get_metrics_summary()
#' exp$stop()
#' }
#'
#' @export
create_experiment <- function(
experiment_name = NULL, project_name = NULL, workspace_name = NULL, api_key = NULL,
keep_active = TRUE, log_output = TRUE, log_error = FALSE,
log_code = TRUE, log_system_details = TRUE, log_git_info = FALSE
) {
base_experiment(
experiment_name = experiment_name, project_name = project_name,
workspace_name = workspace_name, api_key = api_key,
keep_active = keep_active, log_output = log_output, log_error = log_error,
log_code = log_code, log_system_details = log_system_details, log_git_info = log_git_info)
}
#' @title Get a previously created experiment
#' @description
#' Get a previously created experiment on Comet's servers. The return value is an [`Experiment`]
#' object that can be used to modify or get information about the experiment.
#' @param experiment_key Experiment key.
#' @param api_key Comet API key (can also be specified using the `COMET_API_KEY`
#' parameter as an environment variable or in a comet config file).
#' @param keep_active if `TRUE` keeps a communication channel open with comet.ml
#' @param log_output If `TRUE`, all standard output will automatically be sent to
#' the Comet servers to display as message logs for the experiment. The output will still
#' be shown in the console as well.
#' @param log_error If `TRUE`, all output from 'stderr' (which includes errors,
#' warnings, and messages) will be redirected to the Comet servers to display as message
#' logs for the experiment. Note that unlike `auto_log_output`, if this option is on then
#' these messages will not be shown in the console and instead they will only be logged
#' to the Comet experiment. This option is set to `FALSE` by default because of this
#' behavior.
#' @param log_code If `TRUE`, log the source code of the R script that was called
#' to Comet as the associated code of this experiment. This only works if the you run
#' a script using the `Rscript` tool and will not work in interactive sessions.
#' @param log_system_details If `TRUE`, automatically log the system details to
#' Comet when the experiment is created.
#' @param log_git_info If `TRUE`, log information about the active git repository.
#' Requires the `git2r` package to be installed.
#' @return An [`Experiment`] object.
#'
#' @examples
#' \dontrun{
#' library(cometr)
#' # Assuming you have COMET_API_KEY, COMET_WORKSPACE, COMET_PROJECT_NAME variables defined
#' exp <- get_experiment("SOME-EXPERIMENT-KEY")
#' exp$get_key()
#' exp$get_metadata()
#' exp$add_tags(c("test", "tag2"))
#' exp$get_tags()
#' exp$log_metric("metric1", 5)
#' exp$get_metric("metric1")
#' exp$get_metrics_summary()
#' exp$stop()
#' }
#'
#' @export
get_experiment <- function(
experiment_key, api_key = NULL, keep_active = FALSE, log_output = FALSE, log_error = FALSE,
log_code = FALSE, log_system_details = FALSE, log_git_info = FALSE
) {
base_experiment(api_key = api_key, keep_active = keep_active, log_output = log_output,
log_error = log_error, log_code = log_code, log_system_details = log_system_details,
log_git_info = log_git_info, experiment_key = experiment_key)
}
base_experiment <- function(
experiment_name = NULL, project_name = NULL, workspace_name = NULL, api_key = NULL,
keep_active = TRUE, log_output = TRUE, log_error = FALSE,
log_code = TRUE, log_system_details = TRUE, log_git_info = FALSE,
experiment_key = NULL
) {
if (!isBool(keep_active)) {
comet_stop("keep_active must be either TRUE or FALSE.")
}
if (!isBool(log_output)) {
comet_stop("log_output must be either TRUE or FALSE.")
}
if (!isBool(log_error)) {
comet_stop("log_error must be either TRUE or FALSE.")
}
if (!isBool(log_code)) {
comet_stop("log_code must be either TRUE or FALSE.")
}
if (!isBool(log_system_details)) {
comet_stop("log_system_details must be either TRUE or FALSE.")
}
if (!isBool(log_git_info)) {
comet_stop("log_git_info must be either TRUE or FALSE.")
}
if (log_git_info && (!requireNamespace("git2r", quietly = TRUE) || utils::packageVersion("git2r") < "0.22.1")) {
comet_stop("log_git_info requires you to have `git2r` version 0.22.1 or later.")
}
if (!is.null(experiment_key) &&
(!is.null(workspace_name) || !is.null(project_name) || !is.null(experiment_name))) {
comet_stop("If experiment_key is given, then workspace_name, project_name, and experiment_name must not be given.")
}
if (is.null(experiment_key)) {
dynamic <- TRUE
if (!is.null(.cometrenv$curexp)) {
LOG_INFO("Existing experiment ", .cometrenv$curexp$get_key(), " will be stopped ",
"because a new experiment is being created.", echo = TRUE)
.cometrenv$curexp$stop()
}
resp <- new_experiment(
experiment_name = experiment_name,
project_name = project_name,
workspace_name = workspace_name,
api_key = api_key
)
experiment_key <- resp[["experimentKey"]]
experiment_link <- resp[["link"]]
if (is.null(experiment_key) || is.null(experiment_link)) {
comet_stop("Create experiment in Comet failed.")
}
workspace_name <- resp[["workspaceName"]]
project_name <- resp[["projectName"]]
LOG_INFO("Experiment created: ", experiment_link, echo = TRUE)
} else {
dynamic <- FALSE
resp <- get_metadata(experiment_key)
project_name <- resp[["projectName"]]
workspace_name <- resp[["workspaceName"]]
experiment_name <- resp[["experimentName"]]
archived <- resp[["archived"]]
experiment_link = create_experiment_link(base_url = modify_config_url(get_config_url()),
workspace_name = workspace_name,
project_name = project_name,
experiment_key = experiment_key,
archived = resp[["archived"]])
LOG_INFO("Experiment retrieved: ", experiment_link, echo = TRUE)
}
if (log_code) {
source_file <- get_system_script()
if (!is.null(source_file) && file.exists(source_file)) {
LOG_DEBUG("Logging source code to the newly created experiment from script ", source_file)
try({
source_code <- paste(readLines(source_file, warn = FALSE), collapse = "\n")
log_code(experiment_key = experiment_key, code = source_code, api_key = api_key)
}, silent = TRUE)
}
}
if (log_system_details) {
LOG_DEBUG("Logging system details to the newly created experiment")
try({
system_details <- get_all_system_details()
log_system_details(experiment_key = experiment_key, details = system_details, api_key = api_key)
}, silent = TRUE)
}
if (log_git_info) {
LOG_DEBUG("Logging git information")
git_details <- get_git_metadata_details()
if (length(git_details) > 0) {
try({
LOG_DEBUG(git_details)
log_git_metadata(experiment_key = experiment_key, details = git_details, api_key = api_key)
patchfile <- get_git_patch_file()
if (!is.null(patchfile) && file.exists(patchfile)) {
log_git_patch(experiment_key = experiment_key, file = patchfile, api_key = api_key)
}
}, silent = TRUE)
}
}
.cometrenv$cancreate <- TRUE
experiment <- Experiment$new(
experiment_key = experiment_key,
experiment_url = experiment_link,
api_key = api_key,
keep_active = keep_active,
log_output = log_output,
log_error = log_error,
dynamic = dynamic,
workspace_name = workspace_name,
project_name = project_name
)
invisible(experiment)
}
#' @title A Comet Experiment object
#' @description
#' A comet experiment object can be used to modify or get information about an active
#' experiment. All methods documented here are the different ways to interact with an
#' experiment. Use [`create_experiment()`] to create or [`get_experiment()`] to
#' retrieve a Comet experiment object.
#'
#' @examples
#' \dontrun{
#' library(cometr)
#' # Assuming you have COMET_API_KEY, COMET_WORKSPACE, COMET_PROJECT_NAME variables define
#' exp <- create_experiment()
#' exp$get_key()
#' exp$get_metadata()
#' exp$add_tags(c("test", "tag2"))
#' exp$get_tags()
#' exp$log_metric("metric1", 5)
#' exp$get_metric("metric1")
#' exp$get_metrics_summary()
#' exp$stop()
#' }
#'
#' @export
Experiment <- R6::R6Class(
cloneable = FALSE,
"Experiment",
public = list(
#' @description
#' Do not call this function directly. Use `create_experiment()` or `get_experiment()` instead.
#'
#' @param experiment_key The key of the `Experiment`.
#' @param experiment_url The URL of the `Experiment`.
#' @param api_key Comet API key (can also be specified using the `COMET_API_KEY`
#' parameter as an environment variable or in a comet config file).
#' @param keep_active If `TRUE`, automatically send Comet a status update every
#' few seconds until the experiment is stopped to mark the experiment as active on the
#' Comet web dashboard.
#' @param log_output If `TRUE`, all standard output will automatically be sent to
#' the Comet servers to display as message logs for the experiment. The output will still
#' be shown in the console as well.
#' @param log_error If `TRUE`, all output from 'stderr' (which includes errors,
#' warnings, and messages) will be redirected to the Comet servers to display as message
#' logs for the experiment. Note that unlike `auto_log_output`, if this option is on then
#' these messages will not be shown in the console and instead they will only be logged
#' to the Comet experiment. This option is set to `FALSE` by default because of this
#' behavior.
#' @param dynamic If `TRUE` the Experiment was created rather than retrieved.
#' @param workspace_name The workspace name (can also be specified using the `COMET_WORKSPACE`
#' parameter as an environment variable or in a comet config file).
#' @param project_name The project name (can also be specified using the `COMET_PROJECT_NAME`
#' parameter as an environment variable or in a comet config file).
initialize = function(experiment_key, experiment_url = NULL, api_key = NULL,
keep_active = FALSE, log_output = FALSE, log_error = FALSE,
dynamic = TRUE, workspace_name = NULL, project_name = NULL) {
if (!isTRUE(.cometrenv$cancreate)) {
comet_stop("Do not call this function directly. Use `create_experiment()` instead.")
}
.cometrenv$cancreate <- FALSE
if (isTRUE(dynamic)) {
LOG_DEBUG("Creating experiment ", experiment_key)
.cometrenv$curexp <- self
} else {
LOG_DEBUG("Retrieving experiment ", experiment_key)
}
api_key <- api_key %||% get_config_api_key(must_work = TRUE)
private$dynamic <- dynamic
private$experiment_key <- experiment_key
private$experiment_url <- experiment_url
private$api_key <- api_key
private$log_error <- log_error
private$log_output <- log_output
private$workspace_name <- workspace_name
private$project_name <- project_name
if (keep_active) {
private$keepalive_process <- create_keepalive_process(exp_key = experiment_key, api_key = api_key)
LOG_DEBUG("Created process ", private$keepalive_process$get_pid(), " to send keepalive signal.")
}
if (log_output || log_error) {
private$logfile_path <- tempfile()
private$logfile <- file(private$logfile_path, open = "w")
private$log_offset_path <- paste0(private$logfile_path, ".offset")
if (log_error) {
suppressWarnings(
sink(private$logfile, type = "message")
)
}
if (log_output) {
suppressWarnings(
sink(private$logfile, type = "output", split = TRUE)
)
}
private$logging_process <- create_logging_process(
experiment_key = experiment_key, logfile_path = private$logfile_path,
log_offset_path = private$log_offset_path, api_key = api_key
)
LOG_DEBUG("Created process ", private$logging_process$get_pid(), " to send output logs.")
}
if (isTRUE(dynamic)) {
experiment_log_metadata(self)
}
},
#' @description
#' Get the experiment key of an experiment.
get_key = function() {
private$experiment_key
},
#' @description
#' Get the workspace name of an experiment.
get_workspace_name = function() {
private$workspace_name
},
#' @description
#' Get the project name of an experiment.
get_project_name = function() {
private$project_name
},
#' @description
#' Get the dynamic status of an experiment.
get_dynamic = function() {
private$dynamic
},
#' @description
#' Get the URL to view an experiment in the browser.
get_url = function() {
private$experiment_url
},
#' @description
#' Get an experiment's metadata.
get_metadata = function() {
get_metadata(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Archive an experiment.
archive = function() {
private$check_active()
archive_experiment(experiment_key = private$experiment_key, api_key = private$api_key)
invisible(self)
},
#' @description
#' Restore an archived experiment.
restore = function() {
private$check_active()
restore_experiment(experiment_key = private$experiment_key, api_key = private$api_key)
invisible(self)
},
#' @description
#' Delete an experiment.
delete = function() {
private$finalize()
delete_experiment(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Stop an experiment. Always call this method before creating a new experiment.
stop = function() {
private$finalize()
invisible(self)
},
#' @description
#' Log a metric name and value. Metrics are the only items that are logged as
#' a full time series. However, even metrics can be throttled if too much data
#' (either by rate or by count) is attempted to be logged.
#' @param name (Required) Name of the metric.
#' @param value (Required) Value of the metric.
#' @param step Step number.
#' @param epoch Epoch.
#' @param context Context.
log_metric = function(name, value, step = NULL, epoch = NULL, context = NULL) {
private$check_active()
log_metric(experiment_key = private$experiment_key, api_key = private$api_key,
name = name, value = value, step = step, epoch = epoch, context = context)
invisible(self)
},
#' @description
#' Get All Metrics For Name
#' @param name (Required) Name of metric.
get_metric = function(name) {
get_metric(experiment_key = private$experiment_key, api_key = private$api_key,
name = name)
},
#' @description
#' Get an experiment's metrics summary.
get_metrics_summary = function() {
get_metrics_summary(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Log an experiment's associated model graph.
#' @param graph (Required) JSON representation of a graph.
log_graph = function(graph) {
private$check_active()
log_graph(experiment_key = private$experiment_key, api_key = private$api_key,
graph = graph)
invisible(self)
},
#' @description
#' Get an experiment's model graph.
get_graph = function() {
get_graph(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Log a parameter name and value. Note that you can only retrieve parameters
#' summary data (e.g., this is not recorded as a full time series).
#' @param name (Required) Name of the parameter.
#' @param value (Required) Value of the parameter.
#' @param step Step number.
log_parameter = function(name, value, step = NULL) {
private$check_active()
log_parameter(experiment_key = private$experiment_key, api_key = private$api_key,
name = name, value = value, step = step)
invisible(self)
},
#' @description
#' Get an experiment's parameters summary.
get_parameters = function() {
get_parameters(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Log a key/value `other`` data (not a metric or parameter). Note
#' that you can only retrieve others summary data (e.g., this is
#' not recorded as a full time series).
#' @param key (Required) The key.
#' @param value (Required) The value.
log_other = function(key, value) {
private$check_active()
log_other(experiment_key = private$experiment_key, api_key = private$api_key,
key = key, value = value)
invisible(self)
},
#' @description
#' Get an experiment's others (logged with `log_other()`) summary.
get_other = function() {
get_other(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Add a list of tags to an experiment.
#' @param tags (Required) List of tags.
add_tags = function(tags) {
private$check_active()
add_tags(experiment_key = private$experiment_key, api_key = private$api_key,
tags = as.list(tags))
invisible(self)
},
#' @description
#' Get an experiment's tags.
get_tags = function() {
get_tags(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Set (or append onto) an experiment's HTML.
#' @param html (Required) An HTML string to add to the experiment.
#' @param override If `TRUE`, override the previous HTML. If `FALSE`, append to it.
log_html = function(html, override = FALSE) {
private$check_active()
log_html(experiment_key = private$experiment_key, api_key = private$api_key,
html = html, override = override)
invisible(self)
},
#' @description
#' Get an experiment's HTML.
get_html = function() {
get_html(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Upload a file to the experiment.
#' @param file (Required) Path to the file to upload.
#' @param step Step number.
#' @param overwrite If `TRUE`, overwrite any uploaded file with the same name.
#' @param context The context.
#' @param type The type of asset.
#' @param name Name of the file on comet. By default the name of the file will
#' match the file that you upload, but you can use this parameter to use a
#' different name.
#' @param metadata Metadata to upload along with the file.
upload_asset = function(file, step = NULL, overwrite = NULL, context = NULL,
type = NULL, name = NULL, metadata = NULL) {
private$check_active()
upload_asset(
experiment_key = private$experiment_key,
api_key = private$api_key,
file = file,
step = step,
overwrite = overwrite,
context = context,
type = type,
name = name,
metadata = metadata
)
invisible(self)
},
#' @description
#' Logs a Remote Asset identified by an URI. A Remote Asset is an asset but its content is not
#' uploaded and stored on Comet. Rather a link for its location is stored, so you can identify
#' and distinguish between two experiment using different version of a dataset stored somewhere
#' else.
#' @param uri (Required) The remote asset location, there is no imposed format, and it could be a
#' private link.
#' @param remote_file_name The "name" of the remote asset, could be a dataset
#' name, a model file name.
#' @param step Step number.
#' @param overwrite If `TRUE`, overwrite any logged asset with the same name.
#' @param type The type of asset, default: "asset".
#' @param metadata Metadata to log along with the asset
log_remote_asset = function(uri,
remote_file_name = NULL,
step = NULL,
overwrite = FALSE,
type = "asset",
metadata = NULL) {
private$check_active()
if (is.null(remote_file_name)) {
# Try to parse the URI to see if we can extract a useful file name
remote_file_name <- remote_asset_name_from_uri(uri)
}
upload_remote_asset(
experiment_key = private$experiment_key,
api_key = private$api_key,
remote_uri = uri,
step = step,
overwrite = overwrite,
type = type,
name = remote_file_name,
metadata = metadata
)
invisible(self)
},
#' @description
#' Get an experiment's asset list.
#' @param type The type of assets to retrieve (by default, all assets are returned).
get_asset_list = function(type = NULL) {
get_asset_list(experiment_key = private$experiment_key, api_key = private$api_key,
type = type)
},
#' @description
#' Get an asset.
#' @param assetId (Required) The asset ID to retrieve.
get_asset = function(assetId) {
get_asset(experiment_key = private$experiment_key, api_key = private$api_key,
assetId = assetId)
},
#' @description
#' Add a symlink to an experiment in another project.
#' @param project_name (Required) Project that the experiment to should linked to.
create_symlink = function(project_name) {
private$check_active()
symlink_experiment(experiment_key = private$experiment_key, api_key = private$api_key,
project_name = project_name)
},
#' @description
#' Log an experiment's git metadata. This should only be called once and it can be done
#' automatically by enabling `log_git_info` in [`create_experiment()`] or [`get_experiment()`].
#' This will replace any previous git metadata that was logged.
#' @param branch Git branch name.
#' @param origin Git repository origin.
#' @param parent Git commit SHA.
#' @param user Git username.
#' @param root Git root.
log_git_metadata = function(branch = NULL, origin = NULL, parent = NULL, user = NULL, root = NULL) {
private$check_active()
details <- list(
branch = branch,
origin = origin,
parent = parent,
user = user,
root = root
)
log_git_metadata(experiment_key = private$experiment_key, details = details, api_key = private$api_key)
invisible(self)
},
#' @description
#' Get the git metadata of an experiment.
get_git_metadata = function() {
get_git_metadata(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Get the git patch of an experiment.
get_git_patch = function() {
patch <- get_git_patch(experiment_key = private$experiment_key, api_key = private$api_key)
if (is.raw(patch)) {
rawToChar(patch)
} else {
patch
}
},
#' @description
#' Get an experiment's standard output and error.
get_output = function() {
get_output(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Log an experiment's source code. This should only be called once and it can be done
#' automatically by enabling `log_code` in [`create_experiment()`] or [`get_experiment()`].
#' This will replace any previous code that was logged.
#' @param code The code to set as the source code.
log_code = function(code) {
private$check_active()
log_code(experiment_key = private$experiment_key, code = code, api_key = private$api_key)
invisible(self)
},
#' @description
#' Get an experiment's source code.
get_code = function() {
get_code(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Log system details. This can be done automatically by enabling `log_system_details`
#' in [`create_experiment()`] or [`get_experiment()`].
#' @param command Script and optional arguments.
#' @param executable Executable.
#' @param hostname Hostname.
#' @param installed_packages List of installed R packages.
#' @param gpu_static_info List of GPU information, where each GPU is a `list()` with
#' fields `gpuIndex`, `name`, `powerLimit`, `totalMemory`, `uuid`.
#' @param ip IP address.
#' @param network_interface_ips List of network interface IPs.
#' @param additional_system_info List of additional parameters to log,
#' where each parameter is a `list()` with `key` and `value` pairs.
#' @param os Full details about operating system.
#' @param os_packages List of operating system packages installed.
#' @param os_type Operating system type.
#' @param pid Process ID.
#' @param user User.
#' @param r_version Short form R version.
#' @param r_version_verbose Long form R version.
log_system_details = function(
command = NULL, executable = NULL, hostname = NULL, installed_packages = NULL, gpu_static_info = NULL,
ip = NULL, network_interface_ips = NULL, additional_system_info = NULL, os = NULL,
os_packages = NULL, os_type = NULL, pid = NULL, user = NULL, r_version = NULL,
r_version_verbose = NULL
) {
private$check_active()
details <- list(
command = as.list(command),
executable = executable,
hostname = hostname,
installedPackages = as.list(installed_packages),
gpuStaticInfoList = gpu_static_info,
ip = ip,
networkInterfaceIps = as.list(network_interface_ips),
logAdditionalSystemInfoList = additional_system_info,
os = os,
osPackages = as.list(os_packages),
osType = os_type,
pid = pid,
user = user,
pythonVersion = r_version,
pythonVersionVerbose = r_version_verbose
)
log_system_details(experiment_key = private$experiment_key, details = details, api_key = private$api_key)
invisible(self)
},
#' @description
#' Get an experiment's system details.
get_system_details = function() {
get_system_details(experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Log an [`Artifact`] object, synchronously create a new Artifact Version and
#' upload all local and remote assets attached to the [`Artifact`] object.
#' @param artifact an [`Artifact`] object.
#' @returns [`LoggedArtifact`] with all relevant information about logged
#' artifact.
log_artifact = function(artifact) {
private$check_active()
if (!inherits(artifact, "Artifact")) {
comet_stop("Object is not an Artifact and cannot be logged")
}
log_artifact(artifact = artifact, experiment_key = private$experiment_key, api_key = private$api_key)
},
#' @description
#' Returns a logged artifact object that can be used to access the artifact
#' version assets and download them locally.
#'
#' If no version or alias is provided, the latest version for that artifact is returned.
#'
#' @param artifact_name (Required) Retrieve an artifact with that name. This could either be a fully
#' qualified artifact name like `workspace/artifact-name:versionOrAlias` or just the name
#' of the artifact like `artifact-name`.
#' @param workspace Retrieve an artifact belonging to that workspace.
#' @param version_or_alias Retrieve the artifact by the given alias or version.
#' @returns [`LoggedArtifact`] with all relevant information about logged
#' artifact.
#'
#' @examples
#' \dontrun{
#' library(cometr)
#' # Assuming you have COMET_API_KEY, COMET_WORKSPACE, COMET_PROJECT_NAME variables define
#' exp <- create_experiment()
#'
#' # Get a Comet Artifact
#' logged_artifact <- exp$get_artifact("workspace/artifact-name:version_or_alias")
#'
#' # Which is equivalent to
#' logged_artifact = exp$get_artifact(artifact_name="artifact-name",
#' workspace="workspace",
#' version_or_alias="version_or_alias")
#' }
get_artifact = function(artifact_name, workspace = NULL, version_or_alias = NULL) {
private$check_active()
get_artifact_by_name(experiment_key = private$experiment_key,
artifact_name = artifact_name,
workspace = workspace,
version_or_alias = version_or_alias,
api_key = private$api_key)
},
#' @description
#' Set an experiment's start and end time.
#' @param start Start time for the experiment (milliseconds since the Epoch)
#' @param end End time for the experiment (milliseconds since the Epoch)
set_start_end_time = function(start = NULL, end = NULL) {
private$check_active()
if (is.null(start) && is.null(end)) {
comet_stop("Either start or end must be provided.")
}
set_start_end_time(experiment_key = private$experiment_key, api_key = private$api_key,
start = start, end = end)
invisible(self)
},
#' @description
#' Print the experiment.
print = function() {
cat("Comet experiment", private$experiment_url, "\n")
}
),
private = list(
experiment_key = NULL,
api_key = NULL,
experiment_url = NULL,
dynamic = NULL,
keepalive_process = NULL,
workspace_name = NULL,
project_name = NULL,
log_output = NULL,
log_error = NULL,
logfile_path = NULL,
logfile = NULL,
log_offset_path = NULL,
logging_process = NULL,
check_active = function() {
if (is.null(.cometrenv$curexp) ||
self$get_key() != .cometrenv$curexp$get_key()) {
comet_stop("This experiment already ended and cannot be modified.")
}
},
finalize = function() {
LOG_DEBUG("Experiment finalizer called on experiment ", self$get_key())
suppressWarnings({
# If this is the active experiment, unset the active experiment
if (!is.null(.cometrenv$curexp) && self$get_key() == .cometrenv$curexp$get_key()) {
LOG_DEBUG("Clearing cometr current experiment.")
.cometrenv$curexp <- NULL
}
# Stop sending the keepalive signal
if (!is.null(private$keepalive_process) && private$keepalive_process$is_alive()) {
LOG_DEBUG("Stopping sendalive signal.")
private$keepalive_process$interrupt()
}
# Stop logging output logs
if (!is.null(private$logging_process) && private$logging_process$is_alive()) {
LOG_DEBUG("Stopping output logging.")
private$logging_process$interrupt()
}
# Stop redirecting output to log files
if (private$log_output) {
sink(NULL, type = "output")
}
if (private$log_error) {
sink(NULL, type = "message")
}
if (private$log_output || private$log_error) {
# Close output log file
try(close(private$logfile), silent = TRUE)
# Log the last output logs that haven't had a chance to be sent to Comet yet
try({
if (file.exists(private$log_offset_path)) {
offset <- as.integer(readLines(private$log_offset_path))
} else {
offset <- 0
}
logfile <- file(private$logfile_path, open = "r")
readLines(logfile, n = offset)
new_messages <- readLines(logfile)
close(logfile)
if (length(new_messages) > 0) {
log_output_lines(
experiment_key = private$experiment_key,
lines = new_messages,
offset = offset,
api_key = private$api_key
)
}
}, silent = TRUE)
# Remove the log files
try(file.remove(private$logfile_path), silent = TRUE)
try(file.remove(private$log_offset_path), silent = TRUE)
}
})
}
)
)
create_keepalive_process <- function(exp_key, api_key) {
callr::r_bg(
function(exp_key, api_key) {
cometr::disable_logging()
while(TRUE) {
keepalive <- asNamespace("cometr")$send_keepalive(experiment_key = exp_key, api_key = api_key)
sleeptime <- keepalive[["isAliveBeatDurationMillis"]]
if (is.null(sleeptime)) {
break
}
Sys.sleep(sleeptime / 1000)
}
},
args = list(exp_key = exp_key, api_key = api_key),
supervise = TRUE
)
}
create_logging_process <- function(experiment_key, logfile_path, log_offset_path, api_key) {
callr::r_bg(
function(experiment_key, logfile_path, log_offset_path, api_key) {
if (!file.exists(logfile_path)) {
return()
}
cometr::disable_logging()
logfile <- file(logfile_path, open = "r")
offset <- 0
writeLines(as.character(offset), log_offset_path)
log_new_messages <- function() {
new_messages <- readLines(logfile)
if (length(new_messages) > 0) {
asNamespace("cometr")$log_output_lines(
experiment_key = experiment_key,
lines = new_messages,
offset = offset,
api_key = api_key
)
offset <<- offset + length(new_messages)
writeLines(as.character(offset), log_offset_path)
}
}
while(TRUE) {
log_new_messages()
Sys.sleep(10)
}
},
args = list(experiment_key = experiment_key, logfile_path = logfile_path,
log_offset_path = log_offset_path, api_key = api_key),
supervise = TRUE
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.