8Apr2016

Author: RudolfCardinal

debugfunc.R

@@ -111,7 +111,11 @@ debugfunc$wtf_is <- function(x) {
     print(mode(x))
     cat("\n4. names():\n")
     print(names(x))
-    cat("\n5. str():\n")
+    cat("\n5. slotNames():\n")
+    print(slotNames(x))
+    cat("\n6. attributes():\n")
+    print(attributes(x))
+    cat("\n7. str():\n")
     print(str(x))
 }
 

misclang.R

@@ -43,6 +43,15 @@ misclang$load_or_run_function <- function(varname, file, fn, ..., forcerun=FALSE
     return(get(varname))
 }
 
+#==============================================================================
+# Factors
+#==============================================================================
+
+misclang$numeric_factor_to_numeric <- function(f) {
+    # http://stackoverflow.com/questions/3418128
+    as.numeric(levels(f))[f]
+}
+
 #==============================================================================
 # Namespace-like method: http://stackoverflow.com/questions/1266279/#1319786
 #==============================================================================

miscmath.R

@@ -24,6 +24,78 @@ miscmath$harmonic_mean <- function(x) {
     1 / mean(1/x)
 }
 
+# =============================================================================
+# Logarithmic sequence
+# =============================================================================
+
+miscmath$log_sequence <- function(pow10low, pow10high,
+                                  minimum=NA, maximum=NA) {
+    # http://stackoverflow.com/questions/23901907
+    x <- c(2:10 %o% 10^(pow10low:pow10high))
+    if (!is.na(minimum)) {
+        x <- x[which(x >= minimum)]
+    }
+    if (!is.na(maximum)) {
+        x <- x[which(x <= maximum)]
+    }
+    return(x)
+}
+
+# =============================================================================
+# Formatting numbers
+# =============================================================================
+
+miscmath$format_dp <- function(x, k) {
+    # http://stackoverflow.com/questions/3443687/formatting-decimal-places-in-r
+    format(round(x, k), nsmall=k)
+}
+
+miscmath$format_sf <- function(x, k = 3,
+                               scientific = FALSE,
+                               big.mark = ",", big.interval = 3,
+                               small.mark = "", small.interval = 3,
+                               drop0trailing = TRUE) {
+    # http://stackoverflow.com/questions/3443687/formatting-decimal-places-in-r
+    format(signif(x, k),
+           scientific = scientific,
+           big.mark = big.mark,
+           big.interval = big.interval,
+           small.mark = small.mark,
+           small.interval = small.interval,
+           drop0trailing = drop0trailing)
+}
+
+miscmath$describe_p_value <- function(p, boundary_NS = 0.1, ns_val = "NS",
+                                      boundary_scientific = 0.0001) {
+    ifelse(
+        p > boundary_NS,
+        paste("p >", boundary_NS),
+        ifelse(
+            p == 0,  # unusual!
+            "p = 0",  # better than "p = 0e0+00"
+            ifelse(
+                p >= boundary_scientific,
+                paste("p =", miscmath$format_sf(p, scientific = FALSE,
+                                                small.mark = "")),
+                paste("p =", miscmath$format_sf(p, scientific = TRUE))
+            )
+        )
+    )
+}
+
+miscmath$p_stars <- function(p) {
+    # Simply a convention!
+    # http://stats.stackexchange.com/questions/29158/do-you-reject-the-null-hypothesis-when-p-alpha-or-p-leq-alpha
+    ifelse(p <= 0.001, "***",
+           ifelse(p <= 0.01, "**",
+                  ifelse(p < 0.05, "*",
+                         "NS")))
+}
+
+miscmath$describe_p_value_with_stars <- function(p) {
+    paste(miscmath$p_stars(p), ", ", miscmath$describe_p_value(p), sep = "")
+}
+
 # =============================================================================
 # Namespace-like method: http://stackoverflow.com/questions/1266279/#1319786
 # =============================================================================

miscplot.R

@@ -1,8 +1,13 @@
 # miscplot.R
 
-requireNamespace("grid")  # for gpar
+requireNamespace("grid")  # for gpar, etc.
 requireNamespace("ggplot2")
 
+library(gridExtra)
+#library(extrafont) # install with sudo. Then (with sudo R) run font_import() then loadfonts(). Then view with fonts() or fonttable(). See https://github.com/wch/extrafont
+library(Cairo)
+library(ggplot2)
+
 #==============================================================================
 # Namespace-like method: http://stackoverflow.com/questions/1266279/#1319786
 #==============================================================================
@@ -105,7 +110,7 @@ element_grob.theme_border <- function(
     element_gp <- grid::gpar(lwd = len0_null(element$size * .pt),
                              col = element$colour,
                              lty = element$linetype)
-    polylineGrob(
+    grid::polylineGrob(
         x = xlist, y = ylist, id = idlist, ..., default.units = "npc",
         gp = modifyList(element_gp, gp),
     )
@@ -132,7 +137,7 @@ element_grob.theme_L_border <- function(
     element_gp <- grid::gpar(lwd = len0_null(element$size * .pt),
                              col = element$colour,
                              lty = element$linetype)
-    polylineGrob(
+    grid::polylineGrob(
         x = c(x+width, x, x), y = c(y,y,y+height), ..., default.units = "npc",
         gp = modifyList(element_gp, gp),
     )
@@ -159,7 +164,7 @@ element_grob.theme_bottom_border <- function(
     element_gp <- grid::gpar(lwd = len0_null(element$size * .pt),
                              col = element$colour,
                              lty = element$linetype)
-    polylineGrob(
+    grid::polylineGrob(
         x = c(x, x+width), y = c(y,y), ..., default.units = "npc",
         gp = modifyList(element_gp, gp),
     )
@@ -186,7 +191,7 @@ element_grob.theme_left_border <- function(
     element_gp <- grid::gpar(lwd = len0_null(element$size * .pt),
                              col = element$colour,
                              lty = element$linetype)
-    polylineGrob(
+    grid::polylineGrob(
         x = c(x, x), y = c(y, y+height), ..., default.units = "npc",
         gp = modifyList(element_gp, gp),
     )
@@ -248,7 +253,7 @@ element_grob.theme_border_numerictype <- function(
     element_gp <- grid::gpar(lwd = len0_null(element$size * .pt),
                              col = element$colour,
                              lty = element$linetype)
-    polylineGrob(
+    grid::polylineGrob(
         x = xlist, y = ylist, id = idlist, ..., default.units = "npc",
         gp = modifyList(element_gp, gp),
     )
@@ -327,11 +332,6 @@ miscplot$multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
 
 # http://cairographics.org/manual/cairo-FreeType-Fonts.html
 
-library(gridExtra)
-#library(extrafont) # install with sudo. Then (with sudo R) run font_import() then loadfonts(). Then view with fonts() or fonttable(). See https://github.com/wch/extrafont
-library(Cairo)
-library(ggplot2)
-
 miscplot$which_cairo_fonts_available <- function() {
     CairoFontMatch(":", sort=TRUE)
 }
@@ -384,7 +384,7 @@ miscplot$save_grob_to_pdf <- function(g, filename, width_mm, height_mm,
               title=title)
         # Cairo automatically embeds fonts:
         # http://cran.r-project.org/web/packages/Cairo/Cairo.pdf
-        grid.draw(g)  # not: print(g)
+        grid::grid.draw(g)  # not: print(g)
         dev.off()
     }
 }
@@ -395,7 +395,7 @@ miscplot$A4_LARGE_MM <- 297
 miscplot$POINTS_PER_INCH <- 72
 miscplot$POINTS_PER_MM <- miscplot$POINTS_PER_INCH * miscplot$INCHES_PER_MM
 
-miscplot$BLANK_GROB <- rectGrob(gp=grid::gpar(fill="white", alpha=0))
+miscplot$BLANK_GROB <- grid::rectGrob(gp=grid::gpar(fill="white", alpha=0))
 # ... alpha=0 makes it invisible
 miscplot$NOLEGEND <- theme(legend.position="none")
 miscplot$MOVELEGEND_BOTTOMLEFT <- theme(legend.justification=c(0,0),