Skip to content

Commit

Permalink
Figure updating with full ggplot code
Browse files Browse the repository at this point in the history
  • Loading branch information
@wenjie1991
wenjie1991 committed Aug 4, 2024
1 parent b317754 commit ecbbfae
Show file tree
Hide file tree
Showing 8 changed files with 420 additions and 184 deletions.
131 changes: 83 additions & 48 deletions R/lib.R
View file
Original file line number Diff line number Diff line change
@@ -1,20 +1,40 @@
## Update fdObj by reading the data from the disk
fd_update = function(fdObj_loc) {
## extract code from the ggplot object
fd_extract_ggplot_code = function(g) {
## Extract the original code from ggplot object
code = constructive:::.cstr_construct(g$mapping)
code = constructive:::pipe_to_layers(code, g$layers, plot_env = g$plot_env, one_liner = TRUE)
code = constructive:::pipe_to_facets(code, g$facet, one_liner = TRUE)
code = constructive:::pipe_to_labels(code, g$labels, g$mapping, g$layers, one_liner = TRUE)
code = constructive:::pipe_to_scales(code, g$scales, one_liner = TRUE)
code = constructive:::pipe_to_theme(code, g$theme, one_liner = TRUE)
code = constructive:::pipe_to_coord(code, g$coordinates, one_liner = TRUE)
code = constructive:::repair_attributes_ggplot(g, code, one_liner = TRUE)
code = paste0("ggplot(data) + ", gsub("ggplot2::", "", code))
code
}


## Update fdObj by reading the data **from the disk**
fd_update = function(fdObj_loc, do_lock = TRUE) {
fdObj_global = as.character(substitute(fdObj, env = parent.frame(n = 1)))
fdObj_parent = as.character(substitute(fdObj))
# print(fdObj_global)
lock = lock(file.path(fdObj_loc$dir, "/db.lock"), exclusive = FALSE)
if (do_lock) {
lock = lock(file.path(fdObj_loc$dir, "/db.lock"), exclusive = FALSE)
}
if (!dir.exists(fdObj_loc$dir)) {
stop("Directory does not exist")
}
env = readr::read_rds(file.path(fdObj_loc$dir, "env.rds"))
fdObj_loc$env = env
unlock(lock)
if (do_lock) {
unlock(lock)
}
assign(fdObj_global, fdObj_loc, envir = parent.frame(n = 2))
assign(fdObj_parent, fdObj_loc, envir = parent.frame(n = 1))
}

## Save the ggfigdone data to the disk
## Update the ggfigdone database changes **to the disk**
fd_save = function(fdObj) {
message("Saving the ggfigdone data to the disk...")
lock = lock(file.path(fdObj$dir, "/db.lock"), exclusive = TRUE)
Expand Down Expand Up @@ -54,7 +74,7 @@ fd_plot = function(fdObj, id) {
#' fd_init(db_dir)
#'
#' @export
fd_init = function(dir, recursive = TRUE) {
fd_init = function(dir, recursive = TRUE, ...) {
if (!dir.exists(dir)) {
dir.create(dir, recursive = recursive)
}
Expand All @@ -65,7 +85,7 @@ fd_init = function(dir, recursive = TRUE) {
env = new.env()
readr::write_rds(env, file.path(dir, "env.rds"))

fd_load(dir)
fd_load(dir, ...)
}

#' Load the ggfigdone database
Expand All @@ -84,15 +104,34 @@ fd_init = function(dir, recursive = TRUE) {
#' fd_load(db_dir)
#'
#' @export
fd_load = function(dir) {
lock = lock(file.path(dir, "/db.lock"), exclusive = FALSE)
fd_load = function(dir, auto_database_upgrade = TRUE) {
## Check if the directory exists
if (!dir.exists(dir)) {
stop("Directory does not exist")
}

## Check the version of the database
if (auto_database_upgrade) {
if (!file.exists(file.path(dir, "version.txt"))) {
x_version = "v0"
} else {
x_version = readLines(file.path(dir, "version.txt"))
}

if (x_version == "v0") {
message(paste0("The database is version 0. It will be transformed to version 1. Please stop other processes that are using the database."))
transform_db_v02v1(dir)
} else if (x_version != "v1") {
stop(paste0("The version of the database is ", x_version, " which is not supported."))
} else {
message("The database version is up-to-date.")
}
}

## Load the ggfigdone database
lock = lock(file.path(dir, "/db.lock"), exclusive = FALSE)
env = readr::read_rds(file.path(dir, "env.rds"))
unlock(lock)

obj = list(
env = env,
dir = dir
Expand Down Expand Up @@ -149,22 +188,27 @@ fd_add = function(g, name, fdObj,
width = 5,
height = 5,
units = "cm",
dpi = 600,
dpi = 200,
overwrite = F,
id = uuid::UUIDgenerate())
{
fd_update(fdObj)
if (id %in% names(fdObj$env) && !overwrite) {
stop("Figure already exists")
}

code_origin = fd_extract_ggplot_code(g)

figObj = list(
g_origin = g,
g_updated = g,
data = g$data,
code_origin = code_origin,
code_updated = code_origin,
name = name,
id = id,
created_date = Sys.time(),
updated_date = Sys.time(),
update_history = c(),
canvas_options = list(
width = width,
height = height,
Expand All @@ -183,7 +227,6 @@ format.fdObj = function(fdObj) {
fd_update(fdObj)
lapply(names(fdObj$env), function(id) {


data.table::data.table(
id = id,
name = fdObj$env[[id]]$name,
Expand Down Expand Up @@ -232,6 +275,8 @@ fd_ls = function(fdObj) {
name = fdObj$env[[id]]$name,
created_date = fdObj$env[[id]]$created_date,
updated_date = fdObj$env[[id]]$updated_date,
code_origin = fdObj$env[[id]]$code_origin,
code_updated = fdObj$env[[id]]$code_updated,
width = fdObj$env[[id]]$canvas_options$width,
height = fdObj$env[[id]]$canvas_options$height,
units = fdObj$env[[id]]$canvas_options$units,
Expand Down Expand Up @@ -274,6 +319,16 @@ fd_back_to_origin = function(id, fdObj) {
}
}

fd_change_name = function(id, name, fdObj) {
fd_update(fdObj)
lock = lock(file.path(fdObj$dir, "/db.lock"), exclusive = TRUE)
if (id %in% names(fdObj$env)) {
fdObj$env[[id]]$name = name
fdObj$env[[id]]$updated_date = Sys.time()
}
unlock(lock)
}

#' Update a figure using ggplot expression
#'
#' This function updates a figure using a ggplot expression.
Expand All @@ -284,51 +339,29 @@ fd_back_to_origin = function(id, fdObj) {
#' @return A character string of the status
#' @export
fd_update_fig = function(id, expr, fdObj) {
fd_update(fdObj)
return_val = NULL
lock = lock(file.path(fdObj$dir, "/db.lock"), exclusive = TRUE)
fd_update(fdObj, do_lock = FALSE)
if (id %in% names(fdObj$env)) {
g = fdObj$env[[id]]$g_origin
update_history = fdObj$env[[id]]$update_history
update_history = c(update_history, expr)
expr_new = paste0("g +", paste(update_history, collapse = " + "))
g = try(eval(parse(text = expr_new)))
data = fdObj$env[[id]]$data
code_updated = expr
g = try(eval(parse(text = code_updated)))
# Update the environment when the figure is updated
if (inherits(g, "try-error")) {
return(g)
return_val = g
} else {
fdObj$env[[id]]$update_history = update_history
fdObj$env[[id]]$code_updated = code_updated
fdObj$env[[id]]$g_updated = g
fdObj$env[[id]]$updated_date = Sys.time()
fd_plot(fdObj, id)

return("OK")
return_val = "OK"
}
} else {
return("Figure does not exist")
}
}

## TODO: Browse the editing history of a figure
fd_update_ls = function(id, fdObj) {
fd_update(fdObj)
if (id %in% names(fdObj$env)) {
fdObj$env[[id]]$update_history
}
}

## TODO: Specifically remove an change of a figure
fd_update_rm = function(id, index, fdObj) {
fd_update(fdObj)
if (id %in% names(fdObj$env)) {
g = fdObj$env[[id]]$g_origin
update_history = fdObj$env[[id]]$update_history
update_history = update_history[-index]
fdObj$env[[id]]$update_history = update_history
expr_new = paste0("g +", paste(update_history, collapse = " + "))
g = eval(parse(text = expr_new))
fdObj$env[[id]]$g_updated = g
fdObj$env[[id]]$updated_date = Sys.time()
fd_plot(fdObj, id)
return_val = "Figure does not exist"
}
unlock(lock)
return(return_val)
}

#' Update the figure canvas size
Expand All @@ -346,13 +379,15 @@ fd_canvas = function(
fdObj,
width = fdObj$env[[id]]$canvas_options$width,
height = fdObj$env[[id]]$canvas_options$height,
units = fdObj$env[[id]]$canvas_options$units
units = fdObj$env[[id]]$canvas_options$units,
dpi = fdObj$env[[id]]$canvas_options$dpi
) {
fd_update(fdObj)
if (id %in% names(fdObj$env)) {
fdObj$env[[id]]$canvas_options$width = width
fdObj$env[[id]]$canvas_options$height = height
fdObj$env[[id]]$canvas_options$units = units
fdObj$env[[id]]$canvas_options$dpi = dpi
fdObj$env[[id]]$updated_date = Sys.time()
fd_plot(fdObj, id)
}
Expand Down
26 changes: 22 additions & 4 deletions R/server.R
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,18 @@
font_list = sort(unique(sysfonts::font_files()$family))

response_fg_change_name = function(fo, req) {
# print("response_fg_change_name")
parsed_qeury = parse_url(req$QUERY_STRING)$query
figure_id = parsed_qeury$id
new_name = parsed_qeury$new_name
fd_change_name(figure_id, new_name, fo)
list(
status = 200L,
headers = list('Content-Type' = "text/plain"),
body = "OK"
)
}

response_fg_font_ls = function() {
list(
status = 200L,
Expand All @@ -25,8 +38,9 @@ response_fg_canvas = function(fo, req) {
width = as.numeric(parsed_qeury$width)
height = as.numeric(parsed_qeury$height)
units = parsed_qeury$units
dpi = as.numeric(parsed_qeury$dpi)
# print(figure_name)
fd_canvas(figure_name, fo, width, height, units)
fd_canvas(figure_name, fo, width, height, units, dpi)
list(
status = 200L,
headers = list('Content-Type' = "text/plain"),
Expand All @@ -36,7 +50,10 @@ response_fg_canvas = function(fo, req) {

response_fg_update_fig = function(fo, req) {
# print("response_fg_update_fig")
parsed_qeury = parse_url(req$QUERY_STRING)$query
input <- req[["rook.input"]]
## get the data from the POST request
postdata <- input$read_lines()
parsed_qeury = jsonlite::fromJSON(postdata)
figure_name = parsed_qeury$id
expr = parsed_qeury$gg_code
res = fd_update_fig(figure_name, expr, fo)
Expand Down Expand Up @@ -105,7 +122,9 @@ fd_server = function(dir, port = 8080) {
} else if (path == "/fd_font_ls") {
response_fg_font_ls()
} else if (path == "/fd_canvas") {
response_fg_canvas(fo, req)
response_fg_canvas(fo, req)
} else if (path == "/fd_change_name") {
response_fg_change_name(fo, req)
} else {
list(
status = 404L,
Expand All @@ -125,7 +144,6 @@ fd_server = function(dir, port = 8080) {
# start the server
message_text = paste0("Start service: http://localhost:", port, "/index.html")
message(message_text)
## TODO: change the port info in javascript
runServer(host = "0.0.0.0", port = port, app = app)
}

Expand Down
55 changes: 55 additions & 0 deletions R/update_database.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,55 @@
## Following code is used to update the database with new data structures

## From no version to version 1
transform_db_v02v1 <- function(dir) {
## Lock before updating
lock = lock(file.path(dir, "/db.lock"), exclusive = FALSE)

## Get fig id
env = readr::read_rds(file.path(dir, "env.rds"))

## Create a new environment
new_env = new.env()

## Update the database
lapply(names(env), function(fig_id) {
fig_id = names(env)[1]
## Extract the data from ggplot object
x = env[[fig_id]]
names(x)
x$canvas_options
g = x$g_origin
d = g$data

## Extract the ggplot code
code_origin = fd_extract_ggplot_code(g)

## Append the updating history history code to the original code
update_history = x$update_history
code_updated = paste(update_history, collapse = " + ")
if (code_updated != "") {
code_updated = paste0(code_origin, " + ", code_updated)
} else {
code_updated = code_origin
}

## Create a new fig object
## Remove update_history
x$update_history = NULL

x$code_updated = code_updated
x$code_origin = code_origin

## Add new fig object to the new environment
code_run = paste0("ggplot2::ggplot(d) + ", code_updated)
g_updated = eval(parse(text = code_run))
new_env[[fig_id]] = x
})

## Save the new environment to the disk
readr::write_rds(new_env, file.path(dir, "env.rds"))
writeLines("v1", file.path(dir, "version.txt"))

unlock(lock)
}

Loading

0 comments on commit ecbbfae

Please sign in to comment.