-
Notifications
You must be signed in to change notification settings - Fork 0
/
RcheckLibrary.R
124 lines (98 loc) · 5.22 KB
/
RcheckLibrary.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
######################################################
# R check library
# Coded by: M.Petera,
# - -
# R functions to use in R scripts
# (management of various generic subroutines)
# - -
# V0: script structure + first functions
# V1: More detailed error messages in match functions
######################################################
# Generic function to return an error if problems have been encountered - - - -
check.err <- function(err.stock){
# err.stock = vector of results returned by check functions
if(length(err.stock)!=0){ stop("\n- - - - - - - - -\n",err.stock,"\n- - - - - - - - -\n") }
}
# Table match check functions - - - - - - - - - - - - - - - - - - - - - - - - -
# To check if dataMatrix and (variable or sample)Metadata match regarding identifiers
match2 <- function(dataMatrix, Metadata, Mtype){
# dataMatrix = data.frame containing dataMatrix
# Metadata = data.frame containing sampleMetadata or variableMetadata
# Mtype = "sample" or "variable" depending on Metadata content
err.stock <- NULL # error vector
id2 <- Metadata[,1]
if(Mtype=="sample"){ id1 <- colnames(dataMatrix)[-1] }
if(Mtype=="variable"){ id1 <- dataMatrix[,1] }
if( length(which(id1%in%id2))!=length(id1) || length(which(id2%in%id1))!=length(id2) ){
err.stock <- c("\nData matrix and ",Mtype," metadata do not match regarding ",Mtype," identifiers.")
if(length(which(id1%in%id2))!=length(id1)){
if(length(which(!(id1%in%id2)))<4){ err.stock <- c(err.stock,"\n The ")
}else{ err.stock <- c(err.stock,"\n For example, the ") }
err.stock <- c(err.stock,"following identifiers found in the data matrix\n",
" do not appear in the ",Mtype," metadata file:\n")
identif <- id1[which(!(id1%in%id2))][1:min(3,length(which(!(id1%in%id2))))]
err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n")
}
if(length(which(id2%in%id1))!=length(id2)){
if(length(which(!(id2%in%id1)))<4){ err.stock <- c(err.stock,"\n The ")
}else{ err.stock <- c(err.stock,"\n For example, the ") }
err.stock <- c(err.stock,"following identifiers found in the ",Mtype," metadata file\n",
" do not appear in the data matrix:\n")
identif <- id2[which(!(id2%in%id1))][1:min(3,length(which(!(id2%in%id1))))]
err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n")
}
err.stock <- c(err.stock,"\nPlease check your data.\n")
}
return(err.stock)
}
# To check if the 3 standard tables match regarding identifiers
match3 <- function(dataMatrix, sampleMetadata, variableMetadata){
# dataMatrix = data.frame containing dataMatrix
# sampleMetadata = data.frame containing sampleMetadata
# variableMetadata = data.frame containing variableMetadata
err.stock <- NULL # error vector
id1 <- colnames(dataMatrix)[-1]
id2 <- sampleMetadata[,1]
id3 <- dataMatrix[,1]
id4 <- variableMetadata[,1]
if( length(which(id1%in%id2))!=length(id1) || length(which(id2%in%id1))!=length(id2) ){
err.stock <- c(err.stock,"\nData matrix and sample metadata do not match regarding sample identifiers.")
if(length(which(id1%in%id2))!=length(id1)){
if(length(which(!(id1%in%id2)))<4){ err.stock <- c(err.stock,"\n The ")
}else{ err.stock <- c(err.stock,"\n For example, the ") }
err.stock <- c(err.stock,"following identifiers found in the data matrix\n",
" do not appear in the sample metadata file:\n")
identif <- id1[which(!(id1%in%id2))][1:min(3,length(which(!(id1%in%id2))))]
err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n")
}
if(length(which(id2%in%id1))!=length(id2)){
if(length(which(!(id2%in%id1)))<4){ err.stock <- c(err.stock,"\n The ")
}else{ err.stock <- c(err.stock,"\n For example, the ") }
err.stock <- c(err.stock,"following identifiers found in the sample metadata file\n",
" do not appear in the data matrix:\n")
identif <- id2[which(!(id2%in%id1))][1:min(3,length(which(!(id2%in%id1))))]
err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n")
}
}
if( length(which(id3%in%id4))!=length(id3) || length(which(id4%in%id3))!=length(id4) ){
err.stock <- c(err.stock,"\nData matrix and variable metadata do not match regarding variable identifiers.")
if(length(which(id3%in%id4))!=length(id3)){
if(length(which(!(id3%in%id4)))<4){ err.stock <- c(err.stock,"\n The ")
}else{ err.stock <- c(err.stock,"\n For example, the ") }
err.stock <- c(err.stock,"following identifiers found in the data matrix\n",
" do not appear in the variable metadata file:\n")
identif <- id3[which(!(id3%in%id4))][1:min(3,length(which(!(id3%in%id4))))]
err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n")
}
if(length(which(id4%in%id3))!=length(id4)){
if(length(which(!(id4%in%id3)))<4){ err.stock <- c(err.stock,"\n The ")
}else{ err.stock <- c(err.stock,"\n For example, the ") }
err.stock <- c(err.stock,"following identifiers found in the variable metadata file\n",
" do not appear in the data matrix:\n")
identif <- id4[which(!(id4%in%id3))][1:min(3,length(which(!(id4%in%id3))))]
err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n")
}
}
if(length(err.stock)!=0){ err.stock <- c(err.stock,"\nPlease check your data.\n") }
return(err.stock)
}