Skip to content

Commit 62b6986

Browse files
KucharssimKucharssim
committed
fix tests
1 parent 80912d7 commit 62b6986

40 files changed

+1755
-1605
lines changed

‎R/commonDiscoverDistributions.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,13 +28,13 @@
2828
if(options[["newVariableName"]] != "")
2929
{
3030
jaspResults[['sampleColumn']] <- createJaspColumn(options[["newVariableName"]])
31-
31+
3232
didItWork <- switch(as,
3333
scale= jaspResults[['sampleColumn']]$setScale( sample),
3434
ordinal=jaspResults[['sampleColumn']]$setOrdinal(sample),
3535
jaspResults[['sampleColumn']]$setNominal(sample))
3636

37-
if(!didItWork)
37+
if(!didItWork)
3838
jaspResults[['sampleColumnError']] <- createJaspHtml(text=gettextf("Could not write to column '%s', probably because it wasn't created by this analysis", options[["newVariableName"]]), elementType="errorMsg", dependencies="newVariableName")
3939
}
4040
}

‎R/ldGaussianunivariate.R‎

Lines changed: 71 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -17,37 +17,37 @@
1717

1818
LDgaussianunivariateInternal <- function(jaspResults, dataset, options, state=NULL){
1919
options <- .recodeOptionsLDGaussianUnivariate(options)
20-
20+
2121
#### Show distribution section ----
22-
.ldShowDistribution(jaspResults = jaspResults, options = options, name = gettext("normal distribution"),
22+
.ldShowDistribution(jaspResults = jaspResults, options = options, name = gettext("normal distribution"),
2323
parSupportMoments = .ldGaussianParsSupportMoments,
24-
formulaPDF = .ldFormulaGaussianPDF,
25-
formulaCDF = .ldFormulaGaussianCDF,
24+
formulaPDF = .ldFormulaGaussianPDF,
25+
formulaCDF = .ldFormulaGaussianCDF,
2626
formulaQF = .ldFormulaGaussianQF)
27-
27+
2828
#### Generate and Display data section ----
2929
# simulate and read data
3030
.simulateData(jaspResults, options)
31-
31+
3232
ready <- options[['variable']] != ""
3333
errors <- FALSE
3434
if(ready && is.null(dataset)){
3535
dataset <- .readDataSetToEnd(columns.as.numeric = options[['variable']])
36-
36+
3737
variable <- dataset[[.v(options[['variable']])]]
3838
variable <- variable[!is.na(variable)]
3939
errors <- .hasErrors(dataset, type = c("observations", "variance", "infinity", "limits"),
4040
observations.amount = "<2",
41-
limits.min = options$support$min, limits.max = options$support$max,
41+
limits.min = options$support$min, limits.max = options$support$max,
4242
exitAnalysisIfErrors = FALSE)
4343
}
44-
44+
4545
# overview of the data
4646
.ldDescriptives(jaspResults, variable, options, ready, errors, "continuous")
47-
47+
4848
#### Fit data and assess fit ----
4949
.ldMLE(jaspResults, variable, options, ready, errors, .ldFillGaussianEstimatesTable)
50-
50+
5151
return()
5252
}
5353

@@ -62,24 +62,24 @@ LDgaussianunivariateInternal <- function(jaspResults, dataset, options, state=NU
6262
} else if(options$parametrization == "kappa"){
6363
options$sd <- 1/options$varValue
6464
}
65-
65+
6666
options[['parValNames']] <- c("mu", "varValue")
67-
67+
6868
options[['pars']] <- list(mean = options[['mu']], sd = options[['sd']])
6969
options[['pdfFun']] <- stats::dnorm
7070
options[['cdfFun']] <- stats::pnorm
7171
options[['qFun']] <- stats::qnorm
7272
options[['rFun']] <- stats::rnorm
7373
options[['distNameInR']] <- "norm"
74-
74+
7575
options <- .ldOptionsDeterminePlotLimits(options)
76-
76+
7777
options$support <- list(min = -Inf, max = Inf)
7878
options$lowerBound <- c(-Inf, 0)
7979
options$upperBound <- c(Inf, Inf)
80-
80+
8181
options$transformations <- c(mu = "mean", sigma2 = "sd^2", sigma = "sd", tau = "1/sd^2", kappa = "1/sd")
82-
82+
8383
options
8484
}
8585

@@ -93,9 +93,9 @@ LDgaussianunivariateInternal <- function(jaspResults, dataset, options, state=NU
9393
sigma = gettextf("standard deviation: %s", "&sigma; \u2208 \u211D<sup>+</sup>"),
9494
tau = gettextf("precision: %s", "&tau; \u2208 \u211D<sup>+</sup>"),
9595
kappa = gettextf("square root of precision: %s", "&kappa; \u2208 \u211D<sup>+</sup>"))
96-
96+
9797
support <- "x \u2208 \u211D"
98-
98+
9999
moments <- list()
100100
moments$expectation <- gettext("&mu;")
101101
moments$variance <- switch(options[['parametrization']],
@@ -111,26 +111,26 @@ LDgaussianunivariateInternal <- function(jaspResults, dataset, options, state=NU
111111
.ldFormulaGaussianPDF <- function(options){
112112
if(options[['parametrization']] == "sigma2"){
113113
text <- "<MATH>
114-
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&sigma;&sup2;</span>) =
115-
(2&pi;<span style='color:blue'>&sigma;&sup2;</span>)<sup>-&frac12;</sup>
114+
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&sigma;&sup2;</span>) =
115+
(2&pi;<span style='color:blue'>&sigma;&sup2;</span>)<sup>-&frac12;</sup>
116116
exp[-(x-<span style='color:red'>&mu;</span>)&sup2; &frasl; 2<span style='color:blue'>&sigma;&sup2;</span>]
117117
</MATH>"
118118
} else if(options[['parametrization']] == "sigma"){
119119
text <- "<MATH>
120-
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&sigma;</span>) =
121-
(2&pi;<span style='color:blue'>&sigma;</span>&sup2;)<sup>-&frac12;</sup>
120+
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&sigma;</span>) =
121+
(2&pi;<span style='color:blue'>&sigma;</span>&sup2;)<sup>-&frac12;</sup>
122122
exp[-(x-<span style='color:red'>&mu;</span>)&sup2; &frasl; 2<span style='color:blue'>&sigma;</span>&sup2;]
123123
</MATH>"
124124
} else if(options[['parametrization']] == "tau2"){
125125
text <- "<MATH>
126-
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&tau;&sup2;</span>) =
127-
(<span style='color:blue'>&tau;&sup2;</span> &frasl; 2&pi;)<sup>&frac12;</sup>
126+
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&tau;&sup2;</span>) =
127+
(<span style='color:blue'>&tau;&sup2;</span> &frasl; 2&pi;)<sup>&frac12;</sup>
128128
exp[-(x-<span style='color:red'>&mu;</span>)&sup2; <span style='color:blue'>&tau;&sup2;</span> &frasl; 2]
129129
</MATH>"
130130
} else if(options[['parametrization']] == "tau"){
131131
text <- "<MATH>
132-
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&tau;</span>) =
133-
<span style='color:blue'>&tau;</span> &frasl; (2&pi;)<sup>&frac12;</sup>
132+
f(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&tau;</span>) =
133+
<span style='color:blue'>&tau;</span> &frasl; (2&pi;)<sup>&frac12;</sup>
134134
exp[-(x-<span style='color:red'>&mu;</span>)&sup2; <span style='color:blue'>&tau;</span>&sup2; &frasl; 2]
135135
</MATH>"
136136
}
@@ -156,7 +156,7 @@ exp[-(x-<span style='color:red'>&mu;</span>)&sup2; &frasl; 2<span style='color:b
156156
F(x; <span style='color:red'>&mu;</span>, <span style='color:blue'>&tau;</span>)
157157
</MATH>"
158158
}
159-
159+
160160
return(gsub(pattern = "\n", replacement = " ", x = text))
161161
}
162162

@@ -178,7 +178,7 @@ exp[-(x-<span style='color:red'>&mu;</span>)&sup2; &frasl; 2<span style='color:b
178178
Q(p; <span style='color:red'>&mu;</span>, <span style='color:blue'>&tau;</span>)
179179
</MATH>"
180180
}
181-
181+
182182
return(gsub(pattern = "\n", replacement = " ", x = text))
183183
}
184184

@@ -190,170 +190,170 @@ exp[-(x-<span style='color:red'>&mu;</span>)&sup2; &frasl; 2<span style='color:b
190190
if(is.null(table)) return()
191191

192192
par1 <- c(mu = "\u03BC")
193-
par2 <- c(sigma2 = "\u03C3\u00B2", sigma = "\u03C3",
193+
par2 <- c(sigma2 = "\u03C3\u00B2", sigma = "\u03C3",
194194
tau = "\u03C4", kappa = "\u03BA")[options$parametrization]
195195
res <- results$structured
196196
res <- res[res$par %in% names(c(par1, par2)),]
197197
res$parName <- c(par1, par2)
198-
198+
199199
if(results$fitdist$convergence != 0){
200200
table$addFootnote(gettext("The optimization did not converge, try adjusting the parameter values."), symbol = gettext("<i>Warning.</i>"))
201201
}
202202
if(!is.null(results$fitdist$optim.message)){
203203
table$addFootnote(results$fitdist$message, symbol = gettext("<i>Warning.</i>"))
204204
}
205-
205+
206206
table$setData(res)
207-
207+
208208
return()
209209
}
210210

211211
# old ----
212212
# .ldGaussianMethodMomentsResults <- function(jaspResults, options, variable, ready){
213213
# if(!ready || !options[['methodMoments']])
214214
# return()
215-
#
216-
#
215+
#
216+
#
217217
# if(is.null(jaspResults[['methodMoments']][['results']]$object)){
218218
# jaspResults[['methodMoments']][['results']] <- createJaspState()
219219
# jaspResults[['methodMoments']][['results']]$dependOn(c("variable", "simulateNow"))
220-
#
220+
#
221221
# results <- list()
222222
# results$par <- .computeObservedMoments(x = variable, max.moment = 2, about.mean = TRUE)
223223
# results$par[2] <- sqrt(results$par[2])
224224
# names(results$par) <- c("mean", "sd")
225-
#
225+
#
226226
# results$table <- c(mu = results$par[[1]],
227227
# sigma = results$par[[2]],
228228
# sigma2 = results$par[[2]]^2,
229229
# tau = results$par[[2]],
230230
# tau2 = 1/results$par[[2]]^2)
231231
# jaspResults[['methodMoments']][['results']]$object <- results
232232
# }
233-
#
233+
#
234234
# return()
235235
# }
236-
#
236+
#
237237
# .ldGaussianMethodUnbiasedResults <- function(jaspResults, options, variable, ready){
238238
# if(!ready || !options[['methodUnbiased']])
239239
# return()
240-
#
241-
#
242-
#
240+
#
241+
#
242+
#
243243
# if(is.null(jaspResults[['methodUnbiased']][['results']]$object)){
244244
# jaspResults[['methodUnbiased']][['results']] <- createJaspState()
245245
# jaspResults[['methodUnbiased']][['results']]$dependOn(c("variable", "simulateNow", "ciInterval"))
246-
#
246+
#
247247
# results <- list()
248248
# results$par <- c(mean = mean(variable), sd = .sdGaussianUnbiased(variable))
249249
# names(results$par) <- c("mean", "sd")
250-
#
250+
#
251251
# results$table <- c(mu = results$par[[1]],
252252
# sigma = results$par[[2]],
253253
# sigma2 = var(variable),
254254
# tau = 1/results$par[[2]],
255255
# tau2 = 1/var(variable))
256-
#
256+
#
257257
# if(options[['ciInterval']]){
258258
# res <- t.test(variable, conf.level = options[['ciIntervalInterval']])
259259
# resvar <- ci.GaussianVar(variable, conf.level = options[['ciIntervalInterval']])
260260
# ressd <- ci.GaussianSD (variable, conf.level = options[['ciIntervalInterval']])
261-
#
261+
#
262262
# results$table <- c(results$table, mu.lower = res[['conf.int']][[1]], mu.upper = res[['conf.int']][[2]],
263263
# sigma2.lower = resvar[1], sigma2.upper = resvar[2],
264264
# sigma.lower = ressd[1], sigma.upper = ressd[2],
265265
# tau2.lower = 1/resvar[1], tau2.upper = 1/resvar[2],
266266
# tau.lower = 1/ressd[1], tau.upper = 1/ressd[2])
267-
#
267+
#
268268
# }
269269
# jaspResults[['methodUnbiased']][['results']]$object <- results
270270
# }
271-
#
271+
#
272272
# return()
273273
# }
274-
#
274+
#
275275
# .ldFitAssessment <- function(methodContainer, options, variable, ready){
276276
# if(is.null(methodContainer[['fitAssessment']])){
277277
# methodContainer[['fitAssessment']] <- createJaspContainer(title = "Fit Assessment")
278278
# methodContainer[['fitAssessment']]$dependOn(c("variable", "simulateNow"))
279279
# }
280-
#
281-
#
280+
#
281+
#
282282
# estParameters <- methodContainer[['results']]$object[['par']]
283-
#
283+
#
284284
# .ldFillAssessmentTable(methodContainer, estParameters, options, variable, ready)
285-
#
286-
#
285+
#
286+
#
287287
# if(is.null(methodContainer[['fitAssessment']][['estPDF']]) && options$estPDF){
288288
# pdfplot <- createJaspPlot(title = "Histogram vs. Theoretical PDF")
289289
# pdfplot$dependOn(c("estPDF"))
290290
# pdfplot$position <- 2
291291
# methodContainer[['fitAssessment']][['estPDF']] <- pdfplot
292-
#
292+
#
293293
# if(ready)
294294
# .ldFillEstPDFPlot(pdfplot, estParameters, options, variable)
295295
# }
296-
#
296+
#
297297
# if(is.null(methodContainer[['fitAssessment']][['qqplot']]) && options$qqplot){
298298
# qqplot <- createJaspPlot(title = "Q-Q plot")
299299
# qqplot$dependOn(c("qqplot"))
300300
# qqplot$position <- 3
301301
# methodContainer[['fitAssessment']][['qqplot']] <- qqplot
302-
#
302+
#
303303
# if(ready)
304304
# .ldFillQQPlot(qqplot, estParameters, options, variable)
305305
# }
306-
#
306+
#
307307
# if(is.null(methodContainer[['fitAssessment']][['estCDF']]) && options$estCDF){
308308
# cdfplot <- createJaspPlot(title = "Empirical vs. Theoretical CDF")
309309
# cdfplot$dependOn(c("estCDF"))
310310
# cdfplot$position <- 4
311311
# methodContainer[['fitAssessment']][['estCDF']] <- cdfplot
312-
#
312+
#
313313
# if(ready)
314314
# .ldFillEstCDFPlot(cdfplot, estParameters, options, variable)
315315
# }
316-
#
316+
#
317317
# if(is.null(methodContainer[['fitAssessment']][['ppplot']]) && options$ppplot){
318318
# ppplot <- createJaspPlot(title = "P-P plot")
319319
# ppplot$dependOn(c("ppplot"))
320320
# ppplot$position <-5
321321
# methodContainer[['fitAssessment']][['ppplot']] <- ppplot
322-
#
322+
#
323323
# if(ready)
324324
# .ldFillPPPlot(ppplot, estParameters, options, variable)
325325
# }
326-
#
326+
#
327327
# return()
328328
# }
329-
#
329+
#
330330
#### Helper functions ----
331331
# .sdGaussianUnbiased <- function(x){
332332
# # https://en.wikipedia.org/wiki/Unbiased_estimation_of_standard_deviation
333333
# x <- na.omit(x)
334334
# n <- length(x)
335335
# logSDBiased <- log(sd(x))
336-
#
336+
#
337337
# logCorrectionFactor <- 0.5*log(2) - 0.5*log(n-1) + lgamma(n/2) - lgamma((n-1)/2)
338-
#
338+
#
339339
# logSDUnbiased <- logSDBiased - logCorrectionFactor
340-
#
340+
#
341341
# return(exp(logSDUnbiased))
342342
# }
343-
#
344-
#
343+
#
344+
#
345345
# ci.GaussianVar <- function(x, conf.level = options[['ciIntervalInterval']]){
346346
# x <- na.omit(x)
347347
# df <- length(x) - 1
348348
# v <- var(x)
349-
#
349+
#
350350
# alpha <- 1-conf.level
351351
# perc <- c(1-alpha/2, alpha/2)
352352
# res <- v * df / qchisq(p = perc, df = df)
353-
#
353+
#
354354
# return(res)
355355
# }
356-
#
356+
#
357357
# ci.GaussianSD <- function(variable, conf.level = options[['ciIntervalInterval']]){
358358
# sqrt(ci.GaussianVar(variable, conf.level))
359359
# }

‎jaspDistributions.Rproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
Version: 1.0
2+
ProjectId: 26bce1ce-a4eb-450b-9c1b-159a44be99d3
23

34
RestoreWorkspace: Default
45
SaveWorkspace: Default

0 commit comments

Comments
 (0)