From f8f65f176cf792187854d3e9c2b85f8a35e8c2ee Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 15 Jan 2020 13:29:47 +0100
Subject: [PATCH] Fixed bugs on old functions

---
 R/computeIndLogml.R                          |  8 +++++++-
 R/computeRows.R                              |  2 +-
 R/times.R                                    |  2 +-
 tests/testthat/test-admix1.R                 | 15 +++++++++++++++
 tests/testthat/test-convertedBaseFunctions.R |  4 ++++
 5 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/R/computeIndLogml.R b/R/computeIndLogml.R
index 872c932..0e6d08c 100644
--- a/R/computeIndLogml.R
+++ b/R/computeIndLogml.R
@@ -5,15 +5,21 @@
 #' @param osuusTaulu Percentage table?
 #' @export
 computeIndLogml <- function (omaFreqs, osuusTaulu) {
+    omaFreqs <- as.matrix(omaFreqs)
+    osuusTaulu <- as.matrix(osuusTaulu)
 
     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) {
         apu <- colSums(as.matrix(apu))
     } else {
         apu <- sum(apu)
     }
 
+    if (any(apu < 0)) {
+        # Workaround for log of a negative number
+       apu <- as.complex(apu)
+    }
     apu <- log(apu)
 
     loggis <- sum(apu)
diff --git a/R/computeRows.R b/R/computeRows.R
index 447e5ef..c4a69c3 100644
--- a/R/computeRows.R
+++ b/R/computeRows.R
@@ -14,7 +14,7 @@ computeRows <- function(rowsFromInd, inds, ninds) {
     }
     rows <- inds[, rep(1, 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 <- matrix(t(rows), c(1, rowsFromInd * ninds))
     return(t(rows))
diff --git a/R/times.R b/R/times.R
index c887d3d..e935cfc 100644
--- a/R/times.R
+++ b/R/times.R
@@ -26,7 +26,7 @@ times <- function(a, b) {
 
     if (is.null(dominant_mx)) {
         out <- a * b
-    } else if (dominant_mx == "neither") {
+    } else if (dominant_mx[1] == "neither") {
         a <- repmat(
             mx = a,
             n = c(dominant_dim[1] - nrow(a) + 1, dominant_dim[2] - ncol(a) + 1)
diff --git a/tests/testthat/test-admix1.R b/tests/testthat/test-admix1.R
index 1c427eb..876ec49 100644
--- a/tests/testthat/test-admix1.R
+++ b/tests/testthat/test-admix1.R
@@ -117,6 +117,21 @@ test_that("computeIndLogml works like on Matlab", {
     expect_equivalent(computeIndLogml(-pi, -8), 3.2242, 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(
+        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", {
diff --git a/tests/testthat/test-convertedBaseFunctions.R b/tests/testthat/test-convertedBaseFunctions.R
index 1b53265..3480053 100644
--- a/tests/testthat/test-convertedBaseFunctions.R
+++ b/tests/testthat/test-convertedBaseFunctions.R
@@ -56,4 +56,8 @@ test_that("times works as expected", {
         object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 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)
+    )
 })
\ No newline at end of file