Apply (?)를 사용하여 R을 사용하는 루프 방지

Question

데이터 집합의 각 행에 함수를 적용하려고합니다. 이 함수는 두 번째 데이터 집합에서 일치하는 행을 조회하고 전달 된 제품 세부 정보에 대한 유사성 점수를 계산합니다.

방금 ​​테스트 번호로 호출하면 함수가 작동하지만 내 데이터 집합의 모든 행에서이를 실행하는 방법을 알 수 없습니다. 나는 apply를 사용해 보았지만 작동시키지 못했다.

역사적인 데이터에 가장 적합한 데이터를 찾기 위해 다른 매개 변수 설정을 반복하여 속도가 중요하므로 ... 루프가 있음을 의미합니다. 당신이 제공 할 수있는 도움은 대단히 감사하겠습니다.

감사합니다. 앨런

GetDistanceTest <- function(SnapshotDate, Cand_Type, Cand_Height, Cand_Age) { 
    HeightParam <- 1/5000 
     AgeParam <- 1 
    Stock_SameType <- HistoricalStock[!is.na(HistoricalStock$date) & !is.na(HistoricalStock$Type) & as.character(HistoricalStock$date)==as.character(SnapshotDate) & HistoricalStock$Type==Cand_Type,] 

    Stock_SameType$ED <- (HeightParam*(Stock_SameType$Height - Cand_Height))^2 + (AgeParam*(Stock_SameType$Age - Cand_Age))^2 

    return(sqrt(sum(Stock_SameType$ED))) 

} 

HistoricalStock <- HistoricalAQStock[,c(1, 3, 4, 5)] 
colnames(HistoricalStock) <- c("date", "Age", "Height", "Type") 
Sales <- AllSales[,c(2,10,11,25)] 
colnames(Sales) <- c("date", "Age", "Height", "Type") 

GetDistanceTest("2010-04-01", 5261, 12, 7523) #works and returns a single number 

res1 <- transform(Sales, ClusterScore=GetDistanceTest(date, Type, Height, Age)) 
     # returns Error in `$<-.data.frame`(`*tmp*`, "ED", value = c(419776714.528591, 22321257.0276852, : replacement has 4060 rows, data has 54 
    # also 4 warnings, one for each variable. e.g. 1: In as.character(HistoricalStock$date) == as.character(SnapshotDate) : longer object length is not a multiple of shorter object length 

res2 <- apply(Sales, 1, GetDistanceTest, Sales$Type, Sales$Height, Sales$Age) 
    # `$<-.data.frame`(`*tmp*`, "ED", value = c(419648071.041523, 22325941.2704261, : replacement has 4060 rows, data has 13 
    # also same 4 warnings as res1 

Answer 1

나는 내가 ...을 merge 기능을 사용하면 두 데이터 프레임을 병합 할 수 있습니다 때마다 그 사용이 루프 벡터화하고, "열"에서 작동하도록 시도 C/B 코드와 함께 약간의 자유를했다 R에 내장 된 벡터화를 사용할 수 있습니다. 두 번째 줄에서는 A 및 B에 height 및 age에 대해 동일한 값이 없도록하여 두 번째 줄에서 거리가 항상 0이 아님) :

A <- B <- data.frame(date=Sys.Date()-9:0, stock=letters[1:10], type=1:10, height=1:10, age=1:10) 
B$height <- B$age <- 10:1 
AB <- merge(x=A, y=B, by=c("date", "type"), suffixes=c(".A", ".B")) 
height.param <- 1/5000 
age.param <- 1 
temp <- sqrt(height.param * (AB$height.A - AB$height.B)^2 + age.param * (AB$age.A - AB$age.B)^2) 

Answer 2

mapply, multiv 적용의 ariate 형태 :

res1 <- mapply(GetDistanceTest, Sales$date, Sales$Type, Sales$Height, Sales$Age) 

Answer 3

코드 위의 의견에 따라 :

A <- data.frame(date=rep(Sys.Date()-9:0,100), id=letters[1:10], type=floor(runif(1000, 1, 10)), height=runif(1000, 1, 100), age=runif(1000, 1, 100)) 
B <- data.frame(date=rep(Sys.Date()-9:0,1000), type=floor(runif(10000, 1, 10)), height=runif(10000, 1, 10), age=runif(10000, 1, 10)) 



AB <- merge(x=A, y=B, by=c("date", "type"), suffixes=c(".A", ".B")) 
height.param <- 1 
age.param <- 1 
AB$ClusterScore <- sqrt(height.param * (AB$height.A - AB$height.B)^2 + age.param * (AB$age.A - AB$age.B)^2) 
Scores <- ddply(AB, c("id"), function(df)sum(df$ClusterScore))