Merge branch 'release/0.1.0'

Author: HenrikBengtsson

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: future.p2p
 Title: A Peer-to-Peer Compute Cluster via Futureverse
-Version: 0.0.0.9027
+Version: 0.1.0
 Description: Implementation of the 'Future' API <doi:10.32614/RJ-2021-048> that resolves futures on a peer-to-peer ('P2P') compute environment. By using this future backend, you and your friends can share your spare compute resources with each other.
 Depends:
   future (>= 1.58.0)

NAMESPACE

@@ -11,14 +11,14 @@ S3method(resolved,PicoP2PFuture)
 S3method(result,PicoP2PFuture)
 export(PicoP2PFutureBackend)
 export(availablePicoP2PWorkers)
+export(cluster)
 export(find_wormhole)
 export(future_id)
+export(host_cluster)
 export(install_wormhole)
 export(p2p_cluster)
 export(p2p_name)
 export(pico_hosted_channels)
-export(pico_p2p)
-export(pico_p2p_cluster)
 export(pico_p2p_have_future)
 export(pico_p2p_hello)
 export(pico_p2p_hosted_clusters)
@@ -28,13 +28,13 @@ export(pico_p2p_send_future)
 export(pico_p2p_send_result)
 export(pico_p2p_take_on_future)
 export(pico_p2p_wait_for)
-export(pico_p2p_worker)
 export(pico_pipe)
 export(pico_receive_message)
 export(pico_receive_message_dataframe)
 export(pico_send_message)
 export(pico_terminate)
 export(pico_username)
+export(worker)
 export(wormhole_filename)
 export(wormhole_receive)
 export(wormhole_send)

NEWS.md

@@ -0,0 +1,4 @@
+# Version 0.1.0 [2025-08-10]
+
+This is the first public version of the **future.p2p** package.
+

R/PicoP2PFutureBackend-class.R

@@ -1,9 +1,9 @@
-#' pico_p2p futures
+#' p2p futures
 #'
 #' _WARNING: This function must never be called.
 #'  It may only be used with [future::plan()]_
 #'
-#' A 'pico_p2p' future is an asynchronous multiprocess
+#' A 'p2p' future is an asynchronous multiprocess
 #' future that will be evaluated in a background R session.
 #'
 #' @inheritParams pico_pipe
@@ -23,15 +23,14 @@
 #' being invited to a shared folder.
 #'
 #' Users who wish to contribute their compute power to the P2P cluster
-#' should call [pico_p2p_worker()].
+#' should call [worker()].
 #'
 #' Users who wish to take advantage of the compute power of the
-#' P2P cluster should use `plan(pico_p2p)`.
+#' P2P cluster should use `plan(future.p2p::cluster)`.
 #'
 #' @examplesIf interactive()
-#' ## Futures are pushed to the Pico P2P cluster and 
-#' ## results are collected from there
-#' plan(future.p2p::pico_p2p, .init = FALSE)
+#' # Connect to personal P2P cluster, which is automatically launched
+#' plan(future.p2p::cluster)
 #' 
 #' ## Create future
 #' a <- 42
@@ -47,16 +46,16 @@
 #'
 #' @importFrom future future
 #' @export
-pico_p2p <- function(cluster = p2p_cluster(), name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, ...) {
-  stop("INTERNAL ERROR: The future.p2p::pico_p2p() must never be called directly")
+cluster <- function(cluster = p2p_cluster(), name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, ...) {
+  stop("INTERNAL ERROR: The future.p2p::cluster() function must never be called directly")
 }
-class(pico_p2p) <- c("pico_p2p", "multiprocess", "future", "function")
-attr(pico_p2p, "init") <- TRUE
+class(cluster) <- c("pico_p2p", "multiprocess", "future", "function")
+attr(cluster, "init") <- TRUE
 
 
 #' A Pico P2P future is resolved through a Peer-to-Peer (P2P) workers communicating via pico.sh and Wormhole
 #'
-#' @inheritParams pico_p2p
+#' @inheritParams cluster
 #'
 #' @param \ldots Additional arguments passed to [future::FutureBackend()].
 #'
@@ -107,7 +106,7 @@ PicoP2PFutureBackend <- function(cluster = p2p_cluster(), name = p2p_name(), hos
 
   core
 }
-attr(pico_p2p, "factory") <- PicoP2PFutureBackend
+attr(cluster, "factory") <- PicoP2PFutureBackend
 
 
 
@@ -177,7 +176,7 @@ nbrOfFreeWorkers.PicoP2PFutureBackend <- function(evaluator = NULL, background =
 #' It will always return at least one worker, which is yourself.
 #' _WARNING: This is currently hardcoded to 10 workers, regardless of the number._
 #' 
-#' @rdname pico_p2p
+#' @rdname cluster
 #' @export
 availablePicoP2PWorkers <- function() {
   nworkers <- 10L
@@ -302,7 +301,10 @@ print.PicoP2PFutureBackend <- function(x, ...) {
   cat(sprintf("P2P clusters you are hosting: [n=%d]\n", nrow(clusters)))
   for (kk in seq_len(nrow(clusters))) {
     cluster <- clusters[kk, ]
-    cat(sprintf(" %2d. %s (%s)\n", kk, cluster$name, cluster$users))
+    users <- strsplit(cluster$users, split = ",", fixed = TRUE)[[1]]
+    users <- unique(c(users, pico_username()))
+    users <- paste(users, collapse = ", ")
+    cat(sprintf(" %2d. %s (users: %s)\n", kk, sQuote(cluster$name), users))
   }
 
   cat("Message board:\n")
@@ -321,7 +323,7 @@ print.PicoP2PFutureBackend <- function(x, ...) {
 }
 
 
-p2p_can_connect <- function(cluster, name = name, host = "pipe.pico.sh", ssh_args = NULL, timeout = 10.0) {
+p2p_can_connect <- function(cluster, name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, timeout = 10.0) {
   cluster_owner <- dirname(cluster)
   if (cluster_owner == pico_username()) {
     topic <- sprintf("%s/future.p2p", basename(cluster))

R/p2p_name.R

@@ -1,14 +1,21 @@
 #' Gets the default name of the P2P cluster
 #'
+#' @param users Users to have access to the cluster. This controls whether
+#' the default cluster names should be "personal" or "friends".
+#'
 #' @return
-#' `p2p_cluster()` return R option `future.p2p.cluster`, if set,
-#' otherwise `{pico_name}/personal`.
+#' `p2p_cluster()` returns R option `future.p2p.cluster`, if set.
+#' If not set, it returns `{pico_name}/personal` if `length(users) == 0`,
+#' otherwise `{pico_name}/friends`.
 #' 
 #' @export
-p2p_cluster <- function() {
+p2p_cluster <- function(users = character(0)) {
+  users <- unique(users)
   name <- getOption("future.p2p.cluster")
   if (is.null(name)) {
-    name <- sprintf("%s/%s", pico_username(), "personal")
+    users <- setdiff(users, pico_username())
+    name <- if (length(users) == 0) "personal" else "friends"
+    name <- sprintf("%s/%s", pico_username(), name)
   }
   name
 }

R/pico_p2p_cluster.R

@@ -1,4 +1,4 @@
-#' Launches a P2P cluster
+#' Hosts a P2P cluster
 #'
 #' @inheritParams pico_pipe
 #'
@@ -13,11 +13,12 @@
 #' @param duration Duration (in seconds) to offer this cluster.
 #'
 #' @examplesIf interactive()
-#' pico_p2p_cluster()
+#' # Connect to personal P2P cluster, which is automatically launched
+#' host_cluster(users = c("bob", "carol"))
 #'
 #' @importFrom future resolve plan sequential
 #' @export
-pico_p2p_cluster <- function(cluster = p2p_cluster(), users = character(0L), name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, duration = 14*24*60*60) {
+host_cluster <- function(cluster = p2p_cluster(users), users = character(0L), name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, duration = 14*24*60*60) {
   stopifnot(length(cluster) == 1L, is.character(cluster), !is.na(cluster), nzchar(cluster))
 
   parts <- strsplit(cluster, split = "/", fixed = TRUE)[[1]]
@@ -100,8 +101,8 @@ pico_p2p_cluster <- function(cluster = p2p_cluster(), users = character(0L), nam
   info("shutting down cluster ...")
   pico_terminate(p)
   info("bye")
-} ## pico_p2p_cluster()
+} ## host_cluster()
 
 
 ## Expose function on the CLI
-cli_fcn(pico_p2p_cluster) <- c("--(cluster)=(.*)", "--(name)=(.*)", "--(users)=(.*)", "--(host)=(.*)", "--(ssh_args)=(.*)", "--(duration)=([[:digit:]]+)")
+cli_fcn(host_cluster) <- c("--(cluster)=(.*)", "--(name)=(.*)", "--(users)=(.*)", "--(host)=(.*)", "--(ssh_args)=(.*)", "--(duration)=([[:digit:]]+)")

R/pico_p2p_worker.R

@@ -9,15 +9,16 @@
 #' @param duration Duration (in seconds) to offer working on futures.
 #'
 #' @examplesIf interactive()
-#' pico_p2p_worker()
+#' ## Start a P2P cluster worker
+#' future.p2p::worker()
 #'
 #' @section Sequential, single-core processing by default:
 #' A P2P worker runs sequentially (`plan(sequential)`) and is configured
 #' to with a single CPU core to prevent nested parallelization.
 #'
 #' @importFrom future resolve plan sequential
 #' @export
-pico_p2p_worker <- function(cluster = p2p_cluster(), name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, duration = 60*60) {
+worker <- function(cluster = p2p_cluster(), name = p2p_name(), host = "pipe.pico.sh", ssh_args = NULL, duration = 60*60) {
   parts <- strsplit(cluster, split = "/", fixed = TRUE)[[1]]
   if (length(parts) != 2L) {
     stop(sprintf("Argument 'cluster' must be of format '{owner}/{name}': %s", sQuote(cluster)))
@@ -108,8 +109,8 @@ pico_p2p_worker <- function(cluster = p2p_cluster(), name = p2p_name(), host = "
     }
   } ## repeat()
   info("bye")
-} ## pico_p2p_worker()
+} ## worker()
 
 
 ## Expose function on the CLI
-cli_fcn(pico_p2p_worker) <- c("--(cluster)=(.*)", "--(name)=(.*)", "--(host)=(.*)", "--(ssh_args)=(.*)", "--(duration)=([[:digit:]]+)")
+cli_fcn(worker) <- c("--(cluster)=(.*)", "--(name)=(.*)", "--(host)=(.*)", "--(ssh_args)=(.*)", "--(duration)=([[:digit:]]+)")

R/utils-options.R

@@ -14,6 +14,15 @@
 #' If you find yourself having to tweak one of the options, make sure to
 #' undo your changes immediately afterward.
 #'
+#' @section Options:
+#' \describe{
+#'  \item{\option{future.p2p.wormhole}:}{(character)
+#'    Specifies the absolute path to the `wormhole` executable. If not
+#'    specified, a default one will be installed.
+#     (Default: not set)
+#'  }
+#' }
+#'
 #' @section Options for debugging:
 #' \describe{
 #'  \item{\option{future.p2p.debug}:}{(logical)
@@ -40,8 +49,10 @@
 #' future.p2p.options
 #'
 #' future.p2p.debug
+#' future.p2p.wormhole
 #'
-#' R_FUTURE_DEBUG
+#' R_FUTURE_P2P_DEBUG
+#' R_FUTURE_P2P_WORMHOLE
 #'
 #' @name zzz-future.p2p.options 
 NULL
@@ -138,4 +149,5 @@ update_package_option <- function(name, mode = "character", default = NULL, spli
 ## Set options based on environment variables
 update_package_options <- function(debug = FALSE) {
   update_package_option("future.p2p.debug", mode = "logical")
+  update_package_option("future.p2p.wormhole", mode = "character")
 }

R/vignette_engine.R

@@ -18,6 +18,7 @@ register_vignette_engine_during_build_only <- function(pkgname) {
 
       html <- commonmark::markdown_html(md,
                                         smart = FALSE,
+					footnotes = TRUE,
                                         extensions = "table",
                                         normalize = FALSE)
 

R/wormhole.R

@@ -63,17 +63,22 @@ wormhole_receive <- function(code, path = tempdir(), ..., rsh = NULL) {
   files
 }
 
-#' Find the Wormhole Executable
+#' Find a Wormhole Executable
 #'
 #' @return
 #' The absolute path to the `wormhole` executable as a character string.
 #' Attribute `version-string` comprise the `wormhole --version` output,
 #' and attributes `name` and `version` the parsed version string.
 #' If no executable exists, an error is produced.
 #'
+#' @details
+#' Unless R option `future.p2p.wormhole` specifies an executable, the default
+#' is to download and install `wormhole-william` locally and use that one.
+#'
 #' @export
 find_wormhole <- local({
   bin <- NULL
+  
   function() {
     if (is.null(bin)) {
       debug <- isTRUE(getOption("future.p2p.debug"))
@@ -85,14 +90,24 @@ find_wormhole <- local({
         })
       }
 
-      res <- wormhole_pathname()
-
-      ## Install wormhole?  
-      if (!file_test("-x", res)) res <- install_wormhole()
-
+      ## User specified binary?
+      res <- getOption("future.p2p.wormhole")
+      if (!is.null(res)) {
+        if (!file_test("-f", res)) {
+          stop("R option 'future.p2p.wormhole' specifies a non-existing file: ", sQuote(res))
+	} else if (!file_test("-x", res)) {
+        stop("R option 'future.p2p.wormhole' specifies a file that is non-executable: ", sQuote(res))
+        }
+      }	else {
+        ## If not, install automatically, if missing
+        res <- wormhole_pathname()
+
+        ## Install wormhole?
+        if (!file_test("-x", res)) res <- install_wormhole()
+      }
+      
       ## Legacy: fall back to pre-existing 'wormhole' executable
       if (!file_test("-x", res)) res <- Sys.which("wormhole")
-      
       if (debug) mdebugf("Wormhole executable: %s", sQuote(res))
 
       if (nzchar(res)) {
@@ -201,7 +216,7 @@ install_wormhole <- function(pathname = wormhole_pathname(), version = "1.0.8")
   filename <- basename(pathname)
 
   url <- sprintf("https://github.com/psanford/wormhole-william/releases/download/v%s/%s", version, filename)
-  tf <- file.path(tempdir(), filename)
+  tf <- sprintf("%s.%s", pathname, basename(tempdir()))
   res <- download.file(url, destfile = tf, mode = "wb")
   stopifnot(file_test("-f", tf))
   Sys.chmod(tf, mode = "0755")