Skip to content

Commit ebaaf33

Browse files
grlloydgrlloyd
committed
add tests
- new tests for ontology - updated tests for citations, libraries, .dollarNames, iterators - added stato tests back until officially removed, as classes still exist in package
1 parent bef6505 commit ebaaf33

13 files changed

+255
-27
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ Description: Defines and includes a set of class-based templates for developing
2121
common standardised structure to allow for effective and fast integration.
2222
Model objects can be combined into sequences, and sequences nested in
2323
iterators using overloaded operators to simplify and improve readability of
24-
the code. STATistics Ontology (STATO) has been integrated and implemented
24+
the code. Ontology lookup has been integrated and implemented
2525
to provide standardised definitions for methods, inputs and outputs wrapped
2626
using the class-based templates.
2727
License: GPL-3

‎R/model_class.R‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -267,6 +267,10 @@ setMethod(f = 'as.code',
267267
# add predicted if its not the default
268268
if (is(M,'model')) {
269269
N=new_struct(class(M)[1])
270+
if (length(predicted_name(N))==0) {
271+
N@predicted='cake'
272+
}
273+
270274
if (predicted_name(N) != predicted_name(M) | mode=='full') {
271275
P=c(P,'predicted')
272276
}

‎R/ontology_term_class.R‎

Lines changed: 0 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -119,23 +119,6 @@ setMethod(f = 'show',
119119
)
120120

121121

122-
.as_ontology_term = function(obj) {
123-
124-
if (!is(obj,'Term')) {
125-
stop('Input object must be a rols::Term object')
126-
}
127-
128-
OT = ontology_term(
129-
ontology=rols::termOntology(obj),
130-
id=rols::termId(obj),
131-
label=rols::termLabel(obj),
132-
description=rols::termDesc(obj),
133-
iri=obj@iri
134-
)
135-
return(OT)
136-
}
137-
138-
139122
setAs("ontology_term", "data.frame",
140123
function(from)
141124
data.frame(

‎R/optimiser_class.R‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -25,9 +25,6 @@ optimiser = function(...) {
2525
)
2626
)
2727

28-
setClassUnion("model_OR_optimiser", c("model", "optimiser"))
29-
30-
3128
setMethod(f = "show",
3229
signature = c("optimiser"),
3330
definition = function(object) {

‎R/stato_class.R‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ stato = function(stato_id) {
5757
setMethod(f = "stato_id",
5858
signature = c('stato'),
5959
definition = function(obj) {
60+
warning('stato objects are deprecated as of version 1.5.1 please see "?struct::ontology" for details.')
6061
if (!exists('ont',envir = statoOntology)) {
6162
# load the ontology if it hasn't been done already
6263
.stato_env()
@@ -70,6 +71,7 @@ setMethod(f = "stato_id",
7071
setMethod(f = "stato_name",
7172
signature = c('stato'),
7273
definition = function(obj) {
74+
warning('stato objects are deprecated as of version 1.5.1 please see "?struct::ontology" for details.')
7375
# get the stato id
7476
id = stato_id(obj)
7577
# get the name from the stato database
@@ -83,6 +85,7 @@ setMethod(f = "stato_name",
8385
setMethod(f = "stato_definition",
8486
signature = c('stato'),
8587
definition = function(obj) {
88+
warning('stato objects are deprecated as of version 1.5.1 please see "?struct::ontology" for details.')
8689
# get the id for the object
8790
id = stato_id(obj)
8891
# get the definition and clean any special chars
@@ -110,6 +113,7 @@ statoOntology = new.env()
110113
setMethod(f = "stato_summary",
111114
signature = c('stato'),
112115
definition = function(obj) {
116+
warning('stato objects are deprecated as of version 1.5.1 please see "?struct::ontology" for details.')
113117
cat(stato_id(obj),'\n')
114118
cat(stato_name(obj),'\n')
115119
cat(stato_definition(obj),'\n')
@@ -146,6 +150,7 @@ setMethod(f = "stato_summary",
146150
setMethod(f = 'show',
147151
signature = c('stato'),
148152
definition = function(object) {
153+
warning('stato objects are deprecated as of version 1.5.1 please see "?struct::ontology" for details.')
149154
# add extra info
150155
cat('Stato ID: ',stato_id(object),sep='')
151156
cat('\n')

‎R/struct_class.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,7 @@ struct_class = function(
7878

7979
# check all citations are Bibtex
8080
if (length(citations>0)) {
81-
ok=lapply(citations,is,class='bibentry')
81+
ok=unlist(lapply(citations,is,class='bibentry'))
8282
if (!(all(ok))){
8383
stop('all citations must be in "bibentry" format')
8484
}

‎tests/testthat/test-base.R‎

Lines changed: 70 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,80 @@
11
# test struct object
22
test_that('struct objects can be created and modified',{
33
# a test object
4-
test_object=struct_class(name = 'test_name', description='test_desc','type' = 'test_type')
5-
4+
test_object=struct_class(
5+
name = 'test_name',
6+
description=c(
7+
'A'='test_desc_A',
8+
'B'='test_desc_B'),
9+
type = 'test_type',
10+
citations= bibentry(
11+
bibtype ='Article',
12+
year = 2009,
13+
volume = 95,
14+
number = 2,
15+
pages = '122-128',
16+
author = as.person("Nestor F. Perez and Joan Ferre and Ricard Boque"),
17+
title = paste0('Calculation of the reliability of ',
18+
'classification in discriminant partial least-squares ',
19+
'binary classification'),
20+
journal = "Chemometrics and Intelligent Laboratory Systems"
21+
),
22+
ontology='STATO:0000572'
23+
24+
)
25+
626
# name
727
expect_equal({test_object$name},'test_name') # get
828
expect_equal({test_object$name='cabbage';test_object$name},'cabbage') # set
929
#type
1030
expect_equal({test_object$type},'test_type') # get
1131
expect_equal({test_object$type='cabbage';test_object$type},'cabbage') #set
1232
# description
13-
expect_equal({test_object$description},"test_desc") #get
33+
expect_equal({test_object$description},c(
34+
'A'='test_desc_A',
35+
'B'='test_desc_B')) #get
36+
expect_output(show(test_object),'A "struct_class" object')
1437
expect_equal({test_object$description='cabbage';test_object$description},'cabbage') #set
1538
# show
16-
expect_output(show(test_object),'A "struct_class" object\\n-----------------------\\nname: cabbage\\ndescription: cabbage')
39+
expect_output(show(test_object),'A "struct_class" object')
40+
41+
expect_error({
42+
test_object=struct_class(name = 'test_name', description='test_desc','type' = 'test_type',
43+
citations= list(bibentry(
44+
bibtype ='Article',
45+
year = 2009,
46+
volume = 95,
47+
number = 2,
48+
pages = '122-128',
49+
author = as.person("Nestor F. Perez and Joan Ferre and Ricard Boque"),
50+
title = paste0('Calculation of the reliability of ',
51+
'classification in discriminant partial least-squares ',
52+
'binary classification'),
53+
journal = "Chemometrics and Intelligent Laboratory Systems"
54+
),
55+
'cake'
56+
57+
))
58+
})
59+
60+
cit=citations(test_object)
61+
expect_true(length(cit)==2)
62+
lib=libraries(test_object)
63+
expect_true(length(lib)==0)
64+
ont=ontology(test_object,cache = list(
65+
'STATO:0000572'=ontology_term(
66+
id='STATO:0000572',
67+
ontology = 'stato',
68+
label = 'test_ontology',
69+
description = 'test_ontology',
70+
iri = 'test_ontology',
71+
rols=FALSE
72+
)
73+
)
74+
)
75+
expect_true(length(ont)==1)
76+
77+
1778
})
1879

1980
# test metric object
@@ -29,16 +90,20 @@ test_that('entity object',{
2990
E=entity(type='numeric',value=0,name='test_enti')
3091
value(E)=1
3192
expect_equal(value(E),1)
93+
max_length(E)=1
94+
expect_output(show(E),regexp = 'A "entity" object')
3295
})
3396

3497
# test enum
3598
test_that('enum object',{
3699
E=enum(allowed=c('hello','world'),value='hello',type='character',name='test_entity')
37-
# check object creation
100+
# check object creationS
38101
expect_equal(value(E),'hello')
39102
# check throws error if value not in list
40103
expect_error({value(E)='banana'},'not a valid choice for this enum')
41104
# check assign value
42105
value(E)='world'
43106
expect_equal(value(E),'world')
107+
expect_output(show(E),regexp = 'A "enum" object')
44108
})
109+

‎tests/testthat/test-charts.R‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,12 @@
11
# test charts
22

33
test_that('charts',{
4+
5+
6+
C=example_chart()
7+
chart_plot(C,example_model())
8+
expect_output(show(C),regexp = 'A "example_chart" object')
9+
410
C=chart()
511
# warning if no chart defined
612
expect_warning(chart_plot(C,example_iterator()))
@@ -27,4 +33,6 @@ test_that('charts',{
2733

2834
expect_equal(chart_names(DatasetExperiment(),'char'),'test_chart')
2935
#expect_equal(chart_names(DatasetExperiment(),'obj'),list(test_chart()))
36+
37+
expect_true("name" %in% .DollarNames.chart(C))
3038
})

‎tests/testthat/test-dataset.R‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,4 +18,41 @@ test_that('DatasetExperiment objects',{
1818

1919
# check show
2020
expect_output(show(test_data),'A "DatasetExperiment" object')
21+
22+
SE=as.SummarizedExperiment(iris_DatasetExperiment())
23+
expect_true(is(SE,'SummarizedExperiment'))
24+
25+
DE=as.DatasetExperiment(SE)
26+
expect_true(is(DE,'DatasetExperiment'))
27+
28+
expect_true("name" %in% .DollarNames.struct_class(DE))
29+
30+
df=as.data.frame(matrix(rnorm(20*3),nrow=20))
31+
sm=as.data.frame(matrix(rnorm(20*3),nrow=20))
32+
vm=as.data.frame(matrix(rnorm(3*3),nrow=3))
33+
DE=DatasetExperiment(data=df,sample_meta=sm,variable_meta=vm)
34+
35+
# excel files
36+
dirT <- tempdir()
37+
export_xlsx(DE,file.path(dirT,'test.xlsx'),transpose=FALSE)
38+
export_xlsx(DE,file.path(dirT,'test2.xlsx'),transpose=TRUE)
39+
40+
# check the output file has the expect sheets
41+
sn=openxlsx::getSheetNames(file.path(dirT,'test.xlsx'))
42+
expect_equal(sn,c('data','sample_meta','variable_meta'))
43+
44+
# check dims aftr reading back in
45+
DF=openxlsx::read.xlsx(file.path(dirT,'test.xlsx'),rowNames=TRUE,colNames=TRUE,sheet = 'data')
46+
DF2=openxlsx::read.xlsx(file.path(dirT,'test2.xlsx'),rowNames=TRUE,colNames=TRUE,sheet = 'data')
47+
SM=openxlsx::read.xlsx(file.path(dirT,'test.xlsx'),rowNames=TRUE,colNames=TRUE,sheet='sample_meta')
48+
VM=openxlsx::read.xlsx(file.path(dirT,'test.xlsx'),rowNames=TRUE,colNames=TRUE,sheet='variable_meta')
49+
50+
expect_equal(dim(DF),dim(df))
51+
expect_equal(dim(DF2),dim(t(df)))
52+
expect_equal(dim(SM),dim(sm))
53+
expect_equal(dim(VM),dim(vm))
54+
55+
# clean up temp files
56+
files <- dir(path=dirT, pattern="test*")
57+
unlink(x=files)
2158
})

‎tests/testthat/test-iterators.R‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -58,4 +58,29 @@ test_that('iterator objects',{
5858

5959
# check we get an error if incorrectly combined
6060
expect_error(model()*IM)
61+
62+
O=optimiser(result='name')
63+
expect_true(is(O,'optimiser'))
64+
65+
R=resampler(result='name')
66+
expect_true(is(R,'resampler'))
67+
68+
P=preprocess(predicted='name')
69+
expect_true(is(P,'preprocess'))
70+
71+
expect_output(show(R),regexp = 'A "resampler" object')
72+
expect_output(cat(as.code(R*example_model(),mode='compact')),regexp='M = resampler')
73+
expect_output(cat(as.code(R*(example_model()+example_model()),mode='compact')),regexp='M = resampler')
74+
expect_output(cat(as.code(R*(example_model()+example_model()),mode='expanded')),regexp='M = resampler')
75+
76+
expect_output(show(O),regexp = 'A "optimiser" object')
77+
expect_output(cat(as.code(O*example_model())),regexp='M = optimiser')
78+
79+
expect_output(show(P),regexp = 'A "preprocess" object')
80+
expect_output(cat(as.code(P),regexp='M = preprocess'))
81+
82+
expect_true("name" %in% .DollarNames.iterator(I))
83+
expect_true("name" %in% .DollarNames.optimiser(O))
84+
expect_true("name" %in% .DollarNames.resampler(R))
85+
expect_true("name" %in% .DollarNames.preprocess(P))
6186
})

0 commit comments

Comments
 (0)