add test funciton

.Rproj.user/F63D843C/pcs/files-pane.pper

@@ -1,5 +1,5 @@
 {
-    "path" : "~/chinhung/develop/packages/taitratools/R",
+    "path" : "~/chinhung/develop/packages/taitratools/tests/testthat",
     "sortOrder" : [
         {
             "ascending" : false,

.Rproj.user/F63D843C/pcs/source-pane.pper

@@ -1,4 +1,4 @@
 {
-    "activeTab" : -1,
+    "activeTab" : 3,
     "activeTabSourceWindow1" : 0
 }

.Rproj.user/F63D843C/pcs/windowlayoutstate.pper

@@ -1,14 +1,14 @@
 {
     "left" : {
-        "panelheight" : 837,
-        "splitterpos" : 334,
-        "topwindowstate" : "HIDE",
-        "windowheight" : 874
+        "panelheight" : 1026,
+        "splitterpos" : 445,
+        "topwindowstate" : "NORMAL",
+        "windowheight" : 1063
     },
     "right" : {
-        "panelheight" : 823,
-        "splitterpos" : 509,
+        "panelheight" : 1026,
+        "splitterpos" : 634,
         "topwindowstate" : "NORMAL",
-        "windowheight" : 861
+        "windowheight" : 1063
     }
 }

.Rproj.user/F63D843C/sources/prop/INDEX

@@ -32,8 +32,17 @@
 ~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2FREADME.md="9C9B411"
 ~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Fdata-raw%2Ftt_source_path.R="AA8612A3"
 ~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Finst%2Fextdata%2Fgen_pkg_data.R="58A4C692"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Finst%2Fextdata%2Fgetsourcepath.R="E9DE0D77"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_break_line.R="4FE0AEA"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_calculate.R="5B75327E"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_df_show.R="B9857E23"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_pkg_data.R="147D5F6A"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_pkg_data_exist.R="B20FC38B"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_str2regex.R="FD9E7D8C"
+~%2Fchinhung%2Fdevelop%2Fpackages%2Ftaitratools%2Ftests%2Ftestthat%2Ftest_string.R="58CFA68B"
 ~%2Fchinhung%2Fproject%2Freports%2F20190702_%E4%B8%8D%E7%B9%94%E5%B8%83%2Fexcel_df.R="3F06DA"
 ~%2Fchinhung%2Fproject%2Freports%2F20190716_%E8%87%AA%E5%8B%95%E5%8C%96%E7%B0%A1%E5%A0%B1_officer%2Frender_plots.R="E117142A"
 ~%2Fchinhung%2Fproject%2Freports%2F20190829_%E6%89%8B%E5%B7%A5%E5%85%B7%E8%A8%88%E7%AE%97%2Foutput_report.R="1377E208"
 ~%2Fchinhung%2Fproject%2Freports%2F20190829_%E6%89%8B%E5%B7%A5%E5%85%B7%E8%A8%88%E7%AE%97%2Futils%2Fmain_helper.R="86603D0E"
+~%2Fchinhung%2Fproject%2Freports%2F20190913_%E5%87%BA%E5%8F%A3%E6%83%85%E5%8B%A2%E5%88%86%E6%9E%90_%E5%A2%9E%E6%B8%9B%E9%A1%8D%2FR%2Fcal_heatmap_diff.R="FE84924C"
 ~%2Fchinhung%2Fproject%2Freports%2F20191017_%E6%BD%9B%E5%8A%9B%E5%B8%82%E5%A0%B4%E7%AF%A9%E9%81%B8%2Fgen_report_all.R="C9B9D1C7"

.Rproj.user/shared/notebooks/paths

@@ -21,6 +21,11 @@ C:/Users/k484/Documents/chinhung/develop/packages/taitratools/README.Rmd="2FA8A0
 C:/Users/k484/Documents/chinhung/develop/packages/taitratools/README.md="F38AB28E"
 C:/Users/k484/Documents/chinhung/develop/packages/taitratools/data-raw/tt_source_path.R="41E40763"
 C:/Users/k484/Documents/chinhung/develop/packages/taitratools/inst/extdata/gen_pkg_data.R="496C4EF6"
+C:/Users/k484/Documents/chinhung/develop/packages/taitratools/inst/extdata/getsourcepath.R="A07FEACD"
+C:/Users/k484/Documents/chinhung/develop/packages/taitratools/tests/testthat/test_calculate.R="39EEFB40"
+C:/Users/k484/Documents/chinhung/develop/packages/taitratools/tests/testthat/test_df_show.R="666BD0F5"
+C:/Users/k484/Documents/chinhung/develop/packages/taitratools/tests/testthat/test_string.R="464A99B1"
 C:/Users/k484/Documents/chinhung/project/reports/20190702_不織布/excel_df.R="22B1BF4F"
 C:/Users/k484/Documents/chinhung/project/reports/20190716_自動化簡報_officer/render_plots.R="2512C94A"
+C:/Users/k484/Documents/chinhung/project/reports/20190913_出口情勢分析_增減額/R/cal_heatmap_diff.R="9836A2"
 C:/Users/k484/Documents/chinhung/project/reports/20191017_潛力市場篩選/gen_report_all.R="CEB121F"

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: taitratools
 Title: TAITRA Tools
-Version: 1.0.0
+Version: 1.0.1
 Authors@R: 
     person("Peter", "Tseng", role = c("aut", "cre"), email = "[email protected]")
 Description: Miscellaneous Tools for Work.

NAMESPACE

@@ -13,6 +13,7 @@ export(rpt_country_value)
 export(rpt_mof_industry_region)
 export(str2regex)
 export(toChString)
+export(tt_area_show)
 export(tt_bind_area)
 export(tt_bind_industry)
 export(tt_df_show)

R/bind_area.R

@@ -12,18 +12,18 @@ tt_bind_area <- function(.df) {
     stop("Input data.frame MUST contain a column named `country`!", call. = FALSE)
   }
 
-  tmp_tbl <- tt_read_table(tt_get_path("PATH_AREA"))
-  output <- vector("list", length = nrow(tmp_tbl))
+  output <- vector("list", length = nrow(.area_tbl))
 
   for (i in seq_along(output)) {
-    output_pattern <- str2regex(tmp_tbl[i, ][["countryName"]], sep = ",")
-    output_name <- tmp_tbl[i, ][["areaName"]]
+    output_pattern <- str2regex(.area_tbl[i, ][["countryName"]], sep = ",")
+    output_name <- .area_tbl[i, ][["areaName"]]
 
     if (output_name == "\u5168\u7403") {
       output_pattern <- "[\\w\\W]+"
     }
 
     tmp_output <- .df[stringr::str_detect(.df$country, output_pattern), ]
+    if (nrow(tmp_output) == 0) next()
     tmp_output$area <- output_name
     output[[i]] <- tmp_output
   }

R/bind_industry.R

@@ -7,16 +7,17 @@
 #' @param type Filter specified type.
 #' @param major Filter specified major.
 #' @param minor Filter specified minor.
+#' @param col_more append type, major, minor and industry columns
 #'
 #' @return A data frame
 #'
 #' @export
-tt_bind_industry <- function(.df, sub = 11, ind21 = FALSE, index = NULL, type = NULL, major = NULL, minor = NULL) {
+tt_bind_industry <- function(.df, sub = 11, ind21 = FALSE, index = NULL, type = NULL, major = NULL, minor = NULL, col_more = FALSE) {
   if (!all("hscode" %in% names(.df))) {
     stop("Input data.frame MUST contain a column named `hscode`!", call. = FALSE)
   }
 
-  tmp_tbl <- tt_read_table(tt_get_path("PATH_INDUSTRY"))
+  tmp_tbl <- .industry_tbl
 
   if (nrow(tmp_tbl) != 354 & ncol(tmp_tbl) != 9) {
     stop("The Industry Table must be changed! Please check and update SOURCE_PATH!", call. = FALSE)
@@ -26,7 +27,7 @@ tt_bind_industry <- function(.df, sub = 11, ind21 = FALSE, index = NULL, type =
     if (!check_ind21(tmp_tbl)) {
       stop(sprintf("Industry21 reference table may be changed. Please check and update `%s`!", tt_get_path("PATH_INDUSTRY")), call. = FALSE)
     }
-    tmp_tbl <- tmp_tbl[tmp_tbl[["\u7DE8\u865F"]] %in% tt_ind21_list, ]
+    tmp_tbl <- tmp_tbl[tmp_tbl[["\u7DE8\u865F"]] %in% .tt_ind21_list, ]
 
   } else {
     # Filter by index
@@ -78,7 +79,7 @@ tt_bind_industry <- function(.df, sub = 11, ind21 = FALSE, index = NULL, type =
   }
 
   # Only keey `hscode` and `industry` columns
-  tmp_tbl <- tmp_tbl[c("hscode", "industry")]
+  tmp_tbl <- tmp_tbl[c("\u9078\u64C7\u65B9\u5F0F", "\u5927\u9805", "\u7D30\u9805", "hscode", "industry")]
   output <- vector("list", length = nrow(tmp_tbl))
 
   for (i in seq_along(output)) {
@@ -94,7 +95,15 @@ tt_bind_industry <- function(.df, sub = 11, ind21 = FALSE, index = NULL, type =
     tmp_output <- .df[stringr::str_detect(.df$hscode, output_pattern), ]
     if (nrow(tmp_output) == 0) next()
 
-    tmp_output$industry <- output_name
+    if (!col_more) {
+      tmp_output$industry <- tmp_tbl[i, ][["industry"]]
+    } else {
+      tmp_output$type <- tmp_tbl[i, ][["\u9078\u64C7\u65B9\u5F0F"]]
+      tmp_output$major <- tmp_tbl[i, ][["\u5927\u9805"]]
+      tmp_output$minor <-tmp_tbl[i, ][["\u7D30\u9805"]]
+      tmp_output$industry <- tmp_tbl[i, ][["industry"]]
+    }
+
     output[[i]] <- tmp_output
   }
 
@@ -103,7 +112,7 @@ tt_bind_industry <- function(.df, sub = 11, ind21 = FALSE, index = NULL, type =
 
 check_ind21 <- function(.df) {
   # Package prestore industry 21 data.
-  valid_tbl <- tt_ind21_tbl
+  valid_tbl <- .tt_ind21_tbl
   # User's data.
   check_tbl <- .df
 

R/df_show.R

@@ -42,3 +42,22 @@ tt_hscode_show <- function(hscode = NULL, chinese = NULL) {
     .full_hscode_tbl[stringr::str_detect(.full_hscode_tbl$hscode_cn, patterns), ]
   }
 }
+
+#' tt_area_show
+#'
+#' @param area string
+#'
+#' @return string
+#' @export
+#'
+tt_area_show <- function(area = NULL) {
+  if (is.null(area)) return(.area_tbl)
+
+  area_nm <- .area_tbl[["areaName"]][-1]
+  stopifnot(all(area %in% area_nm))
+
+  cat(paste0(
+    area, " ==> ",
+    .area_tbl[.area_tbl$areaName == area, ][["countryName"]]
+  ))
+}

R/filter_by_area.R

@@ -20,7 +20,7 @@ tt_filter_by_area <- function(.df, area) {
     }
   }
 
-  tmp_tbl <- tt_read_table(tt_get_path("PATH_AREA"))
+  tmp_tbl <- .area_tbl
   tmp_tbl <- tmp_tbl[tmp_tbl$areaName %in% area, ]
   output <- vector("list", length = nrow(tmp_tbl))
 

R/get_path.R

@@ -14,11 +14,11 @@
 #' tt_get_path("PATH_FULL_HSCODE")
 #'
 tt_get_path <- function(path_name) {
-  ind <- which(names(tt_source_path) == path_name)
+  ind <- which(names(.tt_source_path) == path_name)
 
   if (identical(ind, integer(0))) {
     stop("Incorrect path name\n", call. = FALSE)
   }
 
-  unname(unlist(tt_source_path[ind]))
+  unname(unlist(.tt_source_path[ind]))
 }

R/ls.R

@@ -12,10 +12,9 @@
 #'
 #' @export
 tt_ls <- function() {
-  tmp_df <- tt_source_path
-  cwidth <- max(stringr::str_length(names(tmp_df)))
-  df_nm <- stringr::str_pad(names(tmp_df), width = cwidth, side = "right", pad = " ")
-  df_con <- unname(unlist(tmp_df))
+  cwidth <- max(stringr::str_length(names(.tt_source_path)))
+  df_nm <- stringr::str_pad(names(.tt_source_path), width = cwidth, side = "right", pad = " ")
+  df_con <- unname(unlist(.tt_source_path))
   cat(sprintf("%s %s  ==>  \"%s\"",check_path(df_con), df_nm, df_con), sep = "\n")
 }
 

R/read_mof.R

@@ -4,26 +4,17 @@
 #'
 #' @param start_date Start date with "year-month" format. ex> "2019-01".
 #' @param end_date End date with "year-month" format. ex> "2019-01".
-#' @param period Integer
-#' @param direct A string used to specify `export` and `import` values. The default value is `export`
-#' @param money A string used to specify `usd` and `twd` value. The default value is `usd`
-#' @param columns a character vector
-#' @param fixed_cny_nm boolean: fixed country names
-#' @param source_path source path
+#' @param period Integer.
+#' @param direct A string used to specify `export` and `import` values. The default value is `export`.
+#' @param money A string used to specify `usd` and `twd` value. The default value is `usd`.
+#' @param columns a character vector.
+#' @param dep_month_cols create year and month column, default is only year column with "\%Y-\%m" format.
+#' @param fixed_cny_nm boolean: fixed country names.
+#' @param source_path source path.
 #'
 #' @return data.frame
 #' @export
-tt_read_mof <- function(
-  start_date,
-  end_date,
-  period = 0,
-  direct = "export",
-  money = "usd",
-  columns = NULL,
-  fixed_cny_nm = TRUE,
-  source_path = "SOURCE_MOF"
-)
-{
+tt_read_mof <- function(start_date, end_date, period = 0, direct = "export", money = "usd", columns = NULL, dep_month_cols = FALSE, fixed_cny_nm = TRUE, source_path = "SOURCE_MOF"){
   stopifnot(validate_tt_read_mof(start_date, end_date, period, direct, money))
 
   period_list <- period_month(ym2date(start_date), ym2date(end_date), "%Y-%m")
@@ -61,6 +52,10 @@ tt_read_mof <- function(
     tmp_df <- fixed_country_names(tmp_df)
   }
 
+  if (dep_month_cols) {
+    tmp_df <- tidyr::separate(tmp_df, year, into = c("year", "month"))
+  }
+
   tmp_df
 }
 
@@ -76,6 +71,7 @@ validate_tt_read_mof <- function(start_date, end_date, period, direct, money) {
   stopifnot(is.numeric(period))
   stopifnot(direct %in% c("export", "import"))
   stopifnot(money %in% c("usd", "twd"))
+
   TRUE
 }
 

inst/extdata/gen_pkg_data.R

@@ -1,21 +1,22 @@
 # TODO Adding some common
+getsourcepath <- function() {
+  tmp_path <- readxl::read_xlsx("inst/extdata/tt_source_path.xlsx")
+  .tt_source_path <- as.list(tmp_path$path)
+  names(.tt_source_path) <- tmp_path$name
+  save(.tt_source_path, file = "R/sysdata.rda")
+}
 
 tt_update_data <- function() {
   # tt_source_path data
   tmp_path <- readxl::read_xlsx("inst/extdata/tt_source_path.xlsx")
-  tt_source_path <- as.list(tmp_path$path)
-  names(tt_source_path) <- tmp_path$name
+  .tt_source_path <- as.list(tmp_path$path)
+  names(.tt_source_path) <- tmp_path$name
 
   # industry21 data
-  tmp_tbl <- tt_read_table(tt_get_path("PATH_INDUSTRY"))
-  tt_ind21_list <- c("001", "007", "018", "028", "033", "045", "050", "054", "058", "062",
-    "078", "083", "088", "102", "105", "106", "107", "108", "110", "115",
-    "120", "134", "157", "158", "174", "175", "179", "180", "184", "185",
-    "189", "196", "197", "198", "199", "222", "223", "224", "225", "226",
-    "227", "228", "229", "233", "234", "238", "239", "240", "241", "257",
-    "263", "298", "353", "354")
+  .industry_tbl <- tt_read_table(tt_get_path("PATH_INDUSTRY"))
+  .tt_ind21_list <- .industry_tbl[.industry_tbl[["reports"]] == 1, ][["\u7DE8\u865F"]]
 
-  tt_ind21_tbl <- tmp_tbl[tmp_tbl[["\u7DE8\u865F"]] %in% tt_ind21_list, ][c("\u7DE8\u865F", "industry")]
+  .tt_ind21_tbl <- .industry_tbl[.industry_tbl[["\u7DE8\u865F"]] %in% .tt_ind21_list, ][c("\u7DE8\u865F", "industry")]
 
   # full hsocde data
   .full_hscode_tbl <- tt_read_table(tt_get_path("PATH_FULL_HSCODE"))
@@ -26,7 +27,13 @@ tt_update_data <- function() {
   })
   .full_hscode_tbl <- Reduce(rbind, tmp)
 
+  # area data
+  .area_tbl <- tt_read_table(tt_get_path("PATH_AREA"))
+  .area_tbl[.area_tbl$areaName == "全球", ][["countryName"]] <- "[\\w\\W]+"
 
-  save(tt_source_path, tt_ind21_tbl, tt_ind21_list, .full_hscode_tbl, file = "R/sysdata.rda")
+  # save data
+  save(.tt_source_path, .tt_ind21_tbl, .industry_tbl, .tt_ind21_list, .full_hscode_tbl, .area_tbl, file = "R/sysdata.rda")
 }
 
+getsourcepath()
+tt_update_data()

inst/extdata/getsourcepath.R

@@ -1,7 +1,7 @@
 
 getsourcepath <- function() {
   tmp_path <- readxl::read_xlsx("inst/extdata/tt_source_path.xlsx")
-  tt_source_path <- as.list(tmp_path$path)
-  names(tt_source_path) <- tmp_path$name
-  save(tt_source_path, file = "R/sysdata.rda")
+  .tt_source_path <- as.list(tmp_path$path)
+  names(.tt_source_path) <- tmp_path$name
+  save(.tt_source_path, file = "R/sysdata.rda")
 }