Next version

- 0.2.0.99
- All local builds pass
- Rhub
- Finalize for CRAN

Author: bedantaguru

DESCRIPTION

@@ -2,7 +2,7 @@ Type: Package
 Package: tidycells
 Title: Read Tabular Data from Diverse Sources and Easily Make
     Them Tidy
-Version: 0.2.0.9000
+Version: 0.2.0.99
 Authors@R: 
     person(given = "Indranil",
            family = "Gayen",

NEWS.md

@@ -1,16 +1,25 @@
 
 # *News*
 
+# tidycells 0.2.1
+
+## New features
+
+* Enhancement in the heuristic-based algorithm
+
+## Other changes
+
+* Now if `read_cells` fails in the intermediate stage, it will give the output of last successful stage 
+
 # tidycells 0.2.0 _(2019-08-20)_
 
 ## First CRAN Release
 
-* Next release will adopt to [tidyr 1.0.0](https://github.com/tidyverse/tidyr/issues/710)
-* Next release will fix CRAN build issue in Fedora [#1](https://github.com/r-rudra/tidycells/issues/1) ([![See DevNotes](https://img.shields.io/badge/See-DevNotes-blue.svg)](https://github.com/r-rudra/tidycells/blob/master/dev-notes.md#regarding-cran-results))
+* Initial CRAN Release
 
 # tidycells 0.1.9 _(2019-08-12)_
 
-## New Features
+## New Features`
 
 * Added `collate_columns` to collate attribute-columns having similar content.
 
@@ -19,5 +28,5 @@
 ## Initial Public Release
 
 * Initial Release to GitHub
-* Prior to this it was private package
+* Prior to this it was a private package
 

R/ai_attach_direction.R

@@ -1,12 +1,19 @@
 
 
 ai_attach_direction <- function(d_att_dat_map_raw) {
-  d_att_dat_map_raw %>%
+
+  # asp: attr split
+  d_att_dat_map_raw_asp <- d_att_dat_map_raw %>%
     # kept for tracking
     mutate(direction_basic = direction) %>%
     mutate(attr_gid_split = ifelse(direction_group == "NS" & attr_group == "major", row_a,
       ifelse(direction_group == "WE" & attr_group == "major", col_a, 0)
-    )) %>%
+    ))
+
+  d_att_dat_map_raw_asp <- d_att_dat_map_raw_asp %>%
+    mutate(attr_gid_split = ifelse(direction_group == "corner", col_a, attr_gid_split))
+
+  d_att_dat_map_raw_asp %>%
     group_by(data_gid, attr_gid, direction, attr_gid_split) %>%
     group_split() %>%
     map_df(~ .x %>% mutate(direction = get_direction(.x)))

R/ai_data_gid_join.R

@@ -1,5 +1,7 @@
 ai_data_gid_join <- function(d_dat, data_attr_map, full_data) {
   repeat({
+    if (length(unique(d_dat$group_id_map$gid)) < 2) break()
+
     data_gid_comb <- d_dat$group_id_map$gid %>%
       unique() %>%
       utils::combn(2) %>%

R/ai_get_data_attr_map_main.R

@@ -0,0 +1,58 @@
+
+ai_get_data_attr_map_main <- function(d_dat, d_att, crude_join = TRUE) {
+
+  #  start with simple attr data map
+  admap0 <- ai_get_data_attr_map(
+    dat_boundary = d_dat$group_id_boundary,
+    att_gid_map = d_att$group_id_map
+  )
+
+
+  if (crude_join) {
+    # crude joins
+    # absolutely sure joins
+    crude_djoins <- ai_crude_data_block_joins(basic_admap = admap0$map, d_dat = d_dat)
+    if (crude_djoins$done) {
+      d_dat <- crude_djoins$d_dat
+      admap0 <- ai_get_data_attr_map(
+        dat_boundary = d_dat$group_id_boundary,
+        att_gid_map = d_att$group_id_map
+      )
+    }
+  }
+
+
+  # split attr gid relative to data_gid
+  rel_chk <- ai_relative_data_split_attr(basic_map = admap0, d_att = d_att, d_dat = d_dat)
+  if (rel_chk$done) {
+    d_att <- rel_chk$d_att %>% map(unique)
+    admap0 <- rel_chk$admap
+  }
+
+
+  admap1_major_minor <- admap0$all_map %>%
+    rename(attr_gid = gid, dist = md) %>%
+    filter(direction_group != "corner") %>%
+    ai_get_data_attr_map_details(d_dat, d_att)
+
+  admap1_major_minor_compact <- admap1_major_minor$map %>%
+    filter(attr_group == "major") %>%
+    rename(md = dist) %>%
+    group_by(data_gid, direction_group) %>%
+    mutate(m_dist = min(md)) %>%
+    ungroup() %>%
+    filter(md == m_dist) %>%
+    select(-md) %>%
+    rename(dist = m_dist)
+
+  admap0_pass0 <- admap1_major_minor_compact %>%
+    filter(direction_group != "corner") %>%
+    unique() %>%
+    select(-attr_group)
+
+  # dimension analysis done here (major minor classification)
+  admap1 <- admap0_pass0 %>%
+    ai_get_data_attr_map_details(d_dat, d_att)
+
+  list(admap = admap1, d_dat = d_dat, d_att = d_att)
+}

R/ai_relative_data_join_attr.R

@@ -2,8 +2,8 @@
 
 ai_relative_data_join_attr <- function(admap_main, d_att) {
   chk <- admap_main$raw_map %>%
-    distinct(attr_gid, data_gid, direction) %>%
-    group_by(data_gid, direction) %>%
+    distinct(attr_gid, data_gid, direction, attr_group) %>%
+    group_by(data_gid, direction, attr_group) %>%
     mutate(n_att = n_distinct(attr_gid)) %>%
     ungroup() %>%
     filter(n_att > 1)
@@ -16,13 +16,14 @@ ai_relative_data_join_attr <- function(admap_main, d_att) {
 
     rel_gids <- chk %>%
       select(-n_att) %>%
-      inner_join(admap_main$raw_map, by = c("attr_gid", "data_gid", "direction"))
+      inner_join(admap_main$raw_map, by = c("attr_gid", "data_gid", "direction", "attr_group"))
 
-    d_att_dat_map_raw_rest <- admap_main$raw_map %>% anti_join(chk, by = c("attr_gid", "data_gid", "direction"))
+    d_att_dat_map_raw_rest <- admap_main$raw_map %>%
+      anti_join(chk, by = c("attr_gid", "data_gid", "direction", "attr_group"))
 
     rel_gids_att <- rel_gids %>%
-      distinct(attr_gid, data_gid, direction, row = row_a, col = col_a) %>%
-      group_by(data_gid, direction) %>%
+      distinct(attr_gid, data_gid, direction, attr_group, row = row_a, col = col_a) %>%
+      group_by(data_gid, direction, attr_group) %>%
       mutate(new_attr_gid = paste(min(attr_gid), data_gid, direction, sep = "_")) %>%
       ungroup()
 
@@ -31,6 +32,7 @@ ai_relative_data_join_attr <- function(admap_main, d_att) {
     rel_gids <- rel_gids %>%
       group_by(new_attr_gid, data_gid) %>%
       mutate(
+        # this is possibly not required anymore as attr_group is in grouping vars
         new_attr_group = ifelse(any(attr_group == "major"), "major", "minor"),
         new_dist = min(dist)
       ) %>%

R/analyze_cells.R

@@ -90,37 +90,17 @@ analyze_cells_raw <- function(d, silent = TRUE) {
     abort("No `attribute` cells found")
   }
 
-  d_dat <- get_group_id(data_cells)
-  d_att <- get_group_id(attr_cells)
+  d_dat_orig <- get_group_id(data_cells)
+  d_att_orig <- get_group_id(attr_cells)
 
-  #  start with simple attr data map
-  admap0 <- ai_get_data_attr_map(
-    dat_boundary = d_dat$group_id_boundary,
-    att_gid_map = d_att$group_id_map
-  )
-
-  # crude joins
-  # absolutely sure joins
-  crude_djoins <- ai_crude_data_block_joins(basic_admap = admap0$map, d_dat = d_dat)
-  if (crude_djoins$done) {
-    d_dat <- crude_djoins$d_dat
-    admap0 <- ai_get_data_attr_map(
-      dat_boundary = d_dat$group_id_boundary,
-      att_gid_map = d_att$group_id_map
-    )
-  }
+  d_dat <- d_dat_orig
+  d_att <- d_att_orig
 
-  # split attr gid relative to data_gid
-  rel_chk <- ai_relative_data_split_attr(basic_map = admap0, d_att = d_att, d_dat = d_dat)
-  if (rel_chk$done) {
-    d_att <- rel_chk$d_att
-    admap0 <- rel_chk$admap
-  }
+  setp1 <- ai_get_data_attr_map_main(d_dat, d_att)
 
-  # dimension analysis done here (major minor classification)
-  admap1 <- admap0$map %>%
-    filter(direction_group != "corner") %>%
-    ai_get_data_attr_map_details(d_dat, d_att)
+  d_dat <- setp1$d_dat
+  d_att <- setp1$d_att
+  admap1 <- setp1$admap
 
   # data_gid join (if possible)
   if (nrow(d_dat$group_id_boundary) > 1) {
@@ -132,22 +112,21 @@ analyze_cells_raw <- function(d, silent = TRUE) {
       # this means results has been invalidated
       d_dat <- d_dat0
 
-      admap0 <- ai_get_data_attr_map(
-        dat_boundary = d_dat$group_id_boundary,
-        att_gid_map = d_att$group_id_map
-      )
+      # revert back to original form
+      d_att <- d_att_orig
 
-      # all (NS and WE) attr are attached
-      admap1 <- admap0$map %>%
-        filter(direction_group != "corner") %>%
-        ai_get_data_attr_map_details(d_dat, d_att)
+      setp2 <- ai_get_data_attr_map_main(d_dat, d_att, crude_join = FALSE)
+
+      d_dat <- setp2$d_dat
+      d_att <- setp2$d_att
+      admap1 <- setp2$admap
     }
   }
 
   # join attr based on block merges possible
   rel_chk <- ai_relative_data_join_attr(admap_main = admap1, d_att = d_att)
   if (rel_chk$done) {
-    d_att <- rel_chk$d_att
+    d_att <- rel_chk$d_att %>% map(unique)
     admap1 <- rel_chk$admap
   }
 
@@ -193,10 +172,52 @@ analyze_cells_raw <- function(d, silent = TRUE) {
   }
 
 
-  d_dat$group_id_whole_boundary <- extend_data_block(d_dat$group_id_extended_boundary, admap_fc1$map, d_att)
+  # last stage of analysis
+  # this is not required
+  # d_dat$group_id_whole_boundary <- extend_data_block(d_dat$group_id_extended_boundary, admap_fc1$map, d_att)
+
+  admap2 <- merge_admaps(admap1, admap_fc1)
+
+  # join attr based on block merges possible (one more time)
+  rel_chk <- ai_relative_data_join_attr(admap_main = admap2, d_att = d_att)
+  if (rel_chk$done) {
+    d_att <- rel_chk$d_att %>% map(unique)
+    admap2 <- rel_chk$admap
+  }
+
+  cmp <- compact_gid_maps(d_att, admap2)
+  d_att <- cmp$gid_map
+  admap2 <- cmp$admap
+
+  admap3 <- admap2$map %>%
+    select(-attr_group) %>%
+    ai_get_data_attr_map_details(d_dat, d_att)
+
+  if (!identical(admap3$map, admap2$map)) {
+    # I think this can be iterated
+    # KFL
+    admap3_pass <- admap3$map %>%
+      rename(md = dist) %>%
+      group_by(data_gid, direction_group, attr_group) %>%
+      mutate(m_dist = min(md)) %>%
+      ungroup() %>%
+      filter(md == m_dist) %>%
+      select(-md) %>%
+      rename(dist = m_dist)
+
+    admap <- admap3_pass %>%
+      select(-attr_group) %>%
+      ai_get_data_attr_map_details(d_dat, d_att)
+  } else {
+    admap <- admap3
+  }
+
+  # once admap is done
+  d_dat$group_id_extended_boundary <- NULL
+  d_dat$group_id_whole_boundary <- extend_data_block(d_dat$group_id_boundary, admap$map, d_att)
 
-  admap <- merge_admaps(admap1, admap_fc1)
 
+  # str-detection done
   this_cells <- get_cells_from_admap(admap, d_dat, d_att)
 
   # natural gid for easier understanding

R/attach_trace_info.R

@@ -4,12 +4,12 @@ attach_trace_info <- function(ca, dc) {
     if (missing(ca)) {
       abort("either 'ca' or 'dc' required")
     }
-    dc_t <- compose_cells_raw(ca, trace_it_back = TRUE)
+    dc_t <- compose_cells_raw(ca, trace_it_back = TRUE, silent = TRUE)
     dc <- dc_t
   } else {
     if (!any(stringr::str_detect(colnames(dc), "cellAddress_"))) {
       if (!missing(ca)) {
-        dc_t <- compose_cells_raw(ca, trace_it_back = TRUE)
+        dc_t <- compose_cells_raw(ca, trace_it_back = TRUE, silent = TRUE)
         dc_t <- dc_t[c("row", "col", colnames(dc_t)[stringr::str_detect(colnames(dc_t), "cellAddress_")])]
         dc_t$chk_this <- "ok"
         dc <- dc %>% left_join(dc_t, by = c("row", "col"))

R/compact_gid_maps.R

@@ -0,0 +1,47 @@
+
+# diffrent split resulted in same attr_gid
+# these will be compated to single group
+compact_gid_maps <- function(gid_map, admap_main) {
+  gid_map_raw <- gid_map$group_id_map
+
+  foot_prints <- gid_map_raw %>%
+    group_by(gid) %>%
+    group_split() %>%
+    map_df(~ .x %>%
+      distinct(row, col, gid) %>%
+      arrange(row, col) %>%
+      summarise(gid = gid[1], fp = paste0(row, ",", col, collapse = ";")))
+
+  ngmap <- foot_prints %>%
+    group_by(fp) %>%
+    mutate(new_gid = min(gid)) %>%
+    ungroup() %>%
+    distinct(gid, new_gid)
+
+  gid_map_raw_new <- gid_map_raw %>% left_join(ngmap, by = "gid")
+  gid_map_raw_new <- gid_map_raw_new %>%
+    mutate(new_gid = ifelse(is.na(new_gid), gid, new_gid)) %>%
+    select(-gid) %>%
+    rename(gid = new_gid) %>%
+    distinct()
+
+  gid_map$group_id_map <- gid_map_raw_new
+  gid_map$group_id_boundary <- get_group_id_boundary(gid_map_raw_new)
+
+  admap_main_raw_map_new <- admap_main$raw_map %>%
+    left_join(ngmap %>% rename(attr_gid = gid, new_attr_gid = new_gid), by = "attr_gid")
+  admap_main_raw_map_new <- admap_main_raw_map_new %>%
+    mutate(new_attr_gid = ifelse(is.na(new_attr_gid), attr_gid, new_attr_gid)) %>%
+    select(-attr_gid) %>%
+    rename(attr_gid = new_attr_gid) %>%
+    distinct()
+
+  admap_main$raw_map <- admap_main_raw_map_new
+
+  admap_main$map <- admap_main$raw_map %>%
+    distinct(attr_gid, data_gid, direction, direction_group, dist, attr_group)
+
+  # dimesion analysis is not kept
+
+  list(gid_map = gid_map, admap = admap_main)
+}