简体   繁体   English

在用户定义的函数中使用Apply in R

[英]using apply in R with a user defined function

I am trying to apply the user defined function augenSpike over a set of tickers stored in an environment but somehow it is not working. 我正在尝试将用户定义的函数augenSpike应用于存储在环境中的一组自动收录器中,但是不知何故它不起作用。 If someone can help this entry level R user, I would much appreciated... 如果有人可以帮助此入门级R用户,我将不胜感激...

library(quantmod)

slideapply <- function(x, n, FUN=sd) {
  v <- c(rep(NA, length(x)))
  for (i in n:length(x) ) {
    v[i] <- FUN(x[(i-n+1):i])
  } 
  return(v)   
}

augenSpike <- function(x, n=20) {
  prchg <- c(NA, diff(x))
  lgchg <- c(NA, diff(log(x)))
  stdevlgchg <- slideapply(lgchg, n, sd)
  stdpr <- x * stdevlgchg
  #shuffle things up one
  stdpr <- c(NA, stdpr[-length(stdpr)])
  spike <- prchg / stdpr
  return(spike)
}
myenv <- new.env()
# environment used to store tickers
tickers <- c("PBR", "AAPL", "MSFT", "GOOG")
getSymbols(tickers, env= myenv)
sp <-tickers['2013/2014']
asp <- augenSpike(as.vector(Cl(sp)))
sp$spike <- asp


## Create a vector of colors selected based on whether x is <0 or >0
## (FALSE + 1 -> 1 -> "blue";    TRUE + 1 -> 2 -> "red")
cols <- c("blue", "red" ) [(sp$spike > 0) +  1]

barplot(sp['2013-2014']$spike, col= cols, main="Augen Price Spike", xlab="Time Daily",ylab="Price Spike in Std Dev")
abline(h = 2, col = "red")
abline(h = 0, col = "black")
abline(h = -2, col = "red")

In the provided code snippet, sp is NA, which causes Cl(sp) to fail. 在提供的代码段中, sp为NA,这会导致Cl(sp)失败。 The reason for this is that tickers is still a vector of strings and not the xts object representing the stock symbol. 这样做的原因是, tickers器仍然是字符串的向量,而不是代表股票代码的xts对象。 The xts objects are inaccessible because of the use of the custom environment. 由于使用自定义环境,因此无法访问xts对象。 In the absence of that environment, new variables named after the stock symbols are added to scope. 在没有这种环境的情况下,将以股票代号命名的新变量添加到范围中。 You can make a secondary vector of the xts objects, and then subscript that with '2013/2014' . 您可以创建xts对象的辅助向量,然后用'2013/2014'下标。 The following script should do what you want: 以下脚本应执行您想要的操作:

library(quantmod)

slideapply <- function(x, n, FUN=sd) {
  v <- c(rep(NA, length(x)))
  for (i in n:length(x) ) {
    v[i] <- FUN(x[(i-n+1):i])
  } 
  return(v)   
}

augenSpike <- function(x, n=20) {
  prchg <- c(NA, diff(x))
  lgchg <- c(NA, diff(log(x)))
  stdevlgchg <- slideapply(lgchg, n, sd)
  stdpr <- x * stdevlgchg
  #shuffle things up one
  stdpr <- c(NA, stdpr[-length(stdpr)])
  spike <- prchg / stdpr
  return(spike)
}

tickers <- c("PBR", "AAPL", "MSFT", "GOOG")
getSymbols(tickers)
ticker_symbols <- c(PBR, AAPL, MSFT, GOOG)

sp <-ticker_symbols['2013/2014']
asp <- augenSpike(as.vector(Cl(sp)))
sp$spike <- asp


## Create a vector of colors selected based on whether x is <0 or >0
## (FALSE + 1 -> 1 -> "blue";    TRUE + 1 -> 2 -> "red")
cols <- c("blue", "red" ) [(sp$spike > 0) +  1]

barplot(sp['2013-2014']$spike, col= cols, main="Augen Price Spike", xlab="Time Daily",ylab="Price Spike in Std Dev")
abline(h = 2, col = "red")
abline(h = 0, col = "black")
abline(h = -2, col = "red")

Which produces this lovely graphic: 产生以下可爱的图形: R脚本的输出

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

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