Translated ownNum2Str

R/admix1.R

@@ -769,40 +769,4 @@ admix1 <- function(tietue) {
 # rows = reshape(rows', [1,rowsFromInd*ninds]);
 
 # %--------------------------------------------------------------------------
-# %-----
-
-# function str = ownNum2Str(number)
-
-# absolute = abs(number);
-
-# if absolute < 1000
-#     str = num2str(number);
-# elseif absolute < 10000000
-#     first_three = rem(number,1000);
-#     next_four = (number - first_three) /1000;
-#     first_three = abs(first_three);
-#     if first_three<10
-#         first_three = ['00' num2str(first_three)];
-#     elseif first_three<100
-#         first_three = ['0' num2str(first_three)];
-#     else
-#         first_three = num2str(first_three);
-#     end;
-#     str = [num2str(next_four) first_three]; 
-# elseif absolute < 100000000
-#     first_four = rem(number,10000);
-#     next_four = (number - first_four) /10000;
-#     first_four = abs(first_four);
-#     if first_four<10
-#         first_four = ['000' num2str(first_four)];
-#     elseif first_four<100
-#         first_four = ['00' num2str(first_four)];
-#     elseif first_four<1000
-#         first_four = ['0' num2str(first_four)];
-#     else
-#         first_four = num2str(first_four);
-#     end;
-#     str = [num2str(next_four) first_four];     
-# else
-#     str = num2str(number);
-# end;
+# %-----

R/ownNum2Str.R

@@ -0,0 +1,39 @@
+#' @title Own number to string
+#' @param number number
+#' @note On Matlab, if number is NaN the output is 'NaN'. Here, the output will be an error. Also, the function belo expects "number" to have length one, whereas Matlab accepts vectors.
+#' @export
+ownNum2Str <- function(number) {
+    absolute <- abs(number)
+    if (absolute < 1000) {
+        str <- as.character(number)
+    } else if (absolute < 10000000) {
+        first_three <- number %% 1000
+        next_four <- (number - first_three) /1000
+        first_three <- abs(first_three)
+        if (first_three < 10) {
+            first_three <- paste0('00', as.character(first_three))
+        } else if (first_three < 100) {
+            first_three <- paste0('0', as.character(first_three))
+        } else {
+            first_three <- as.character(first_three)
+        }
+        str <- paste0(as.character(next_four), first_three)
+    } else if (absolute < 100000000) {
+        first_four <- number %% 10000
+        next_four <- (number - first_four) / 10000
+        first_four <- abs(first_four)
+        if (first_four < 10) {
+            first_four <- paste0('000', as.character(first_four))
+        } else if (first_four < 100) {
+            first_four <- paste0('00', as.character(first_four))
+        } else if (first_four < 1000) {
+            first_four <- paste0('0', as.character(first_four))
+        } else {
+            first_four <- as.character(first_four)
+        }
+        str <- paste0(as.character(next_four), first_four)
+    } else {
+        str <- as.character(number)
+    }
+    return(str)
+}