From 266d1a4018d0b2b843164bd83aa8ef3e551b1b63 Mon Sep 17 00:00:00 2001
From: Edgar Ruiz <edgar@rstudio.com>
Date: Wed, 10 Jul 2019 10:29:21 -0500
Subject: [PATCH] Fixes #65

---
 .Rbuildignore                  |  1 +
 DESCRIPTION                    |  2 +-
 NAMESPACE                      |  5 +++++
 NEWS.md                        |  4 +++-
 R/corrr.R                      |  5 ++++-
 R/retract.R                    | 37 ++++++++++++++++++++++++++++++++++
 R/utility.R                    |  9 ++++-----
 man/retract.Rd                 | 25 +++++++++++++++++++++++
 tests/testthat/test-as_cordf.R |  1 +
 tests/testthat/test-fashion.R  |  3 +++
 tests/testthat/test-stretch.R  |  9 ++++++++-
 11 files changed, 92 insertions(+), 9 deletions(-)
 create mode 100644 R/retract.R
 create mode 100644 man/retract.Rd

diff --git a/.Rbuildignore b/.Rbuildignore
index 6f3e6a8..3453f7d 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -14,3 +14,4 @@ revdep
 codecov.yml
 ^docs
 _pkgdown.yml
+pkgdown
diff --git a/DESCRIPTION b/DESCRIPTION
index 22fefec..5de13aa 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: corrr
 Type: Package
-Version: 0.3.2.9001
+Version: 0.3.2.9002
 Title: Correlations in R
 Description: A tool for exploring correlations.
     It makes it possible to easily perform routine tasks when
diff --git a/NAMESPACE b/NAMESPACE
index 4f43339..57819c5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -12,6 +12,7 @@ S3method(focus_if,default)
 S3method(network_plot,cor_df)
 S3method(network_plot,default)
 S3method(rearrange,cor_df)
+S3method(retract,data.frame)
 S3method(rplot,cor_df)
 S3method(rplot,default)
 S3method(shave,cor_df)
@@ -27,6 +28,7 @@ export(focus_if)
 export(network_plot)
 export(pair_n)
 export(rearrange)
+export(retract)
 export(rplot)
 export(shave)
 export(stretch)
@@ -41,8 +43,11 @@ importFrom(purrr,imap_dfr)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map_df)
+importFrom(purrr,map_dfc)
+importFrom(purrr,map_dfr)
 importFrom(purrr,map_lgl)
 importFrom(purrr,set_names)
+importFrom(rlang,as_label)
 importFrom(stats,dist)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
diff --git a/NEWS.md b/NEWS.md
index 189ab05..849c20a 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,8 @@
 # corrr (development version)
 
-# corrr 0.3.2.9001
+# corrr 0.3.2.9002
+
+- Adds `retract()` function (#65)
 
 - Fixes compatability issues with `dplyr` 
 
diff --git a/R/corrr.R b/R/corrr.R
index 63f20b0..4f25783 100644
--- a/R/corrr.R
+++ b/R/corrr.R
@@ -1,11 +1,14 @@
 #' @importFrom stats dist
 #' @importFrom purrr map_df
+#' @importFrom purrr map_dfr
+#' @importFrom purrr map_dfc
 #' @importFrom purrr map_lgl
 #' @importFrom purrr map
 #' @importFrom purrr map2
 #' @importFrom purrr imap_dfr
 #' @importFrom purrr flatten
 #' @importFrom purrr set_names
+#' @importFrom rlang as_label
 #' @importFrom dplyr select
 #' @importFrom dplyr mutate_all
 #' @importFrom dplyr filter
@@ -17,4 +20,4 @@
 #' @keywords internal
 "_PACKAGE"
 NULL
-utils::globalVariables(c("id"))
+utils::globalVariables(c("id", "r"))
diff --git a/R/retract.R b/R/retract.R
new file mode 100644
index 0000000..9f52e73
--- /dev/null
+++ b/R/retract.R
@@ -0,0 +1,37 @@
+#' Creates a data frame from a streched correlation table
+#' 
+#' \code{retract} does the opposite of what \code{stretch} does
+#' 
+#' @param .data A data.frame or tibble containing at least three variables: x, y and the value
+#' @param x The name of the column to use from .data as x
+#' @param y The name of the column to use from .data as y
+#' @param val The name of the column to use from .data to use as the value
+#' @export
+#' @examples
+#' x <- correlate(mtcars)
+#' xs <- stretch(x)
+#' retract(xs)
+#' @export
+retract <- function(.data, x, y, val) {
+  UseMethod("retract")
+}
+
+#' @export
+retract.data.frame <- function(.data,  x = x, y = y, val = r) {
+  val <- enquo(val)
+  y <- enquo(y)
+  x <- enquo(x)
+  row_names <- unique(.data[, as_label(y)][[1]])
+  res <- map_dfr(
+    row_names, ~{
+      df <- .data[.data[, as_label(x)]== .x, ]
+      vl <- df[, as_label(val)][[1]]
+      nm <- df[, as_label(y)][[1]]
+      map_dfc(
+        seq_along(nm),
+        ~ tibble(!! nm[.x] := !! vl[.x])
+      )
+    }
+  )
+  first_col(res, row_names)
+}
diff --git a/R/utility.R b/R/utility.R
index 6781322..88c6f95 100644
--- a/R/utility.R
+++ b/R/utility.R
@@ -14,19 +14,18 @@
 #' as_cordf(x)
 #' as_cordf(x, diagonal = 1)
 as_cordf <- function(x, diagonal = NA) {
-  
   if(methods::is(x, "cor_df")) {
     warning("x is already a correlation data frame.")
     return(x)
   }
-  
-  x <- tibble::as_tibble(x)
-  
+  x <- as.data.frame(x)
+  row_name <- x$rowname
+  x <- x[, colnames(x) != "rowname"]
+  rownames(x) <- row_name
   if(ncol(x) != nrow(x)) {
     stop("Input object x is not a square. ",
          "The number of columns must be equal to the number of rows.")
   }
-  
   diag(x) <- diagonal
   x <- first_col(x, names(x))
   class(x) <- c("cor_df", class(x))
diff --git a/man/retract.Rd b/man/retract.Rd
new file mode 100644
index 0000000..1c268f7
--- /dev/null
+++ b/man/retract.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/retract.R
+\name{retract}
+\alias{retract}
+\title{Creates a data frame from a streched correlation table}
+\usage{
+retract(.data, x, y, val)
+}
+\arguments{
+\item{.data}{A data.frame or tibble containing at least three variables: x, y and the value}
+
+\item{x}{The name of the column to use from .data as x}
+
+\item{y}{The name of the column to use from .data as y}
+
+\item{val}{The name of the column to use from .data to use as the value}
+}
+\description{
+\code{retract} does the opposite of what \code{stretch} does
+}
+\examples{
+x <- correlate(mtcars)
+xs <- stretch(x)
+retract(xs)
+}
diff --git a/tests/testthat/test-as_cordf.R b/tests/testthat/test-as_cordf.R
index e43ed0e..a75f477 100644
--- a/tests/testthat/test-as_cordf.R
+++ b/tests/testthat/test-as_cordf.R
@@ -5,6 +5,7 @@ d <- cor(mtcars)
 test_that("Inherits correct classes", {
   expect_is(as_cordf(d), "cor_df")
   expect_is(as_cordf(d), "tbl")
+  expect_warning(as_cordf(as_cordf(d)), "x is already a correlation")
 })
 
 test_that("Yields correct columns and rows", {
diff --git a/tests/testthat/test-fashion.R b/tests/testthat/test-fashion.R
index 9807107..3580ee3 100644
--- a/tests/testthat/test-fashion.R
+++ b/tests/testthat/test-fashion.R
@@ -71,3 +71,6 @@ test_that("Vectors and padding", {
   )
 })
 
+test_that("Fashion works against matrix", {
+  expect_is(fashion(as.matrix(correlate(mtcars))), "data.frame")
+})
diff --git a/tests/testthat/test-stretch.R b/tests/testthat/test-stretch.R
index ee36b44..6a62d47 100644
--- a/tests/testthat/test-stretch.R
+++ b/tests/testthat/test-stretch.R
@@ -28,4 +28,11 @@ test_that("na.rm", {
     sum(is.na(stretch(d, na.rm = TRUE)$r)),
     0
   )
-})
\ No newline at end of file
+})
+
+test_that("retract works", {
+  cd <- as_cordf(retract(stretch(d)))
+  expect_equal(d, cd)
+  expect_is(d, "cor_df")
+})
+