繁体   English   中英

将带有产品标签的数据框转换为时间序列,以便在 R 中进行预测

[英]Convert data frame with product labels to time series for forecasting in R

我正在做一个关于药品需求预测的项目。

所以首先:

使用的原始导入数据包括以下信息; 进口日期、活性药物成分标签(产品代码)和 excel 表格中的数量。 例如:

进口日期 产品代码 数量
14/09/2018 1 300
18/06/2019 1 9400
18/06/2019 1 5430
05/06/2019 2 7000
17/09/2018 3 2300

首先,我需要合并相同日期和相同标签的条目,例如,2019 年 6 月 18 日只有一个进口商品被标记为“1”。 此外,我需要将数据框转换为时间序列,按日期排序,“产品代码”作为字符,“数量”作为数字。 当我尝试使用以下代码时,结果如下:

# Pacman, version 0.4.1 is used to organize the packages used in R.

library(pacman)

p_load(readxl, readr, ggplot2, forecast, fpp2, tidyverse, TTR, dplyr, zoo, xts)

dat <- read_xlsx("C://Users/oozgen/Desktop/Albania Statistical Analysis/labelleddata.xlsx", col_names=T)

# We need to format the 'Import Date' column as Date format (Year/Month), and sort by Date

orderdates <- as.Date(dat$`Import Date`)

# Since labeling is done numerically, we need to convert the 'Product Code' column from numeric format to character format in R.

dat <- transform(dat, 'Product Code' = as.character(dat$`Product Code`), 'Import Date' = orderdates)

dat_ts <- as.xts(x = dat[, -1], order.by = dat$Import.Date)

head(dat_ts)
产品代码 数量
2018-01-04 “784” “29976”
2018-01-04 “1149” “200”
2018-01-05 “306” “1000”
2018-01-05 “713” “50”
2018-01-05 “744” “5040”
2018-01-05 “744” “5040”

“产品代码”和“数量”都是字符格式。 此外,您可能已经注意到,很难预测单个表上的不同产品。 我是否必须将所有产品分开到不同的表格并分别进行预测?

您可以从此链接访问样本数据集*。

第一次编辑,我研究了@g-grothendieck 分享的解决方案:

# Pacman, version 0.4.1 is used to organize the packages used in R.

library(pacman)

p_load(readxl, readr, ggplot2, forecast, fpp3, tidyverse, TTR, dplyr, zoo, xts)

dat <- read_xlsx("C://Users/oozgen/Desktop/Albania Statistical Analysis/labelleddata.xlsx", col_names=T)

# We need to format the 'Import Date' column as Date format (Year/Month), and sort by Date. And also since labeling is done numerically, we need to convert the 'Product Code' column from numeric format to character format in R.

dat <- transform(dat, 'Product Code' = as.character(dat$`Product Code`), 'Import Date' = as.yearmon(dat$`Import Date`, "%Y/%m"))

class(dat)

[1] "data.frame"

我的数据整理成这样,作为data.frame:

导入日期 产品代码 数量
1 2018 年 9 月 1 3000
2 2019 年 3 月 1 600
3 2019 年 3 月 1 930
4 2019 年 6 月 1 2202
5 2019 年 6 月 1 5900
6 2019 年 6 月 1 5630

然后我继续但收到此错误:

> x <- dat |>
+   type.convert(as.is = TRUE) |>
+   read.zoo(format = "%Y/%m", split = "Product Code", aggregate = sum) |>
+   as.xts()
Error in `[.data.frame`(rval, , split) : undefined columns selected

对我的第一次编辑的补充(编辑 v1.1。); @g-grothendieck 表明,我在列名上犯了一个错误,并更正了它。 代码如下:

x <- dat |>
  type.convert(as.is = TRUE) |>
  read.zoo(format = "%Y/%m", split = "Product.Code", aggregate = sum) |>
  as.xts()

我收到以下错误:

...
+   as.xts()
Error in read.zoo(type.convert(dat, as.is = TRUE), format = "%Y/%m", split = "Product.Code",  : 
  index has 33038 bad entries at data rows: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 ...

对我的 First Edit 的 Edit (edit v1.2.) 的补充; 在@g-grothendieck 的帮助下,代码最终与“产品代码”分开编译,使用 zoo 包和as.yearmon命令:

x <- dat |>
  type.convert(as.is = TRUE) |>
  read.zoo(format = "%b %Y", FUN = as.yearmon,  split = "Product.Code", aggregate = sum) |>
  as.xts()

x[is.na(x)] <- 0

tt <- merge(x, zoo(, seq(start(x), end(x), 1/12))) |>
  na.spline() |>
  as.ts()

并且输出数据是时间序列,更整洁。 我也可以使用as.yearqtr操作不同频率的不同产品组(也来自@g-grothendieck)

对于第二次编辑,我已将日期转换为月/年并遵循@rob-hyndman 提供的代码:

# Pacman, version 0.4.1 is used to organize the packages used in R.

library(pacman)

p_load(readxl, readr, ggplot2, forecast, fpp3, tidyverse, TTR, dplyr, zoo, janitor, xts)

dat <- read_xlsx("C://Users/oozgen/Desktop/Albania Statistical Analysis/labelleddata.xlsx", col_names=T)

# We need to format the 'Import Date' column as Date format (Year/Month), and sort by Date. And also since labeling is done numerically, we need to convert the 'Product Code' column from numeric format to character format in R.

dat <- transform(dat, 'Product Code' = as.character(dat$`Product Code`), 'Import Date' = as.yearmon(dat$`Import Date`, "%Y/%m"))

class(dat)

dat[is.na(dat)]=0

write.csv(dat,"C:/Users/oozgen/Downloads/data2.csv", row.names = FALSE)

x <- readr::read_csv(
  "C:/Users/oozgen/Downloads/data2.csv",
  name_repair = janitor::make_clean_names
) %>%
  mutate(
    # Interpret dates
    import_date = dmy(import_date),
    # Format product codes as character strings with leading zeros
    product_code = sprintf("%03d",product_code)
  ) %>%
  # Make date/code combinations unique
  group_by(import_date, product_code) %>%
  summarise(quantity = sum(quantity), .groups="drop") %>%
  # Create tsibble
  as_tsibble(index=import_date, key=product_code) %>%
  # Fill missing dates with zeros
  fill_gaps(quantity = 0)

我收到了这个错误:

...
+   fill_gaps(quantity = 0)
Rows: 33038 Columns: 3                                                                                                                  
-- Column specification -----------------------------------------------------------------------------
Delimiter: ","
chr (1): import_date
dbl (2): product_code, quantity

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
Error: Column `import_date` (index) must not contain `NA`.
Run `rlang::last_error()` to see where the error occurred.
In addition: Warning message:
Problem with `mutate()` column `import_date`.
i `import_date = dmy(import_date)`.
i All formats failed to parse. No formats found. 

我无法继续预测...

对于我的第二次编辑(编辑 v2.1.); @rob-hyndman 解释说,发生错误是因为我在使用代码之前编辑了日期,因此该函数将无法再解释日期。 我已经修复了我的代码如下:

dat <- readr::read_csv(
  "C://Users/oozgen/Desktop/Albania Statistical Analysis/labelleddata.csv",
  name_repair = janitor::make_clean_names
) %>%
  mutate(
    # Interpret dates
    import_date = quarter(dmy(import_date), with_year = T),
    # Format product codes as character strings with leading zeros
    product_code = sprintf("%03d", product_code)
  ) %>%
  # Make date/code combinations unique
  group_by(import_date, product_code) %>%
  summarise(quantity = sum(quantity), .groups="drop") %>%
  # Create tsibble
  as_tsibble(index=import_date, key=product_code) %>%
  # Fill missing dates with zeros
  fill_gaps(quantity = 0)

它编译没有错误,你可能已经注意到了。 我重新编辑了这一行; import_date = quarter(dmy(import_date), with_year = T),因为进口不频繁,大部分药品一年进口三四次,所以我把日期改为/作为季度。 然后我按照@rob-hyndman 的建议继续预测:

fc <- dat %>%
  model(croston = CROSTON(quantity)) %>%
  forecast(h = "12 quarters")
Error: Problem with `mutate()` column `croston`.
i `croston = (function (object, ...) ...`.
x invalid class “Period” object: periods must have integer values
Run `rlang::last_error()` to see where the error occurred.
In addition: Warning message:
195 errors (1 unique) encountered for croston
[195] At least two non-zero values are required to use Croston's method.

我收到了那个错误......我可以用季度数据预测的任何方法。

第三次和最终编辑:

在蛮力的帮助下,我一次成功地预测了所有数据:

# Pacman, version 0.4.1 is used to organize the packages used in R.

library(pacman)

p_load(readxl, readr, ggplot2, forecast, fpp3, tidyverse, TTR, tibble, tsibble, tsibbledata, feasts, fable, dplyr, zoo, lubridate, janitor, xts)

dat <- read_xlsx("C://Users/oozgen/Desktop/Albania Statistical Analysis/dat.xlsx", col_names=T)

# We need to format the 'Import Date' column as Date format (Year/Month), and sort by Date. And also since labeling is done numerically, we need to convert the 'Product Code' column from numeric format to character format in R.

dat <- transform(dat, 'Product Code' = as.character(dat$`Product Code`))

class(dat)

z <- dat %>%
  type.convert(as.is = TRUE) %>%
  read.zoo(format = "%Y-%m-%d", FUN = as.yearqtr, index.column = 1,
           split = "Product.Code", aggregate = sum)

tt <- merge(z, zoo(, seq(start(z), end(z), 1/4))) |>
  as.ts()

tt[is.na(tt)]=0

result_matrix <- matrix(, nrow = 20, ncol = 1149)

for(i in 1:1149){
  
  res_i <- croston(tt[, i], h=8)
    res_i <- append(res_i$x, res_i$mean)
      result_matrix[, i] <- res_i
  
  }

write.table(result_matrix, "resultmatrix.csv", sep = ";")

由于croston 预测方法适用于间歇性需求。 我必须根据不常进口的药品和经常进口的药品来组织数据。 对于频繁出现的,我应该找到合适的预测方法。

这将是这篇文章的最后一个条目。 我大概会把数据集和相关的代码和算法贴在github上。 非常感谢@sevgib、@g-grothendieck 和@rob-hyndman 的帮助。

PS 如果有一种方法可以使用深度学习算法进行医药产品的需求预测,那就太好了。 有一项研究包括用于大流行预测的 Facebook AI 包,我认为这个*

使用末尾注释中显示的 DF,将应该是数字的列转换为数字,使用read.zoo使用 yearmon 类作为索引,拆分产品代码(检查是否为您的数据准确指定了格式和列名,如果与最后的注释中假设的不同)并使用 sum 聚合并转换为 zoo。 最后通过将 z 与每个月的零宽度系列合并,然后使用na.spline (或na.approxna.locf )填充缺失值进行na.spline ,然后转换为 ts 类,因为需要定期间隔的ts系列通过许多预测程序。 如果您确实想要 xts 系列,则使用 as.xts(z) 或将as.ts()替换为as.xts()如果您仍然想要插值。 ?strptime的百分比码?read.zoovignette("zoo-read")read.zoo?yearmon对这个类和信息?type.convert该功能。

library(xts) # also pulls in zoo

z <- DF |>
  type.convert(as.is = TRUE) |>
  read.zoo(format = "%d/%m/%Y", FUN = as.yearmon, 
    split = "Product Code", aggregate = sum) 

tt <- merge(z, zoo(, seq(start(z), end(z), 1/12))) |>
  na.spline() |>
  as.ts()

给予:

> tt
                 1    2    3
Sep 2018   300.000 7000 2300
Oct 2018  1914.444 7000 2300
Nov 2018  3528.889 7000 2300
Dec 2018  5143.333 7000 2300
Jan 2019  6757.778 7000 2300
Feb 2019  8372.222 7000 2300
Mar 2019  9986.667 7000 2300
Apr 2019 11601.111 7000 2300
May 2019 13215.556 7000 2300
Jun 2019 14830.000 7000 2300

笔记

DF <- structure(list(`Import Date` = c("14/09/2018", "18/06/2019", 
"18/06/2019", "05/06/2019", "17/09/2018"), `Product Code` = c("1", 
"1", "1", "2", "3"), Quantity = c("300", "9400", "5430", "7000", 
"2300")), row.names = c(NA, -5L), class = "data.frame")

最简单的方法是使用 fable 包,它旨在一次处理多个时间序列,并与 tidyverse 包集合集成。 这是使用您的示例数据的示例。

library(fpp3)
#> ── Attaching packages ─────────────────────────────────────── fpp3 0.4.0.9000 ──
#> ✓ tibble      3.1.4          ✓ tsibble     1.0.1     
#> ✓ dplyr       1.0.7          ✓ tsibbledata 0.3.0.9000
#> ✓ tidyr       1.1.3          ✓ feasts      0.2.2.9000
#> ✓ lubridate   1.7.10         ✓ fable       0.3.1.9000
#> ✓ ggplot2     3.3.5
#> ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
#> x lubridate::date()    masks base::date()
#> x dplyr::filter()      masks stats::filter()
#> x tsibble::intersect() masks base::intersect()
#> x tsibble::interval()  masks lubridate::interval()
#> x dplyr::lag()         masks stats::lag()
#> x tsibble::setdiff()   masks base::setdiff()
#> x tsibble::union()     masks base::union()
# Read data and clean up
dat <- readr::read_csv(
    "~/Downloads/albaniaingredient_result.xlsx - Sheet1.csv",
    name_repair = janitor::make_clean_names
  ) %>%
  mutate(
    # Interpret dates
    import_date = dmy(import_date),
    # Format product codes as character strings with leading zeros
    product_code = sprintf("%03d",product_code)
  ) %>%
  # Make date/code combinations unique
  group_by(import_date, product_code) %>%
  summarise(quantity = sum(quantity), .groups="drop") %>%
  # Create tsibble
  as_tsibble(index=import_date, key=product_code) %>%
  # Fill missing dates with zeros
  fill_gaps(quantity = 0)
#> Rows: 3086 Columns: 3
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): import_date
#> dbl (2): product_code, quantity
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Produce daily forecasts
fc <- dat %>%
  model(croston = CROSTON(quantity)) %>%
  forecast(h = "14 days")
#> Warning: 16 errors (1 unique) encountered for croston
#> [16] At least two non-zero values are required to use Croston's method.
# forecasts for product 014
fc %>%
  filter(product_code == "014")
#> # A fable: 14 x 5 [1D]
#> # Key:     product_code, .model [1]
#>    product_code .model  import_date quantity .mean
#>    <chr>        <chr>   <date>        <dist> <dbl>
#>  1 014          croston 2020-12-04  4773.584 4774.
#>  2 014          croston 2020-12-05  4773.584 4774.
#>  3 014          croston 2020-12-06  4773.584 4774.
#>  4 014          croston 2020-12-07  4773.584 4774.
#>  5 014          croston 2020-12-08  4773.584 4774.
#>  6 014          croston 2020-12-09  4773.584 4774.
#>  7 014          croston 2020-12-10  4773.584 4774.
#>  8 014          croston 2020-12-11  4773.584 4774.
#>  9 014          croston 2020-12-12  4773.584 4774.
#> 10 014          croston 2020-12-13  4773.584 4774.
#> 11 014          croston 2020-12-14  4773.584 4774.
#> 12 014          croston 2020-12-15  4773.584 4774.
#> 13 014          croston 2020-12-16  4773.584 4774.
#> 14 014          croston 2020-12-17  4773.584 4774.
fc %>%
  filter(product_code == "014") %>%
  autoplot(filter(dat, year(import_date) >= 2020))

reprex 包(v2.0.1) 于 2021 年 9 月 23 日创建

我使用了 Croston 的方法,因为对于大多数方法,您的数据有太多的零。 如果您将数据聚合到每周或每月,那么您将能够使用更可靠的方法。

OTexts.com/fpp3在线免费提供讨论寓言包的教科书

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM