A toy package designed to showcase and serve as a reference/tutorial for S7 development. To be used in conjunction with the S7 package webs
Added returns to lines as Dr T suggested
+80
-18
+80
-18
README.md
+80
-18
README.md
···
68
68
library(S7)
69
69
70
70
Shape <- new_class("Shape", abstract = TRUE)
71
-
Circle <- new_class("Circle", Shape, properties = list(radius = class_numeric))
72
-
Rect <- new_class("Rect", Shape, properties = list(width = class_numeric, height = class_numeric))
71
+
Circle <- new_class("Circle",
72
+
Shape,
73
+
properties = list(
74
+
radius = class_numeric
75
+
)
76
+
)
77
+
Rect <- new_class("Rect",
78
+
Shape,
79
+
properties = list(
80
+
width = class_numeric,
81
+
height = class_numeric
82
+
)
83
+
)
73
84
74
85
Area <- new_generic("Area", "x")
75
86
method(Area, Circle) <- \(x) pi * x@radius^2
···
87
98
It can easily be extended to admit a `Square` class:
88
99
89
100
```{r}
90
-
Square <- new_class("Square", Rect, constructor = function(side) new_object(S7_object(), width = side, height = side))
101
+
Square <- new_class("Square",
102
+
Rect,
103
+
constructor = function(side) {
104
+
new_object(S7_object(), width = side, height = side)
105
+
}
106
+
)
91
107
square <- Square(5)
92
108
93
109
Area(square)
···
96
112
And, more usefully, our classes can be (minimally) changed to guarantee that the provided values are positive–being numeric is already ensured by using `class_numeric`, even in the original definitions.
97
113
98
114
```{r}
99
-
positive_numeric <- new_property(class_numeric, validator = function(value) if(value <= 0) "must be greater than 0")
115
+
positive_numeric <- new_property(class_numeric,
116
+
validator = function(value) {
117
+
if (value <= 0) "must be greater than 0"
118
+
}
119
+
)
100
120
101
-
Circle <- new_class("Circle", Shape, properties = list(radius = positive_numeric))
102
-
Rect <- new_class("Rect", Shape, properties = list(width = positive_numeric, height = positive_numeric))
121
+
Circle <- new_class("Circle",
122
+
Shape,
123
+
properties = list(
124
+
radius = positive_numeric
125
+
)
126
+
)
127
+
Rect <- new_class("Rect",
128
+
Shape,
129
+
properties = list
130
+
(
131
+
width = positive_numeric,
132
+
height = positive_numeric
133
+
)
134
+
)
103
135
104
136
Rect(0, 4)
105
137
#> ! <Rect> object properties are invalid:
···
119
151
We could also compute area in a property instead of a method:
120
152
121
153
```{r}
122
-
positive_numeric <- new_property(class_numeric, validator = function(value) if (value <= 0) "must be greater than 0")
154
+
positive_numeric <- new_property(class_numeric,
155
+
validator = function(value) {
156
+
if (value <= 0) "must be greater than 0"
157
+
}
158
+
)
123
159
124
160
Shape <- new_class("Shape", abstract = TRUE)
125
161
Circle <- new_class(
126
162
"Circle",
127
163
Shape,
128
-
properties = list(radius = positive_numeric, area = new_property(class_numeric, getter = function(self) pi * self@radius^2, setter = NULL)),
129
-
constructor = function(radius) new_object(S7_object(), radius = radius)
164
+
properties = list(
165
+
radius = positive_numeric,
166
+
area = new_property(class_numeric, getter = function(self) pi * self@radius^2, setter = NULL)
167
+
),
168
+
constructor = function(radius) {
169
+
new_object(S7_object(), radius = radius)
170
+
}
130
171
)
131
172
Rect <- new_class(
132
173
"Rect",
133
174
Shape,
134
-
properties = list(width = positive_numeric, height = positive_numeric, area = new_property(class_numeric, getter = function(self) self@width * self@height, setter = NULL)),
135
-
constructor = function(width, height) new_object(S7_object(), width = width, height = height)
175
+
properties = list(
176
+
width = positive_numeric,
177
+
height = positive_numeric,
178
+
area = new_property(class_numeric, getter = function(self) self@width * self@height, setter = NULL)
179
+
),
180
+
constructor = function(width, height) {
181
+
new_object(S7_object(), width = width, height = height)
182
+
}
183
+
)
184
+
Square <- new_class("Square",
185
+
Rect,
186
+
constructor = function(side) {
187
+
new_object(S7_object(), width = side, height = side)
188
+
}
136
189
)
137
-
Square <- new_class("Square", Rect, constructor = function(side) new_object(S7_object(), width = side, height = side))
138
-
139
190
circ <- Circle(10)
140
191
circ
141
192
#> <Circle>
···
168
219
169
220
```{r}
170
221
# https://rconsortium.github.io/S7/articles/classes-objects.html#frozen-properties
171
-
eg <- new_class("eg", properties = list(VALUE = new_property(class_any, setter = function(self, value){
172
-
if(!is.null(self@VALUE)) stop("@VALUE is read only.")
173
-
self@VALUE <- value
174
-
self
175
-
})))
222
+
eg <- new_class("eg",
223
+
properties = list(
224
+
VALUE = new_property(
225
+
class_any,
226
+
setter = function(self, value) {
227
+
if (!is.null(self@VALUE)) stop("@VALUE is read only.")
228
+
self@VALUE <- value
229
+
self
230
+
}
231
+
)
232
+
)
233
+
)
176
234
177
235
tmp <- eg(10)
178
236
tmp
···
221
279
So why BigNum specifically? Well, mostly because it's easy to implement. The BigNum project is taken from my CSC 203 class, a OOP course at Cal Poly. I already had all the methods implemented (in Java) and a clear idea of what I needed to do and how, with the main work being in porting design to R as opposed to novel thought. This greatly simplified dev time since I had a reference implementation to use. **Importantly,** **this (along with my lack of experience) could lead to unidiomatic R/S7 code and design patterns.** **If you notice anything strange, please open an issue/PR!**
222
280
223
281
I haven't developed an R package before, and so that provided additional motivation for me to create this project. That also means that this package is certainly written sub-optimally. Additionally, my experience with S7 is extremely limited–I would be extremely grateful for any and all R sourcerers who can rain issues and pull requests down from the heavens fixing all my mistakes :)
282
+
283
+
## Acknowledgements
284
+
285
+
Thank you Dr T and Dr Bodwin for helping with this project!
224
286
225
287
## References
226
288