Как избежать зацикливания с помощью R с помощью Apply (?)

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

Я взял на себя смелость с вашим кодом b / c. Я пытаюсь векторизовать циклы использования тисков всякий раз, когда могу ... С помощью функции merge вы объединяете два фрейма данных и работаете с «столбцами», что использовать векторизацию, встроенную в R. Я думаю, что это будет делать то, что вы хотите (во второй строке я просто проверяю, что A и B не имеют одинаковых значений для height и age чтобы ваше расстояние не всегда равнялось нулю):

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, многовариантная форма применения:

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))