Purrr реализация For-Loop

Question

Я пытаюсь разработать модель логистической регрессии в R. Я пытаюсь перебрать строки фрейма данных (или таблицы), чтобы я мог умножить подмножество столбцов в этой строке на другой вектор в виде точечного произведения. .

Сначала я попытался выполнить подготовительную работу с использованием векторных функций мурлыканья, но столкнулся с трудностями и решил реализовать ее в цикле for.

Это рабочий дизайн, который у меня есть сFor-Loop:

library(tidyverse)

# Define necessary functions
 lambdaFunc <- function(factors,theta){
 return((1+exp(sum(factors*theta)))^(-1))
}

# y is 0 or 1
# x and theta are a numeric vectors
indiv_likhd <- function(y,x,theta){
 return(lambdaFunc(x,theta)^y*(1-lambdaFunc(x,theta))^(1-y))
}

# Assuming df is dataframe of the form
# Col1                Col2      ...     ColN
# isDefault(0 or 1)   factor1   ...     factorN
likhds <- function(df,theta){
 df <- as.data.frame(df)
 likhds <- vector("numeric",nrow(df))
 for (i in 1:nrow(df)) {
   likhds[i] <- indiv_likhd(df[i,1],df[i,2:ncol(df)],theta)
 }
 return(likhds)
}

То есть

testdf <- tibble(y=c(1,0),x_1=c(1,1),x_2=c(1,1),x_3=c(1,1))
testTheta <- c(1,1,1)
likhds(testdf,testTheta)

дает

[1] 0.04742587 0.95257413

Есть ли способ реализовать это с помощью векторных функций, в частности пакета purr? Это мой первый настоящий вопрос о стековом потоке, поэтому я прошу прощения, если что-то отсутствует или неясно, в таком случае, пожалуйста, дайте мне знать.

Спасибо.

Answer 1

Не изменяя ваши lambdaFunc и indiv_likhd, мы могли бы перезаписать ваш цикл for с помощью pmap

library(dplyr)
library(purrr)

testdf %>%
   mutate(new_col = pmap_dbl(., ~indiv_likhd(c(...)[1], c(...)[-1], testTheta)))

#      y   x_1   x_2   x_3 new_col
#  <dbl> <dbl> <dbl> <dbl>   <dbl>
#1     1     1     1     1  0.0474
#2     0     1     1     1  0.953 

c(...), чтобы захватить все значения, переданные в pmap (здесь вся строка), поэтому c(...)[1] означает первое значение в строке, c(...)[-1] означает все, кроме первых значений в строке.

Answer 2

Вот вариант

f <- function(df, theta) {
    df %>%
        group_by(y) %>%
        nest() %>%
        mutate(likhds = map2_dbl(y, data, function(y, x) indiv_likhd(y, x, theta))) %>%
        pull(likhds)
}
f(testdf, testTheta)
#[1] 0.04742587 0.95257413

Объяснение: Мы nest данных по y, затем используем map2_dbl для циклического перебора пар y и data (которые являются вашимиx значений) для каждой строки и возвращает вывод indiv_likhd в виде вектора double.