max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Fixed bugs on old functions

Browse source
This commit is contained in:
Waldir Leoncio 2020-01-15 13:29:47 +01:00
parent 168f58899e
commit f8f65f176c
5 changed files with 28 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
R/computeIndLogml.R
View file

@ -5,15 +5,21 @@
#' @param osuusTaulu Percentage table? #' @param osuusTaulu Percentage table?
#' @export #' @export
computeIndLogml <- function (omaFreqs, osuusTaulu) { computeIndLogml <- function (omaFreqs, osuusTaulu) {
omaFreqs <- as.matrix(omaFreqs)
osuusTaulu <- as.matrix(osuusTaulu)
apu <- repmat(t(osuusTaulu), c(1, dim(omaFreqs)[2])) apu <- repmat(t(osuusTaulu), c(1, dim(omaFreqs)[2]))
apu <- c(apu) * omaFreqs # c() avoids deprecation error re. matrix ops apu <- times(apu, omaFreqs) # c() avoids deprecation error re. matrix ops
if (length(apu) > 1) { if (length(apu) > 1) {
apu <- colSums(as.matrix(apu)) apu <- colSums(as.matrix(apu))
} else { } else {
apu <- sum(apu) apu <- sum(apu)
} }
if (any(apu < 0)) {
# Workaround for log of a negative number
apu <- as.complex(apu)
}
apu <- log(apu) apu <- log(apu)
loggis <- sum(apu) loggis <- sum(apu)

2
R/computeRows.R
View file

@ -14,7 +14,7 @@ computeRows <- function(rowsFromInd, inds, ninds) {
} }
rows <- inds[, rep(1, rowsFromInd)] rows <- inds[, rep(1, rowsFromInd)]
rows <- rows * rowsFromInd rows <- rows * rowsFromInd
miinus <- repmat((rowsFromInd - 1):0, c(1, ninds)) miinus <- repmat(t((rowsFromInd - 1):0), c(ninds, 1))
rows <- rows - miinus rows <- rows - miinus
rows <- matrix(t(rows), c(1, rowsFromInd * ninds)) rows <- matrix(t(rows), c(1, rowsFromInd * ninds))
return(t(rows)) return(t(rows))

2
R/times.R
View file

@ -26,7 +26,7 @@ times <- function(a, b) {
if (is.null(dominant_mx)) { if (is.null(dominant_mx)) {
out <- a * b out <- a * b
} else if (dominant_mx == "neither") { } else if (dominant_mx[1] == "neither") {
a <- repmat( a <- repmat(
mx = a, mx = a,
n = c(dominant_dim[1] - nrow(a) + 1, dominant_dim[2] - ncol(a) + 1) n = c(dominant_dim[1] - nrow(a) + 1, dominant_dim[2] - ncol(a) + 1)

15
tests/testthat/test-admix1.R
View file

@ -117,6 +117,21 @@ test_that("computeIndLogml works like on Matlab", {
expect_equivalent(computeIndLogml(-pi, -8), 3.2242, tol = .0001) expect_equivalent(computeIndLogml(-pi, -8), 3.2242, tol = .0001)
expect_equivalent(computeIndLogml(2:3, 2), 2.3026, tol = .0001) expect_equivalent(computeIndLogml(2:3, 2), 2.3026, tol = .0001)
expect_equivalent(computeIndLogml(matrix(8:5, 2), 100), 14.316, tol = .001) expect_equivalent(computeIndLogml(matrix(8:5, 2), 100), 14.316, tol = .001)
expect_equivalent(
object = computeIndLogml(matrix(8:5, 2), matrix(c(1, 3), 1)),
expected = 6.4118,
tol = .001
)
expect_equivalent(
object = computeIndLogml(matrix(8:5, 1), matrix(c(1, 3), 1)),
expected = 12.9717,
tol = .001
)
expect_equivalent(
object = computeIndLogml(c(8, 1), c(-1.6, 5)),
expected = complex(real = 6.4739, imaginary = pi),
tol = .001
)
}) })
test_that("suoritaMuutos works like on Matlab", { test_that("suoritaMuutos works like on Matlab", {

4
tests/testthat/test-convertedBaseFunctions.R
View file

@ -56,4 +56,8 @@ test_that("times works as expected", {
object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)), object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)),
expected = matrix(c(10, -10, 9, 36), 2) expected = matrix(c(10, -10, 9, 36), 2)
) )
expect_equal(
object = times(matrix(c(-1.6, 5), 1), c(8, 1)),
expected = matrix(c(-12.8, -1.6, 40, 5), 2)
)
}) })