是否有任何 R 包/函数可以实时获取汇率,例如来自 Google Finance?如果已经有相关的内容,我希望避免使用 RCurl 或其他解析器。
具体而言,给定“从”和“到”货币符号的向量,我想知道汇率。类似于:
IdealFunction(c("CAD", "JPY", "USD"), c("USD", "USD", "EUR"))
您可以使用quantmod来获取雅虎报价。(我不确定雅虎外汇报价延迟多久,或者更新频率如何。)
library(quantmod)
from <- c("CAD", "JPY", "USD")
to <- c("USD", "USD", "EUR")
getQuote(paste0(from, to, "=X"))
# Trade Time Last Change % Change Open High Low Volume
#CADUSD=X 2014-11-01 08:23:00 0.8875 N/A N/A N/A N/A N/A N/A
#JPYUSD=X 2014-11-01 08:23:00 0.0089 N/A N/A N/A N/A N/A N/A
#USDEUR=X 2014-11-01 08:23:00 0.7985 N/A N/A N/A N/A N/A N/A
如果您注册一个免费帐户,可以使用市场约定(即 USD/JPY 而不是 JPY/USD)获取实时、毫秒级的时间戳行情。或者选择 TFX。
library(TFX)
pairs <- paste(to, from, sep="/")
QueryTrueFX(ConnectTrueFX(pairs, "validUser", "anytext"))
# Symbol Bid.Price Ask.Price High Low TimeStamp
#1 USD/CAD 1.12651 1.12665 1.12665 1.12651 2014-10-31 20:45:00.559
#2 USD/JPY 112.34600 112.35900 112.35900 112.34600 2014-10-31 20:45:00.134
#3 EUR/USD 1.25234 1.25253 1.25253 1.25234 2014-10-31 20:45:00.598
如果您有一个交互式经纪商账户,您可以使用IBrokers软件包,或者我的twsInstrument软件包(它基本上只是对IBrokers函数的封装)
library(twsInstrument)
getQuote(paste0(to, from), src="IB") # only works when market is open.
qt <- QueryTrueFX(); qt[qt$Symbol %in% paste(to, from, sep="/"),]
,但你仍然需要知道是否需要将货币对反过来引用,或者有一些逻辑来判断哪个存在。 - GSeeoptions(download.file.method="wget"); getFX("USD/JPY")
。 - GSeepriceR
库的 historical_exchange_rates()
函数。# install.packages("priceR")
library(priceR)
cur <- historical_exchange_rates("AUD", to = "USD",
start_date = "2010-01-01", end_date = "2020-06-30")
tail(cur)
date one_AUD_equivalent_to_x_USD
2020-06-25 0.688899
2020-06-26 0.686340
2020-06-27 0.686340
2020-06-28 0.685910
2020-06-29 0.687335
2020-06-30 0.690166
dim(cur)
[1] 3834 2
# Plot USD vs AUD last 10 years
library(ggplot2)
library(tidyverse)
cur %>%
tail(365 * 10) %>%
rename(aud_to_usd = one_AUD_equivalent_to_x_USD) %>%
mutate(date = as.Date(date)) %>%
ggplot(aes(x = date, y = aud_to_usd, group = 1)) +
geom_line() +
geom_smooth(method = 'loess') +
theme(axis.title.x=element_blank(),
axis.ticks.x=element_blank()) +
scale_x_date(date_labels = "%Y", date_breaks = "1 year")
看起来TFX
和quantmod
都有相关的功能(感谢@RStudent和@KFB的提示)。我更喜欢使用quantmod
,因为它不需要设置账户,但据我所知,它没有像我所需要的那样进行矢量化的当前快照功能。这个函数GetExchangeRates
可以做到这一点:
GetExchangeRates <- function(from, to, dt=Sys.Date()) {
require(quantmod)
obj.names <- getFX(paste0(from, "/", to), from=dt, to=dt)
result <- numeric(length(obj.names))
names(result) <- obj.names
for (obj.name in obj.names) {
result[obj.name] <- as.numeric(get(obj.name))[1]
# Clean up
rm(obj.name)
}
return(result)
}
TestExchangeRates <- function() {
from <- c("CAD", "JPY", "USD")
to <- c("USD", "USD", "EUR")
GetExchangeRates(from, to)
}
getFX
对于历史请求非常好用,但它只会每天更新一次。 - GSeegetSymbols
和getFX
:
这似乎是真的,因为这里构建的平均值更接近外汇市场,而不是"注意quantmod::getFX返回的是OANDA的中间价格"
getSymbol
的"Adjusted column"(其他测试显示相同趋势,未显示)。from_curr <- c("CAD", "JPY", "USD")
to_curr <- c("USD", "USD", "EUR")
library(quantmod)
# this dates will not work currently see above
res <- GetExchangeRates(from_curr = from_curr, to_curr = to_curr, "2023-05-03", "2023-05-09")
# artificial avg_low_high_this_fun column vs FX:
sum(abs(res$FX - res$avg), na.rm = T)
0.005812667
# Adjusted_Sy == Close == Open ? vs FX:
sum(abs(res$FX - res$Adjusted_Sy), na.rm = T)
0.01492536
# inspired in other answer:
require(quantmod)
require(dplyr)
require(stringr)
require(rlang)
require(tibble)
GetExchangeRates <- function(from_curr, to_curr, from_date, to_date = from_date) {
exchanges <- paste0(from_curr, "/", to_curr)
result_getFX <- mapply(
function(from_curr, to_curr) {
ready_name <- paste0(from_curr, ".", to_curr)
getFX(paste0(from_curr, "/", to_curr),
from = from_date,
to = to_date,
src = "yahoo",
auto.assign = FALSE
) |>
as.list() |>
as.data.frame() |>
rownames_to_column(var = "date") |>
set_names(~ (.) |> paste0("FX")) |>
set_names(~ (.) |> str_replace_all(ready_name, ""))
},
from_curr, to_curr,
SIMPLIFY = F
)
names(result_getFX) <- exchanges
result_getFX <- result_getFX |> bind_rows(.id = "exchange")
result_getSymbols <- try(get_exchange_rates_symbol(from_curr, to_curr, from_date, to_date), silent = TRUE)
if (inherits(result_getSymbols, "try-error")) {
warning("getSymbol unavailable for weekends or between two non-dollar currencies")
return(result_getFX)
}
merge(result_getFX, result_getSymbols,
by.y = c("exchange", "date_input"), by.x = c("exchange", "dateFX"),
all = TRUE
)
}
get_exchange_rates_symbol <- function(from_curr, to_curr, from_date, to_date = from_date) {
exchanges <- paste0(from_curr, "/", to_curr)
result_getSymbols <- mapply(
function(from_curr, to_curr) {
ready_name <- paste0(from_curr, to_curr)
getSymbols(paste0(ready_name, "=X"),
src = "yahoo", auto.assign = FALSE,
from = as.Date(from_date), to = as.Date(to_date)
) |>
as.list() |>
as.data.frame() |>
rownames_to_column(var = "date") |>
set_names(~ (.) |> str_replace_all(".X", "")) |>
rowwise() |>
mutate("{ready_name}.avg_low_high_this_fun" := mean(c(
.data[[paste0(ready_name, ".Low")]],
.data[[paste0(ready_name, ".High")]]
), na.rm = TRUE)) |>
set_names(~ (.) |> str_replace_all(paste0(ready_name, "."), "")) |>
set_names(~ (.) |> paste0("_Sy")) |>
mutate(date_input = ifelse(
as.Date(date_Sy) < as.Date("2023-10-30"),
as.character(as.Date(date_Sy) + 1),
date_Sy
)) |>
relocate(date_input, .before = date_Sy) |>
relocate(avg_low_high_this_fun_Sy, .after = date_input)
},
from_curr, to_curr,
SIMPLIFY = FALSE
)
names(result_getSymbols) <- exchanges
result_getSymbols <- result_getSymbols |>
bind_rows(.id = "exchange") |>
as.data.frame()
result_getSymbols
}
TFX
包。 - DatamineR