Fatal编程技术网
  • r/
  • R-建筑a“；支持的货币“；货币对列表

R-建筑a“；支持的货币“；货币对列表

r

R-建筑a“；支持的货币“；货币对列表,r,R,我正在努力解决R中的一个循环，我不知道如何解决我的问题。我有一个数据框，有三列，如下所示： base_currency quote_currency api_key 1 USD AUD USDAUD13 2 USD CAD USDCAD58 3 EUR CNY EURCNY99 4 EUR

我正在努力解决R中的一个循环，我不知道如何解决我的问题。我有一个数据框，有三列，如下所示：

  base_currency quote_currency       api_key
1           USD            AUD      USDAUD13
2           USD            CAD      USDCAD58
3           EUR            CNY      EURCNY99
4           EUR            CZK      EURCZK65
5           USD            EUR      USDEUR45
6           JPY            HKD      JPYHKD33
7           JPY            RUB      JPYRUB83
这些都是货币对，我有一个数据源通过API获取汇率。如您所见，我可以在
AUD
中转换
USD
（向后），在
CAD中转换
USD
（向后）等等

我不能在
CNY
中直接转换
USD
，但因为我可以在
EUR
中转换
USD
，然后在
CNY
中转换
EUR
，所以我可以使用中间货币对处理转换

使用此系统，我可以使用
USD/AUD
和
USD/CAD
对在
CAD
中类似地转换
AUD
。实际上，前5行中的每种货币都可以转换为同一行中发送的任何货币

我的数据框还可能包含与此“系统”隔离的货币对，如
JPY/HKD
和
JPY/RUB
。通过这些货币对，我可以得到港币/卢布，但仅此而已。第二个货币对“系统”可以链接到第一个货币对的唯一方法是在
base\u currency
列或
quote\u currency
列中共享一种货币

我的目标是定义一个“支持的货币”列表。此列表将包含可转换为该列表中任何其他货币的货币

我可以看到，我的数据框架为该问题提供了两种解决方案：


[1] "USD" "AUD" "CAD" "EUR" "CNY" "CZK"
[2] "JPY" "HKD" "RUB"


我感兴趣的解决方案是第一个，因为它包含“USD”

My real data.frame包含100多个货币对，其中一些是来自不同数据源的冗余货币对

为了向您提供有关上下文的更多信息，我正在使用以下工具构建一个非常基本的股票投资组合管理器：


  • 在设置中，用户可以使用下拉列表指定“投资组合货币”
    • 

  • 将股票添加到投资组合时，用户必须从类似的下拉列表中指定股票的货币
    • 
我真的很想使用“支持的货币”列表来构建下拉菜单，以便在向数据框添加货币对时可以动态更新它们
    
例如，如果我将
    USD/JPY
    添加到数据框中，我的下拉菜单将显示这些选项：
    

    "USD" "AUD" "CAD" "EUR" "CNY" "CZK" "JPY" "HKD" "RUB"

    
这项任务对于我谦逊的R技能来说似乎太复杂了，所以我真的非常感谢您的帮助
    
多谢各位
    
@Cedric
非常感谢你的回答。我编辑了你的代码，添加了额外的假货币对，以检查它的反应和某些不起作用的情况：
    

    v<-"base_currency;quote_currency;api_key
1;USD;AUD;USDAUD13
2;USD;CAD;USDCAD58
3;EUR;CNY;EURCNY99
4;EUR;CZK;EURCZK65
5;USD;EUR;USDEUR45
6;JPY;HKD;JPYHKD33
7;JPY;RUB;JPYRUB83
8;ALL;AKU;ALLAKU24
9;AKU;RRR;AKURRR96
10;KKL;LOI;KKLLOI46"

d<-read.delim(textConnection(v),header=TRUE,sep=";",strip.white=TRUE,stringsAsFactors =F)


## (1) check for values appearing in both columns
## those will be linked
mm <- d$base_currency%in%d$quote_currency | d$quote_currency%in%d$base_currency
currency_both_sides<-unique(c(d$base_currency[mm],d$quote_currency[mm]))
## (2) find remaining (unlinked) matching pairs for those
d1<-d$base_currency[d$quote_currency%in%currency_both_sides]
d2<-d$quote_currency[d$base_currency%in%currency_both_sides]
(common <- unique(c(d1,d2,currency_both_sides)))
# "EUR" "USD" "ALL" "AKU" "AUD" "CAD" "CNY" "CZK" "RRR"
## (3) the other will only appear on one side
## Here I'm showing all but in the end it will be every single value,
## with all it's matching value in the second column
## they will form separate sets
nn <- !d$base_currency%in%common | !d$quote_currency%in%common
(onesided<-unique(c(d$base_currency[nn],d$quote_currency[nn])))
# "JPY" "KKL" "HKD" "RUB" "LOI"

    
现在使用这个向量列表，我需要首先选择每个包含“USD”的向量，因为USD必须是“支持的货币”，所以我需要这些项目：
    

    [[1]]
[1] "USD" "AUD" "CAD" "EUR"

[[2]]
[1] "EUR" "USD" "CNY" "CZK"

[[7]]
[1] "AUD" "USD"

[[8]]
[1] "CAD" "USD"

    
然后我需要组合这些向量，并只选择唯一的事件，我设法这样做：
    

    B <- sapply(A, function(x) is.element('USD', x))
usd_convertible_list <- A[B]
usd_convertible_vector <- Reduce(c, usd_convertible_list)
usd_convertible_vector_unique <- unique(usd_convertible_vector)
usd_convertible_vector_unique

#    "USD" "AUD" "CAD" "EUR" "CNY" "CZK"

    
对于“澳元”：
    
对于“CAD”：
    
等等。对于
    “美元”“澳元”“加元”“欧元”“人民币”“捷克克朗”
    中的每种货币，然后将所有内容合并到一个新向量中，将该向量与前一个向量进行比较，如果出现新货币，则重复该操作
    
当没有新货币添加到该向量时，这意味着列表已完成，循环应停止。以df中提供的货币对为例，列表在第一次运行时就完成了，但如果需要通过多个中间货币对进行转换，我认为需要这个过程
    
比如说
    

    USD    EUR
EUR    CNY
CNY    RUB
RUB    CHF

    
在这种情况下，即使看起来不明显，每种货币都可以转换成任何其他货币。当选择包含USD的第一个向量时，循环需要运行3次
    

    我相信这个过程应该会给我一个我正在寻找的“支持的货币”向量，但我很难将其转化为代码…
    v
    vThank you@Cedric我添加了一些假货币对，以查看代码的反应和某些不起作用的情况。。。我编辑了我的原始帖子，向你展示了它的输出。非常感谢@Cedric！它似乎起作用了。我将更深入地研究您的代码，以了解它是如何工作的。所有的评论都不成问题。再次感谢你！如果遇到问题，请毫不犹豫地询问谢谢@Cedric我添加了一些假货币对，以查看代码的反应和某些不正常情况。。。我编辑了我的原始帖子，向你展示了它的输出。非常感谢@Cedric！它似乎起作用了。我将更深入地研究您的代码，以了解它是如何工作的。所有的评论都不成问题。再次感谢你！如果你遇到了问题，请不要犹豫，我明白你的意思，我在写这篇文章的时候怀疑你可以有两个独立的小组。这很有趣，我会再试一次。@Cedric哈哈，是的，很有趣。这对我来说很有挑战性，但不再那么有趣了。我尝试了很多不同的方法，取得了很大的进步，但还没有成功！我希望它能起作用。我明白你的意思，我在写这篇文章的时候有一个疑问，那就是你可以有两个独立的小组。这很有趣，我会再试一次。@Cedric哈哈，是的，很有趣。这对我来说很有挑战性，但不再那么有趣了。我尝试了很多不同的方法，取得了很大的进步，但还没有成功！我希望它能起作用

    v<-"a;b;c
    1;USD;AUD;USDAUD13
    2;USD;CAD;USDCAD58
    3;EUR;CNY;EURCNY99
    4;EUR;CZK;EURCZK65
    5;USD;EUR;USDEUR45
    6;JPY;HKD;JPYHKD33
    7;JPY;RUB;JPYRUB83
    8;ALL;AKU;ALLAKU24
    9;AKU;RRR;AKURRR96
    10;KKL;LOI;KKLLOI46"
d<-read.delim(textConnection(v),header=TRUE,sep=";",strip.white=TRUE,stringsAsFactors=FALSE)
d<-d[,-3] # not needed
e<-d[,c(2,1)]; colnames(e)<-colnames(d)
f<-rbind(d,e) # since you can run both one way or the other, I create a data
# frame mixing to and fro
require(dplyr)
# this function will left join the df with itself using first and last 
# column
# at some point some lines will produce NA (no matching values)
# we will not join using those values, so I'm splitting the dataframe
# in two and working only with the one without NA in last column
my_left_join <-function(df){
  aa <- first(colnames(df))
  cc <- last(colnames(df))  
  df0 <- df[is.na(df[,ncol(df)]),] # we will not join NA
  df1 <- df[!is.na(df[,ncol(df)]),]
  df1 <- left_join(df1,df1[,c(1,ncol(df1))],by=setNames(aa,cc))
  df0[,last(colnames(df1))]<-rep(NA,nrow(df0))
  df2 <- rbind(df0,df1)
}
(g<-my_left_join(f))
#a   b b.y
#1  USD AUD USD
#2  USD CAD USD
#3  EUR CNY EUR
#4  EUR CZK EUR
#5  USD EUR CNY
#6  USD EUR CZK
#7  USD EUR USD
#8  JPY HKD JPY
#9  JPY RUB JPY
#10 ALL AKU RRR
#11 ALL AKU ALL
# here we see that we might run into loops, so let's remove values already in line
remove_duplicates_inrow <- function(df) {
  df[,ncol(df)]<-apply(df,1,function(X){
        if (X[length(X)]%in%X[1:(length(X)-1)])  X[length(X)]<-NA 
        return( X[length(X)])
      })
  return(df[order(df[ncol(df)]),])
}
(h<-ee(g))
#a   b  b.y
#35 RRR AKU  ALL
#17 CAD USD  AUD
#26 EUR USD  AUD
#15 AUD USD  CAD
#27 EUR USD  CAD
#5  USD EUR  CNY
#23 CZK EUR  CNY
#6  USD EUR  CZK
#21 CNY EUR  CZK
#16 AUD USD  EUR
#19 CAD USD  EUR
#31 RUB JPY  HKD
#10 ALL AKU  RRR
#30 HKD JPY  RUB
#22 CNY EUR  USD
#25 CZK EUR  USD
#1  USD AUD <NA>
#2  USD CAD <NA>
# this function will recursive left join untill there is no matching
# due to the way it is built I have to remove the last two columns
recursive_join <-function (df){
  #print(df)
  #browser()
  df <- my_left_join(df)
  df <- remove_duplicates_inrow(df)
  if (all(is.na(df[,ncol(df)]))){
    return(df[order(df[ncol(df)]),-ncol(df)])
  } else {
    recursive_join(df)
  }
}

i<-recursive_join(f)
# everything is a mix, I sort by row and by col to obtain the right order
# order by row
i<-t(apply(i,1,function(X)X[order(X)]))
# order by all columns, note this is a problem as we don't know in advance
# the number of columns, I have asked a question regarding this.
i<-i[order(i[,1],i[,2],i[,3],i[,4]),]

    

    [[1]]
[1] "USD" "AUD" "CAD" "EUR"

[[7]]
[1] "AUD" "USD"

    

    [[1]]
[1] "USD" "AUD" "CAD" "EUR"

[[8]]
[1] "CAD" "USD"

    

    USD    EUR
EUR    CNY
CNY    RUB
RUB    CHF

    

    v<-"a;b;c
    1;USD;AUD;USDAUD13
    2;USD;CAD;USDCAD58
    3;EUR;CNY;EURCNY99
    4;EUR;CZK;EURCZK65
    5;USD;EUR;USDEUR45
    6;JPY;HKD;JPYHKD33
    7;JPY;RUB;JPYRUB83
    8;ALL;AKU;ALLAKU24
    9;AKU;RRR;AKURRR96
    10;KKL;LOI;KKLLOI46"
d<-read.delim(textConnection(v),header=TRUE,sep=";",strip.white=TRUE,stringsAsFactors=FALSE)
d<-d[,-3] # not needed
e<-d[,c(2,1)]; colnames(e)<-colnames(d)
f<-rbind(d,e) # since you can run both one way or the other, I create a data
# frame mixing to and fro
require(dplyr)
# this function will left join the df with itself using first and last 
# column
# at some point some lines will produce NA (no matching values)
# we will not join using those values, so I'm splitting the dataframe
# in two and working only with the one without NA in last column
my_left_join <-function(df){
  aa <- first(colnames(df))
  cc <- last(colnames(df))  
  df0 <- df[is.na(df[,ncol(df)]),] # we will not join NA
  df1 <- df[!is.na(df[,ncol(df)]),]
  df1 <- left_join(df1,df1[,c(1,ncol(df1))],by=setNames(aa,cc))
  df0[,last(colnames(df1))]<-rep(NA,nrow(df0))
  df2 <- rbind(df0,df1)
}
(g<-my_left_join(f))
#a   b b.y
#1  USD AUD USD
#2  USD CAD USD
#3  EUR CNY EUR
#4  EUR CZK EUR
#5  USD EUR CNY
#6  USD EUR CZK
#7  USD EUR USD
#8  JPY HKD JPY
#9  JPY RUB JPY
#10 ALL AKU RRR
#11 ALL AKU ALL
# here we see that we might run into loops, so let's remove values already in line
remove_duplicates_inrow <- function(df) {
  df[,ncol(df)]<-apply(df,1,function(X){
        if (X[length(X)]%in%X[1:(length(X)-1)])  X[length(X)]<-NA 
        return( X[length(X)])
      })
  return(df[order(df[ncol(df)]),])
}
(h<-ee(g))
#a   b  b.y
#35 RRR AKU  ALL
#17 CAD USD  AUD
#26 EUR USD  AUD
#15 AUD USD  CAD
#27 EUR USD  CAD
#5  USD EUR  CNY
#23 CZK EUR  CNY
#6  USD EUR  CZK
#21 CNY EUR  CZK
#16 AUD USD  EUR
#19 CAD USD  EUR
#31 RUB JPY  HKD
#10 ALL AKU  RRR
#30 HKD JPY  RUB
#22 CNY EUR  USD
#25 CZK EUR  USD
#1  USD AUD <NA>
#2  USD CAD <NA>
# this function will recursive left join untill there is no matching
# due to the way it is built I have to remove the last two columns
recursive_join <-function (df){
  #print(df)
  #browser()
  df <- my_left_join(df)
  df <- remove_duplicates_inrow(df)
  if (all(is.na(df[,ncol(df)]))){
    return(df[order(df[ncol(df)]),-ncol(df)])
  } else {
    recursive_join(df)
  }
}

i<-recursive_join(f)
# everything is a mix, I sort by row and by col to obtain the right order
# order by row
i<-t(apply(i,1,function(X)X[order(X)]))
# order by all columns, note this is a problem as we don't know in advance
# the number of columns, I have asked a question regarding this.
i<-i[order(i[,1],i[,2],i[,3],i[,4]),]

    

    col=""
for (j in 1:ncol(i)){
  col <- paste(col,paste0( 'i[,',j,']' ), sep = "," )
}
## remove first comma
col <- substr(col,2,nchar(col))
i <- eval(parse(text= paste("A[order(",col,",decreasing=TRUE),]")))    



# now we have duplicated 
i<-i[!duplicated(i),]
# OK these duplicates were the easy ones, but we have vectors of different 
length, lets remove vector that are contained in longer vectors  

res<-matrix(i[1, ],1,ncol(i))
for (l in 2:nrow(i)){      
  # comparing line with last in res but remove NA
  # as we have sorted data this works !
  if (!all(i[l,][!is.na(i[l,])]
  %in%
  res[nrow(res),][!is.na(res[nrow(res),])])){    
    res<-rbind(res,i[l,]) 
  }  
}
res
#[,1]  [,2]  [,3]  [,4] 
#[1,] "AKU" "ALL" "RRR" NA   
#[2,] "AUD" "CAD" "EUR" "USD"
#[3,] "CNY" "CZK" "EUR" "USD"
#[4,] "HKD" "JPY" "RUB" NA   
#[5,] "KKL" "LOI" NA    NA