apply dplyr function to time series failed

Question

There is time series ttrc_total , when applying the dplyr function group_by mutate ..., there are failures. Is there way to solve it? Thanks!

library(TTR)
library(tidyverse)
data(ttrc)
ttrc_total <- rbind(ttrc %>% mutate(category='A'),
      ttrc %>% mutate(category='B'),
      ttrc %>% mutate(category='C'))

Below code show error message : no applicable method for 'group_by' applied to an object of class "c('xts', 'zoo')"

ttrc_total %>% xts::xts(., order.by=.$Date) %>% 
  group_by(category) %>% 
  mutate(ATR_10 = ATR(.[,c("High","Low","Close")], n=10))

Answer 1

I might try to split the data by category and shape it back to long format.

library(TTR)
library(tidyverse)
data(ttrc)
ttrc_total <- rbind(ttrc %>% mutate(category='A'),
                    ttrc %>% mutate(category='B'),
                    ttrc %>% mutate(category='C'))

nested_data <- ttrc_total %>%
  as_tibble() %>%
  group_nest(category)

nested_data <- nested_data %>%
  mutate(atr = map(data, \(x) as.data.frame(ATR(select(x, High, Low, Close), n = 10))))

nested_data
#> # A tibble: 3 × 3
#>   category               data atr             
#>   <chr>    <list<tibble[,6]>> <list>          
#> 1 A               [5,550 × 6] <df [5,550 × 4]>
#> 2 B               [5,550 × 6] <df [5,550 × 4]>
#> 3 C               [5,550 × 6] <df [5,550 × 4]>

atr_df <- bind_rows(nested_data$atr) %>%
  mutate(category = rep(nested_data$category, map_int(nested_data$atr, nrow)))

head(atr_df)
#>     tr atr trueHigh trueLow category
#> 1   NA  NA       NA      NA        A
#> 2 0.07  NA     3.15    3.08        A
#> 3 0.04  NA     3.12    3.08        A
#> 4 0.05  NA     3.12    3.07        A
#> 5 0.04  NA     3.12    3.08        A
#> 6 0.07  NA     3.17    3.10        A

^{Created on 2023-09-01 with reprex v2.0.2}

Answer 2

Using the input in the Note at the end, split the data into individual securities, convert to zoo and then xts, and apply ATR giving a list of xts objects, L. Then optionally convert to a long data frame using bind_rows.

# form list of xts objects each w ATR columns added 
L <- ttrc_total %>%
  { split(.[, -ncol(.)], .$category) } %>%
  lapply(function(x) as.xts(read.zoo(x))) %>%
  lapply(function(x) transform(x, ATR = ATR(x[, c("High","Low","Close")], n=10 ))

long <- bind_rows(lapply(L, fortify.zoo, name = "Date" ), .id = "category")

head(long)
##   category       Date Open High  Low Close  Volume   tr atr trueHigh trueLow
## 1        A 1985-01-02 3.18 3.18 3.08  3.08 1870906   NA  NA       NA      NA
## 2        A 1985-01-03 3.09 3.15 3.09  3.11 3099506 0.07  NA     3.15    3.08
## 3        A 1985-01-04 3.11 3.12 3.08  3.09 2274157 0.04  NA     3.12    3.08
## 4        A 1985-01-07 3.09 3.12 3.07  3.10 2086758 0.05  NA     3.12    3.07
## 5        A 1985-01-08 3.10 3.12 3.08  3.11 2166348 0.04  NA     3.12    3.08
## 6        A 1985-01-09 3.12 3.17 3.10  3.16 3441798 0.07  NA     3.17    3.10

Note

library(dplyr, exclude = c("filter", "lag"))
library(TTR)
library(xts)

# form input
data(ttrc)
ttrc_total <- rbind(ttrc %>% mutate(category = 'A'),
      ttrc %>% mutate(category= 'B'),
      ttrc %>% mutate(category= 'C'))