EricMarcon / dbmss
Showing 1 of 3 files from the diff.
Other files ignored by Codecov
NEWS.md has changed.
DESCRIPTION has changed.

@@ -14,19 +14,28 @@
Loading
14 14
    return (TRUE)
15 15
  }
16 16
  
17 -
  ErrorFunction <- paste("Error in ", ParentFunction, ":")
18 -
  
19 -
  # Find the arguments. match.fun does not work with entropart::function
20 -
  ParentFunctionNoNS <- as.name(gsub("dbmss::", "", as.character(ParentFunction)))
17 +
  # Find the arguments. match.fun does not work with dbmss::function
18 +
  # as.character creates a vector. The name of the function is the last item
19 +
  ParentFunction_split <- as.character(ParentFunction)
20 +
  ParentFunctionNoNS <- ParentFunction_split[length(ParentFunction_split)]
21 21
  Args <- formals(match.fun(ParentFunctionNoNS))
22 22
  
23 +
  ErrorFunction <- paste("Error in ", ParentFunctionNoNS, ":")
24 +
  
25 +
  ErrorMessage <- function(Message, Argument) {
26 +
    cat(deparse(substitute(Argument)), "cannot be:\n")
27 +
    print(utils::head(Argument))
28 +
    cat(paste(ErrorFunction, Message, "\n"))
29 +
    stop("Check the function arguments.", call. = FALSE)
30 +
  }
31 +
  
32 +
23 33
  # Get the point pattern or the Dtable
24 34
  X <- eval(expression(X), parent.frame())
25 -
  
26 35
  # X 
27 36
  if (!is.na(names(Args["X"]))) {
28 37
    if (!(inherits(X, "wmppp") | (inherits(X, "Dtable"))))
29 -
      stop(paste(ErrorFunction, "X must be of class wmppp or Dtable"))    
38 +
      ErrorMessage("X must be of class wmppp or Dtable", X)
30 39
  }
31 40
32 41
  # r
@@ -34,13 +43,13 @@
Loading
34 43
    r <- eval(expression(r), parent.frame())
35 44
    if (!is.null(r)) {
36 45
      if (!is.numeric(r) && !is.vector(r)) 
37 -
        stop(paste(ErrorFunction, "r must be a numeric vector"))
46 +
        ErrorMessage("r must be a numeric vector", r)
38 47
      if (length(r) < 2) 
39 -
        stop(paste(ErrorFunction, "r has length", length(r), "- must be at least 2"))
48 +
        ErrorMessage(paste("r has length", length(r), "- must be at least 2"), r)
40 49
      if (r[1] != 0) 
41 -
        stop(paste(ErrorFunction, "First r value must be 0"))
50 +
        ErrorMessage("First r value must be 0", r)
42 51
      if (any(diff(r) <= 0)) 
43 -
        stop(paste(ErrorFunction, "successive values of r must be increasing"))  
52 +
        ErrorMessage("successive values of r must be increasing", r)  
44 53
    }
45 54
  }
46 55
    
@@ -48,26 +57,26 @@
Loading
48 57
  if (!is.na(names(Args["ReferenceType"]))) {
49 58
    ReferenceType <- eval(expression(ReferenceType), parent.frame())
50 59
    if (ReferenceType!="" & !ReferenceType %in% X$marks$PointType)
51 -
      stop(paste(ErrorFunction, "ReferenceType must be a point type of the point pattern, it cannot be", sQuote(ReferenceType)))    
60 +
      ErrorMessage("ReferenceType must be a point type of the point pattern", ReferenceType)
52 61
  }
53 62
  # NeighborType 
54 63
  if (!is.na(names(Args["NeighborType"]))) {
55 64
    NeighborType <- eval(expression(NeighborType), parent.frame())
56 65
    if (NeighborType!="" & !NeighborType %in% X$marks$PointType)
57 -
      stop(paste(ErrorFunction, "NeighborType must be a point type of the point pattern, it cannot be", sQuote(NeighborType)))    
66 +
      ErrorMessage("NeighborType must be a point type of the point pattern", NeighborType)
58 67
  }
59 68
  # Cases 
60 69
  if (!is.na(names(Args["Cases"]))) {
61 70
    Cases <- eval(expression(Cases), parent.frame())
62 71
    if (!Cases %in% X$marks$PointType)
63 -
      stop(paste(ErrorFunction, "Cases must be a point type of the point pattern, it cannot be", sQuote(Cases)))    
72 +
      ErrorMessage("Cases must be a point type of the point pattern", Cases)
64 73
  }
65 74
  # Controls 
66 75
  if (!is.na(names(Args["Controls"]))) {
67 76
    Controls <- eval(expression(Controls), parent.frame())
68 77
    if (!is.null(Controls)) {
69 78
      if (!(Controls %in% X$marks$PointType))
70 -
        stop(paste(ErrorFunction, "Controls must be a point type of the point pattern, it cannot be", sQuote(Controls)))
79 +
        ErrorMessage("Controls must be a point type of the point pattern", Controls)
71 80
    }
72 81
  }
73 82
  
@@ -75,25 +84,25 @@
Loading
75 84
  if (!is.na(names(Args["CaseControl"]))) {
76 85
    CaseControl <- eval(expression(CaseControl), parent.frame())
77 86
    if (!is.logical(CaseControl))
78 -
      stop(paste(ErrorFunction, "CaseControl must be TRUE or FALSE, it cannot be", sQuote(CaseControl)))    
87 +
      ErrorMessage("CaseControl must be TRUE or FALSE", CaseControl)
79 88
  }
80 89
  # Intertype 
81 90
  if (!is.na(names(Args["Intertype"]))) {
82 91
    Intertype <- eval(expression(Intertype), parent.frame())
83 92
    if (!is.logical(Intertype))
84 -
      stop(paste(ErrorFunction, "Intertype must be TRUE or FALSE, it cannot be", sQuote(Intertype)))    
93 +
      ErrorMessage("Intertype must be TRUE or FALSE", Intertype)
85 94
  }
86 95
  # Weighted 
87 96
  if (!is.na(names(Args["Weighted"]))) {
88 97
    Weighted <- eval(expression(Weighted), parent.frame())
89 98
    if (!is.logical(Weighted))
90 -
      stop(paste(ErrorFunction, "Weighted must be TRUE or FALSE, it cannot be", sQuote(Weighted)))    
99 +
      ErrorMessage("Weighted must be TRUE or FALSE", Weighted)
91 100
  }
92 101
  # Original 
93 102
  if (!is.na(names(Args["Original"]))) {
94 103
    Original <- eval(expression(Original), parent.frame())
95 104
    if (!is.logical(Original))
96 -
      stop(paste(ErrorFunction, "Original must be TRUE or FALSE, it cannot be", sQuote(Original)))    
105 +
      ErrorMessage("Original must be TRUE or FALSE", Original)
97 106
  }
98 107
99 108
  # lambda
@@ -101,7 +110,7 @@
Loading
101 110
    lambda <- eval(expression(lambda), parent.frame())
102 111
    if (!is.null(lambda)) {
103 112
      if (!inherits(lambda, "im") & !is.numeric(lambda))
104 -
        stop(paste(ErrorFunction, "lambda must be an image of class im or a numeric vector, it cannot be", sQuote(lambda)))
113 +
        ErrorMessage("lambda must be an image of class im or a numeric vector", lambda)
105 114
    }
106 115
  }
107 116
  
@@ -109,77 +118,77 @@
Loading
109 118
  if (!is.na(names(Args["NumberOfSimulations"]))) {
110 119
    NumberOfSimulations <- eval(expression(NumberOfSimulations), parent.frame())
111 120
    if (!is.numeric(NumberOfSimulations))
112 -
      stop(paste(ErrorFunction, "NumberOfSimulations must be a number, it cannot be", sQuote(NumberOfSimulations)))    
121 +
      ErrorMessage("NumberOfSimulations must be a number", NumberOfSimulations)
113 122
    if (NumberOfSimulations <= 0)
114 -
      stop(paste(ErrorFunction, "NumberOfSimulations must be positive, it cannot be", sQuote(NumberOfSimulations)))    
123 +
      ErrorMessage("NumberOfSimulations must be positive", NumberOfSimulations)
115 124
  }
116 125
  
117 126
  # Alpha 
118 127
  if (!is.na(names(Args["Alpha"]))) {
119 128
    Alpha <- eval(expression(Alpha), parent.frame())
120 129
    if (!is.numeric(Alpha))
121 -
      stop(paste(ErrorFunction, "Alpha must be a number, it cannot be", sQuote(Alpha)))    
130 +
      ErrorMessage("Alpha must be a number", Alpha)
122 131
    if (Alpha < 0)
123 -
      stop(paste(ErrorFunction, "Alpha must be positive, it cannot be", sQuote(Alpha)))    
132 +
      ErrorMessage("Alpha must be positive", Alpha)   
124 133
  }
125 134
  
126 135
  # alpha 
127 136
  if (!is.na(names(Args["alpha"]))) {
128 137
    alpha <- eval(expression(alpha), parent.frame())
129 138
    if (!is.numeric(alpha))
130 -
      stop(paste(ErrorFunction, "alpha must be a number, it cannot be", sQuote(alpha)))    
139 +
      ErrorMessage("alpha must be a number", alpha)
131 140
    if (alpha < 0)
132 -
      stop(paste(ErrorFunction, "alpha must be positive, it cannot be", sQuote(alpha)))    
141 +
      ErrorMessage("alpha must be positive", alpha)
133 142
    if (alpha > 1)
134 -
      stop(paste(ErrorFunction, "alpha must be less than or equal to 1, it cannot be", sQuote(alpha)))    
143 +
      ErrorMessage("alpha must be less than or equal to 1", alpha)
135 144
  }
136 145
  
137 146
  # Adjust 
138 147
  if (!is.na(names(Args["Adjust"]))) {
139 148
    Adjust <- eval(expression(Adjust), parent.frame())
140 149
    if (!is.numeric(Adjust))
141 -
      stop(paste(ErrorFunction, "Adjust must be a number, it cannot be", sQuote(Adjust)))    
150 +
      ErrorMessage("Adjust must be a number", Adjust)
142 151
    if (Adjust<=0)
143 -
      stop(paste(ErrorFunction, "Adjust must be strictly positive, it cannot be", sQuote(Adjust)))    
152 +
      ErrorMessage("Adjust must be strictly positive", Adjust)
144 153
  }
145 154
  
146 155
  # Approximate 
147 156
  if (!is.na(names(Args["Approximate"]))) {
148 157
    Approximate <- eval(expression(Approximate), parent.frame())
149 158
    if (!is.numeric(Approximate))
150 -
      stop(paste(ErrorFunction, "Approximate must be a number, it cannot be", sQuote(Approximate)))    
159 +
      ErrorMessage("Approximate must be a number", Approximate)
151 160
    if (Approximate < 0)
152 -
      stop(paste(ErrorFunction, "Approximate must be positive, it cannot be", sQuote(Approximate)))    
161 +
      ErrorMessage("Approximate must be positive", Approximate)
153 162
  }
154 163
155 164
  # StartFromMinR 
156 165
  if (!is.na(names(Args["StartFromMinR"]))) {
157 166
    StartFromMinR <- eval(expression(StartFromMinR), parent.frame())
158 167
    if (!is.logical(StartFromMinR))
159 -
      stop(paste(ErrorFunction, "StartFromMinR must be TRUE or FALSE, it cannot be", sQuote(StartFromMinR)))    
168 +
      ErrorMessage("StartFromMinR must be TRUE or FALSE", StartFromMinR)
160 169
  }
161 170
  
162 171
  # Individual 
163 172
  if (!is.na(names(Args["Individual"]))) {
164 173
    Individual <- eval(expression(Individual), parent.frame())
165 174
    if (!is.logical(Individual))
166 -
      stop(paste(ErrorFunction, "Individual must be TRUE or FALSE, it cannot be", sQuote(Individual)))    
175 +
      ErrorMessage("Individual must be TRUE or FALSE", Individual)
167 176
  }
168 177
  
169 178
  # Precision 
170 179
  if (!is.na(names(Args["Precision"]))) {
171 180
    Precision <- eval(expression(Precision), parent.frame())
172 181
    if (!is.numeric(Precision))
173 -
      stop(paste(ErrorFunction, "Precision must be a number, it cannot be", sQuote(Precision)))    
182 +
      ErrorMessage("Precision must be a number", Precision)
174 183
    if (Precision < 0)
175 -
      stop(paste(ErrorFunction, "Precision must be positive, it cannot be", sQuote(Precision)))    
184 +
      ErrorMessage("Precision must be positive", Precision)
176 185
  }
177 186
178 187
  # show.window 
179 188
  if (!is.na(names(Args["show.window"]))) {
180 189
    show.window <- eval(expression(show.window), parent.frame())
181 190
    if (!is.logical(show.window))
182 -
      stop(paste(ErrorFunction, "show.window must be TRUE or FALSE, it cannot be", sQuote(show.window)))    
191 +
      ErrorMessage("show.window must be TRUE or FALSE", show.window)
183 192
  }
184 193
  
185 194
  return (TRUE)
Files Coverage
R 81.59%
src/CountNbd.cpp 67.22%
Project Totals (46 files) 79.58%

No yaml found.

Create your codecov.yml to customize your Codecov experience

Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading