r reference

pure OO approach and a functional representation of it are at loggerheads. That is evident when one tries to adopt an OO approach using a powerful functional language. That is my personal opinion.

R has many Object-oriented features built into it.

R has three object oriented (OO) systems: [[S3]], [[S4]] and [[R5]].

Reference classes are one such feature.

Let us consider this data. The id is that of a Subject who is in
a room where monitoring equipment gathers some data. There are several visits to gather this data.

id	visit	room	value	timepoint
14	0	bedroom	6	53
14	0	bedroom	6	54
15	0	bedroom	2.75	56

The idea that this code is based on is from Martin Fowler’s book Analysis Patterns Reusable Object Models. The chapter on Observations and Measurements has a diagram roughly equivalent to the
one shown at the top.

The code is lightly tested several times but without unit tests.

library(plyr)
library(dplyr)
library(purrr)

CompoundUnit <- setRefClass("CompoundUnit",
fields = list(micrograms = 'numeric',
cubicmeter = 'numeric'))

Location <- setRefClass("Location",
fields = list( room = 'character'),
methods=list(getlocation = function(){
room
},
summary = function(){
paste('Room [' , room , ']')
}))

library(objectProperties)
# An Enum which could have behaviour associated with it.
# This is convoluted but the only way I know to represent constants and validate them.
#

MeasurementVisitEnum.gen <- setSingleEnum("MeasurementVisit",levels = c('0', '1', '2'))
par.gen <- setRefClass("Visit",
properties(fields = list(visit = "MeasurementVisitSingleEnum"),
prototype = list(visit =
new("MeasurementVisitSingleEnum",
'0'))))
What is the significance of this convoluted code ?
It restricts the values that are set to 0.1 and 2. It is like the Java enum
But this is not strictly a requirement here. It is just that there is a facility to identify erroneous data if we need it.
> MeasurementVisitEnum.gen par.gen visits visits$visit visits$visit visits$visit visits$visit <- as.character(3)
Error in (function (val) :
Attempt to set invalid value on 'visit': value '3' does not belong to level set
( 0, 1, 2 )



TimePoint <- setRefClass("TimePoint",
fields = list(time = 'numeric'))

Quantity <- setRefClass("Quantity",
fields = list(amount = "numeric",
units = CompoundUnit))
Measurement encapsulates the quantity, the time point and the visit number. So, for example, during visit 0, at this time point the quantity was observed. This type of encapsulation in the true spirit of OO has its
disadvantages as we will see later.
Measurement <- setRefClass("Measurement",
fields = list(
quantity = "Quantity",
timepoint = "TimePoint",
visit = "Visit"),
methods=list(getvisit = function(){
visit$visit
},getquantity = function(){
quantity
})
)

Subject <- setRefClass("Subject",
fields = list( id = "numeric",
measurement = "Measurement",
location = "Location"),
methods=list(getmeasurement = function()
{
measurement
},
getid = function()
{
id
},
getlocation = function()
{
location
},
summary = function()#Implement other summary methods in appropriate objects as per their responsibilities
{
paste("Subject summary ID [",id,"] Location [",location$summary(),"]")
},show = function(){
cat("Subject summary ID [",id,"] Location [",location$summary(),"]\n")
})
)
LongitudinalDatum is the class LongitudinalData inherits from. This inheritance is shown as an example. Not all methods that should belong in the super class are properly added. There are many methods in the sub class that can be moved a level up.
subsummary in the super class can be called from the sub class. The line if( subject(x) == id){ in the sub class LongitudinalData calls this super class method.
LongitudinalDatum  datum

measurements <<- list()
load(datum)

},load = function( df ){
by(df, 1:nrow(df), function(row) {
visits <- par.gen$new()
visits$visit <- as.character(row$visit)

u <- CompoundUnit$new( micrograms = 1,
cubicmeter = 1 )

q <- Quantity$new(amount = row$value,
units = u )

t <- TimePoint$new(time = row$timepoint)

m <- Measurement$new(
quantity = q,
timepoint = t,
visit = visits)

l <- Location$new( room = as.character(row$room))

s <- Subject$new( id = row$id,
measurement = m,
location = l)
measurements <<- c( measurements, s )

})

},
getmeasurementslength = function(){
length(measurements)
},
findsubject = function( id ){
result % map(., function(x) {
if( subject(x) == id){
result <<- x # Warning message is benign for this example. result
#cannot be a class state. It is really local.
}
}
)
result

},
visit = function( sub,v ){
measurementsvisit % map(., function(x) {
m <- x$getmeasurement()
if (m$getvisit() == v && x$getid() == sub$getid() ){
measurementsvisit <<- c(measurementsvisit,x)
}
}

)

list(visit = measurementsvisit )
}
},
room = function( t, room ){
if( length( t) == 0 ){
c('NA')
}else{
measurementsvisitroom % map(., function(x) {
if( x$getlocation()$getlocation() == room )
measurementsvisitroom <% map(., function(y) {
if (x$getid() == y$getid() ){
m <<- x$getmeasurement()
summaries <% summary
}
},subjectsummary = function( subject ){
filteredmeasurements <-
keep(measurements, function(x){
x$getid() == subject$getid()
})
groupedmeasurements % lapply(function(x){
m <% rbind_all()
dataColumns <- c('amount')

ddply(groupedmeasurements,c('visit','location'),function(x)
colSums(x[dataColumns]))
}

)
)