Skip to content

Commit 1037f57

Browse files
committed
feat: add ggplot_chart class
- added a layer entity class to hold ggplot layers - added a typed list class to ensure only gg layers can be set - add a system for specifying preset layers for user convenience - presets can partially/totally overridden - added a new_scatter_chart for testing
1 parent 29df389 commit 1037f57

19 files changed

+1362
-1
lines changed

DESCRIPTION

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -41,16 +41,21 @@ Collate:
4141
'output_class.R'
4242
'model_class.R'
4343
'example_objects.R'
44+
'typed_list_class.R'
45+
'struct_preset_class.R'
46+
'layer_entity_class.R'
47+
'ggplot_chart_class.R'
4448
'model_list_class.R'
4549
'metric_class.R'
4650
'iterator_class.R'
4751
'optimiser_class.R'
4852
'preprocess_class.R'
4953
'resampler_class.R'
54+
'scatter_chart_class.R'
5055
'struct-package.R'
5156
'struct_templates.R'
5257
'zzz.R'
53-
RoxygenNote: 7.3.1
58+
RoxygenNote: 7.3.2
5459
Depends: R (>= 4.0)
5560
Suggests:
5661
testthat,

NAMESPACE

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,14 +14,18 @@ export("output_value<-")
1414
export("param_list<-")
1515
export("param_obj<-")
1616
export("param_value<-")
17+
export("register_preset<-")
1718
export(.struct_class)
1819
export(DatasetExperiment)
1920
export(as.DatasetExperiment)
2021
export(as.SummarizedExperiment)
2122
export(as.code)
2223
export(as_data_frame)
24+
export(as_layer)
25+
export(available_presets)
2326
export(calculate)
2427
export(chart)
28+
export(chart_build)
2529
export(chart_names)
2630
export(chart_plot)
2731
export(citations)
@@ -33,10 +37,13 @@ export(example_chart)
3337
export(example_iterator)
3438
export(example_model)
3539
export(get_description)
40+
export(get_preset)
41+
export(ggplot_chart)
3642
export(iris_DatasetExperiment)
3743
export(is_output)
3844
export(is_param)
3945
export(iterator)
46+
export(layer_entity)
4047
export(libraries)
4148
export(max_length)
4249
export(metric)
@@ -47,6 +54,7 @@ export(model_reverse)
4754
export(model_seq)
4855
export(model_train)
4956
export(models)
57+
export(new_scatter_chart)
5058
export(new_struct)
5159
export(ontology)
5260
export(ontology_list)
@@ -65,6 +73,7 @@ export(param_value)
6573
export(predicted)
6674
export(predicted_name)
6775
export(preprocess)
76+
export(preset)
6877
export(resampler)
6978
export(result)
7079
export(result_name)
@@ -81,6 +90,7 @@ export(stato_summary)
8190
export(struct_class)
8291
export(struct_template)
8392
export(test_metric)
93+
export(typed_list)
8494
export(value)
8595
exportClasses(struct_class)
8696
exportMethods("$")
@@ -89,8 +99,11 @@ exportMethods("*")
8999
exportMethods("+")
90100
exportMethods("[")
91101
exportMethods("[<-")
102+
exportMethods("[[")
103+
exportMethods("[[<-")
92104
exportMethods("max_length<-")
93105
exportMethods("models<-")
106+
exportMethods("names<-")
94107
exportMethods("output_list<-")
95108
exportMethods("output_obj<-")
96109
exportMethods("output_value<-")
@@ -105,12 +118,15 @@ exportMethods(.DollarNames)
105118
exportMethods(as.DatasetExperiment)
106119
exportMethods(as.SummarizedExperiment)
107120
exportMethods(as.code)
121+
exportMethods(as.list)
108122
exportMethods(calculate)
123+
exportMethods(chart_build)
109124
exportMethods(chart_names)
110125
exportMethods(chart_plot)
111126
exportMethods(citations)
112127
exportMethods(evaluate)
113128
exportMethods(export_xlsx)
129+
exportMethods(get_preset)
114130
exportMethods(is_output)
115131
exportMethods(is_param)
116132
exportMethods(length)
@@ -121,6 +137,7 @@ exportMethods(model_predict)
121137
exportMethods(model_reverse)
122138
exportMethods(model_train)
123139
exportMethods(models)
140+
exportMethods(names)
124141
exportMethods(ontology)
125142
exportMethods(output_ids)
126143
exportMethods(output_list)
@@ -138,6 +155,7 @@ exportMethods(result)
138155
exportMethods(result_name)
139156
exportMethods(run)
140157
exportMethods(seq_in)
158+
exportMethods(show)
141159
exportMethods(stato_definition)
142160
exportMethods(stato_id)
143161
exportMethods(stato_name)
@@ -146,6 +164,7 @@ exportMethods(value)
146164
import(S4Vectors)
147165
import(SummarizedExperiment)
148166
import(datasets)
167+
import(ggplot2)
149168
import(methods)
150169
importFrom(graphics,plot)
151170
importFrom(knitr,purl)

R/chart_class.R

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,39 @@ setMethod(f = "chart_plot",
4545
}
4646
)
4747

48+
#' Get preset from chart object
49+
#'
50+
#' @param obj A chart object
51+
#' @param preset_name Character string naming the preset to retrieve
52+
#' @param slot_name Character string naming the slot containing a layer_entity
53+
#' @return The preset configuration
54+
#' @export
55+
#' @examples
56+
#' # Get a preset from a chart object
57+
#' C = new_scatter_chart()
58+
#' get_preset(C, 'default', 'points')
59+
#' @rdname get_preset
60+
setMethod(f = "get_preset",
61+
signature = c('chart','character','character'),
62+
definition = function(obj, preset_name, slot_name) {
63+
64+
# Check if the slot exists
65+
if (!slot_name %in% slotNames(obj)) {
66+
stop('Slot "', slot_name, '" does not exist in chart object of class "', class(obj), '"')
67+
}
68+
69+
# Get the slot value
70+
slot_value = slot(obj, slot_name)
71+
72+
# Check if it's a layer_entity
73+
if (!is(slot_value, 'layer_entity')) {
74+
stop('Slot "', slot_name, '" is not a layer_entity. It is a "', class(slot_value), '"')
75+
}
76+
77+
# Get the preset from the layer_entity
78+
return(get_preset(slot_value, preset_name))
79+
}
80+
)
4881

4982
setMethod(f = "show",
5083
signature = c("chart"),

R/generics.R

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -684,3 +684,50 @@ setGeneric("ontology",function(obj,cache=NULL)standardGeneric("ontology"))
684684

685685
#' @importFrom utils .DollarNames
686686
setGeneric('.DollarNames', package='utils')
687+
688+
####################################
689+
###### ggplot chart generics #####
690+
####################################
691+
692+
#' Build a chart
693+
#'
694+
#' @param obj a chart object
695+
#' @param dobj a DatasetExperiment object
696+
#' @return the chart object with built data
697+
#' @export
698+
setGeneric("chart_build", function(obj, dobj) standardGeneric("chart_build"))
699+
700+
#' Get preset from layer entity or chart object
701+
#'
702+
#' @param obj a layer_entity or chart object
703+
#' @param preset_name character string naming the preset (for layer_entity)
704+
#' @param slot_name character string naming the slot containing a layer_entity (for chart)
705+
#' @return the preset configuration
706+
#' @export
707+
setGeneric("get_preset", function(obj, preset_name, slot_name) standardGeneric("get_preset"))
708+
709+
#' Register a preset for a layer entity
710+
#'
711+
#' @param obj a layer_entity object
712+
#' @param preset_name character string naming the preset
713+
#' @param value list containing the preset configuration
714+
#' @param force logical, whether to force overwrite existing preset
715+
#' @return the layer_entity object
716+
#' @export
717+
setGeneric("register_preset<-", function(obj, preset_name, value, force = TRUE) standardGeneric("register_preset<-"))
718+
719+
#' Get available presets for a chart
720+
#'
721+
#' @param obj a chart object
722+
#' @param name character string naming the slot to check
723+
#' @return character vector of available preset names
724+
#' @export
725+
setGeneric("available_presets", function(obj, name) standardGeneric("available_presets"))
726+
727+
#' Convert layer entity to ggplot2 layer
728+
#'
729+
#' @param obj a layer_entity object
730+
#' @param ... additional arguments
731+
#' @return a ggplot2 layer object
732+
#' @export
733+
setGeneric("as_layer", function(obj, ...) standardGeneric("as_layer"))

R/ggplot_chart_class.R

Lines changed: 106 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
#' ggplot Chart objects
2+
#'
3+
#' A base class in the \pkg{struct} package for ggplot2-based charts.
4+
#' ggplot_chart extends the base chart class to provide common functionality
5+
#' for all ggplot2 chart objects.
6+
#'
7+
#' The layers slot can contain any ggplot2 layer including:
8+
#' - Geoms (geom_point, geom_line, etc.)
9+
#' - Stats (stat_ellipse, stat_smooth, etc.)
10+
#' - Scales (scale_color_manual, scale_x_continuous, etc.)
11+
#' - Themes (theme_minimal, theme_bw, etc.)
12+
#' - Facets (facet_wrap, facet_grid, etc.)
13+
#' - Labels (labs, xlab, ylab, etc.)
14+
#'
15+
#' @export
16+
#' @param ... Additional parameters passed to chart constructor
17+
#' @return A ggplot_chart object
18+
#' @examples
19+
#' # Create a ggplot chart (not typically called directly)
20+
#' gc = ggplot_chart()
21+
#' @rdname ggplot_chart
22+
#' @include chart_class.R layer_entity_class.R struct_preset_class.R typed_list_class.R global_preset_registry.R
23+
ggplot_chart = function(...) {
24+
# new object
25+
out = new_struct('ggplot_chart', ...)
26+
return(out)
27+
}
28+
29+
.ggplot_chart<-setClass(
30+
"ggplot_chart",
31+
contains = 'chart',
32+
slots = c(
33+
data = 'data.frame',
34+
layers = 'typed_list',
35+
mapping = 'entity'
36+
),
37+
prototype = list(
38+
name = 'ggplot chart',
39+
description = 'A base class for ggplot2-based charts. Supports all ggplot2 layer types including geoms, stats, scales, themes, facets, and labels.',
40+
type = 'ggplot',
41+
data = data.frame(),
42+
layers = typed_list(.type = 'Layer'),
43+
mapping = entity(
44+
name = 'Plot aesthetics',
45+
description = 'A list of plot aesthetics and their mapping to the data',
46+
value = NULL,
47+
type = c('typed_list.uneval', 'uneval', 'NULL')
48+
)
49+
)
50+
)
51+
52+
#' @rdname ggplot_chart
53+
#' @export
54+
setMethod(f = "chart_build",
55+
signature = c("ggplot_chart", 'DatasetExperiment'),
56+
definition = function(obj, dobj) {
57+
# This is a base method that should be overridden by specific chart types
58+
warning('chart_build method not implemented for "', class(obj), '"')
59+
return(obj)
60+
}
61+
)
62+
63+
#' @rdname ggplot_chart
64+
#' @export
65+
setMethod(f = "chart_plot",
66+
signature = c("ggplot_chart", 'DatasetExperiment'),
67+
definition = function(obj, dobj) {
68+
# Build the chart
69+
obj = chart_build(obj, dobj)
70+
71+
# Create the ggplot object
72+
p = ggplot2::ggplot(data = obj@data, mapping = obj@mapping@value)
73+
74+
# Add all layers (geoms, stats, scales, themes, labels, facets, etc.)
75+
if (length(obj@layers) > 0) {
76+
for (i in seq_along(obj@layers)) {
77+
layer = obj@layers[[i]]
78+
if (!is.null(layer)) {
79+
p = p + layer
80+
}
81+
}
82+
}
83+
84+
return(p)
85+
}
86+
)
87+
88+
#' @rdname ggplot_chart
89+
#' @export
90+
setMethod(f = 'show',
91+
signature = c('ggplot_chart'),
92+
definition = function(object) {
93+
callNextMethod()
94+
cat('data: ', nrow(object@data), ' rows x ', ncol(object@data), ' columns\n', sep = '')
95+
cat('layers: ', length(object@layers), ' layers\n', sep = '')
96+
}
97+
)
98+
99+
# Helper functions for common ggplot operations
100+
xlab = function(label) {
101+
return(ggplot2::xlab(label))
102+
}
103+
104+
ylab = function(label) {
105+
return(ggplot2::ylab(label))
106+
}

0 commit comments

Comments
 (0)