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