问题：
如何在嵌套的tibble中存储的模型上获得链接函数的逆函数（使用$family$linkinv)？
贡英华
library(tidyverse)
library(magrittr)
set.seed(123)
fruit_liking_df <-
data.frame(
id = 1:100,
i_love_apple = sample(c(1:5), 100, replace = TRUE),
i_love_banana = sample(c(1:5), 100, replace = TRUE),
i_love_mango = sample(c(1:5), 100, replace = TRUE),
age = sample(c(20:70), 100, replace = TRUE),
is_male = sample(c(0, 1), 100, prob = c(0.2, 0.8), replace = TRUE),
education_level = sample(c(1:4), 100, replace = TRUE),
is_colorblinded = sample(c(0, 1), 100, replace = TRUE)
)
> as_tibble(fruit_liking_df)
## # A tibble: 100 x 8
## id i_love_apple i_love_banana i_love_mango age is_male education_level is_colorblinded
## <int> <int> <int> <int> <int> <dbl> <int> <dbl>
## 1 1 3 5 2 50 1 2 0
## 2 2 3 3 1 49 1 1 0
## 3 3 2 1 5 70 1 1 1
## 4 4 2 2 5 41 1 3 1
## 5 5 3 1 1 49 1 4 0
## 6 6 5 2 1 29 0 1 0
## 7 7 4 5 5 35 1 3 0
## 8 8 1 3 5 24 0 3 0
## 9 9 2 4 2 55 1 2 0
## 10 10 3 4 2 69 1 4 0
## # ... with 90 more rows
fruit_liking_df %<>%
mutate_at(vars(starts_with("i_love_")), ~ subtract(., 1) %>% divide_by(., 4))
> as_tibble(fruit_liking_df)
## # A tibble: 100 x 8
## id i_love_apple i_love_banana i_love_mango age is_male education_level is_colorblinded
## <int> <dbl> <dbl> <dbl> <int> <dbl> <int> <dbl>
## 1 1 0.5 1 0.25 50 1 2 0
## 2 2 0.5 0.5 0 49 1 1 0
## 3 3 0.25 0 1 70 1 1 1
## 4 4 0.25 0.25 1 41 1 3 1
## 5 5 0.5 0 0 49 1 4 0
## 6 6 1 0.25 0 29 0 1 0
## 7 7 0.75 1 1 35 1 3 0
## 8 8 0 0.5 1 24 0 3 0
## 9 9 0.25 0.75 0.25 55 1 2 0
## 10 10 0.5 0.75 0.25 69 1 4 0
## # ... with 90 more rows
## will be needed later
my_new_data_for_pred <- expand_grid(
age = 45,
is_male = .5,
education_level = 2.5,
is_colorblinded = 0.5
)
## will be needed later
critval <- 1.96
model_fits_grouped <-
fruit_liking_df %>%
pivot_longer(starts_with("i_love"), values_to = "fruit") %>%
group_by(name) %>%
tidyr::nest() %>%
mutate(model_fit = map(
data,
~ glm(
data = .x,
fruit ~ I(age - 45) +
I((age - 45) ^ 2) +
I(is_male - .5) +
I(education_level - 2) +
is_colorblinded,
family = quasibinomial
)
)) %>%
mutate(predicted_values = map(
model_fit,
~ bind_cols(my_new_data_for_pred,
as.data.frame(
predict(
newdata = my_new_data_for_pred,
.x,
type = "link",
interval = "confidence",
level = 0.95,
se.fit = T
)
)) %>%
rowwise() %>%
mutate(
estimate = fit,
lower_ci_link = fit - critval * se.fit,
upper_ci_link = fit + critval * se.fit
)
))
> model_fits_grouped
## # A tibble: 3 x 4
## # Groups: name [3]
## name data model_fit predicted_values
## <chr> <list> <list> <list>
## 1 i_love_apple <tibble [100 x 6]> <glm> <tibble [1 x 10]>
## 2 i_love_banana <tibble [100 x 6]> <glm> <tibble [1 x 10]>
## 3 i_love_mango <tibble [100 x 6]> <glm> <tibble [1 x 10]>
解嵌套predicted_values获取：
> model_fits_grouped %>% unnest(predicted_values)
## # A tibble: 3 x 13
## # Groups: name [3]
## name data model_fit age is_male education_level is_colorblinded fit se.fit residual.scale estimate lower_ci_link upper_ci_link
## <chr> <list> <list> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 i_love_apple <tibble [100 x 6~ <glm> 45 0.5 2.5 0.5 0.0843 0.261 0.709 0.0843 -0.427 0.595
## 2 i_love_banana <tibble [100 x 6~ <glm> 45 0.5 2.5 0.5 -0.0718 0.286 0.781 -0.0718 -0.633 0.489
## 3 i_love_mango <tibble [100 x 6~ <glm> 45 0.5 2.5 0.5 -0.140 0.279 0.762 -0.140 -0.687 0.407
问题是：现在，我想在predicted_values中再修改两列，用于lower_ci_link和upper_ci_link的反向链接转换，但这失败了
model_fits_grouped <-
fruit_liking_df %>%
pivot_longer(starts_with("i_love"), values_to = "fruit") %>%
group_by(name) %>%
tidyr::nest() %>%
mutate(model_fit = map(
data,
~ glm(
data = .x,
fruit ~ I(age - 45) +
I((age - 45) ^ 2) +
I(is_male - .5) +
I(education_level - 2) +
is_colorblinded,
family = quasibinomial
)
)) %>%
mutate(predicted_values = map(
model_fit,
~ bind_cols(my_new_data_for_pred,
as.data.frame(
predict(
newdata = my_new_data_for_pred,
.x,
type = "link",
interval = "confidence",
level = 0.95,
se.fit = T
)
)) %>%
rowwise() %>%
mutate(
estimate = fit,
lower_ci_link = fit - critval * se.fit,
upper_ci_link = fit + critval * se.fit
) %>%
######################### this addition fails ###########################
mutate(
lower_ci_inverse_link = model_fit$family$linkinv(lower_ci_link),
upper_ci_inverse_link = model_fit$family$linkinv(upper_ci_link)
)
#########################################################################
))
我得到：
-
null
如何使用model_fit$family$linkinv(lower_ci_link)和model_fit$family$linkinv(upper_ci_link)在predicted_values中更改反向链接列，最终获得（滚动到最右边的两列）：
> model_fits_grouped %>% unnest(predicted_values)
## # A tibble: 3 x 15
## # Groups: name [3]
## name data model_fit age is_male education_level is_colorblinded fit se.fit residual.scale estimate lower_ci_link upper_ci_link lower_ci_inverse_link_*DEMO* upper_ci_inverse_link_*DEMO*
## <chr> <list> <list> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 i_love_apple <tibble [100 x 6]> <glm> 45 0.5 2.5 0.5 0.521 0.0632 0.349 0.521 0.397 0.645 0.111 0.111
## 2 i_love_banana <tibble [100 x 6]> <glm> 45 0.5 2.5 0.5 0.482 0.0701 0.387 0.482 0.345 0.620 0.222 0.222
## 3 i_love_mango <tibble [100 x 6]> <glm> 45 0.5 2.5 0.5 0.465 0.0683 0.377 0.465 0.331 0.599 0.333 0.333
演示我如何在没有管道或数据帧的情况下得到我想要的东西
下面的方法依赖于为沿途的几个步骤赋值变量。为了演示起见，它展示了如何运行模型，并仅为一个水果获得$family$linkinv。
与前面一样，在对小数进行算术转换之后，它是fruit_liking_df，因此：
> as_tibble(fruit_liking_df)
## # A tibble: 100 x 8
## id i_love_apple i_love_banana i_love_mango age is_male education_level is_colorblinded
## <int> <dbl> <dbl> <dbl> <int> <dbl> <int> <dbl>
## 1 1 0.5 1 0.25 50 1 2 0
## 2 2 0.5 0.5 0 49 1 1 0
## 3 3 0.25 0 1 70 1 1 1
## 4 4 0.25 0.25 1 41 1 3 1
## 5 5 0.5 0 0 49 1 4 0
## 6 6 1 0.25 0 29 0 1 0
## 7 7 0.75 1 1 35 1 3 0
## 8 8 0 0.5 1 24 0 3 0
## 9 9 0.25 0.75 0.25 55 1 2 0
## 10 10 0.5 0.75 0.25 69 1 4 0
## # ... with 90 more rows
我将只关注i_love_apple列数据，并对其运行glm。
my_model <-
glm(
i_love_apple ~
I(age - 45) +
I((age - 45) ^ 2) +
I(is_male - 0.5) +
I(education_level - 2) +
I(is_colorblinded - 0.5),
family = quasibinomial,
data = fruit_liking_df
)
现在，我使用来自my_new_data_for_pred的预测数据在my_model上运行predicat():
prediction_link_type <-
predict(object = my_model,
newdata = my_new_data_for_pred,
type = "link", ## <------------ type = "link" is crucial to note
interval = "confidence",
level = 0.95,
se.fit = TRUE)
> prediction_link_type
## $fit
## 1
## 0.08427577
## $se.fit
## [1] 0.2606326
## $residual.scale
## [1] 0.7090294
现在，我将在prediction_link_type中获得的SE度量值乘以critval（已赋值1.96)，将SE度量值转换为置信区间(CI)。我分配了两个独立的向量：一个具有上界CI，另一个具有下界CI：
lower_ci_link <- prediction_link_type$fit - (critval * prediction_link_type$se.fit)
upper_ci_link <- prediction_link_type$fit + (critval * prediction_link_type$se.fit)
快到了！我得到了配置项值，但它们在“link”空间中（因为predict()使用了type=“link”)。要将配置项值从“link”转换回来，我使用反向链接函数：
lower_ci_inverse_link <- my_model$family$linkinv(lower_ci_link)
upper_ci_inverse_link <- my_model$family$linkinv(upper_ci_link)
概括地说
虽然这个“向量”方法完成了工作，但它不是我想要的。相反，我想通过本问题开头介绍的管道合并“link->se->ci->inverseLink”的转换。
共有1个答案
郑承恩
要引用在map中传递的数据，需要使用.x。试试下面的答案。
library(tidyverse)
result <- fruit_liking_df %>%
pivot_longer(starts_with("i_love"), values_to = "fruit") %>%
group_by(name) %>%
tidyr::nest() %>%
mutate(model_fit = map(
data,
~ glm(
data = .x,
fruit ~ I(age - 45) +
I((age - 45) ^ 2) +
I(is_male - .5) +
I(education_level - 2) +
is_colorblinded,
family = quasibinomial
)
)) %>%
mutate(predicted_values = map(
model_fit,
~ bind_cols(my_new_data_for_pred,
as.data.frame(
predict(
newdata = my_new_data_for_pred,
.x,
type = "link",
interval = "confidence",
level = 0.95,
se.fit = T
)
)) %>%
rowwise() %>%
mutate(
estimate = fit,
lower_ci_link = fit - critval * se.fit,
upper_ci_link = fit + critval * se.fit,
lower_ci_inverse_link = .x$family$linkinv(lower_ci_link),
upper_ci_inverse_link = .x$family$linkinv(upper_ci_link)
)))
结果如下所示：
result
# name data model_fit predicted_values
# <chr> <list> <list> <list>
#1 i_love_apple <tibble [100 × 6]> <glm> <tibble [1 × 12]>
#2 i_love_banana <tibble [100 × 6]> <glm> <tibble [1 × 12]>
#3 i_love_mango <tibble [100 × 6]> <glm> <tibble [1 × 12]>
要将所有值作为单独的列获取，可以使用unnest_wider:
result %>% unnest_wider(predicted_values)
# name data model_fit age is_male education_level is_colorblinded fit se.fit
# <chr> <lis> <list> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#1 i_lo… <tib… <glm> 45 0.5 2.5 0.5 0.0843 0.261
#2 i_lo… <tib… <glm> 45 0.5 2.5 0.5 -0.0718 0.286
#3 i_lo… <tib… <glm> 45 0.5 2.5 0.5 -0.140 0.279
# … with 6 more variables: residual.scale <dbl>, estimate <dbl>, lower_ci_link <dbl>,
# upper_ci_link <dbl>, lower_ci_inverse_link <dbl>, upper_ci_inverse_link <dbl>
类似资料：
-
在Javascript中调用顶级函数时，函数中的this关键字引用默认对象（如果在浏览器中，则为窗口）。我的理解是，这是作为方法调用函数的一种特殊情况，因为默认情况下，它是在窗口上调用的（如John Resig的书《JavaScript忍者的秘密》第49页所述）。实际上，下面代码中的两个调用是相同的。 到目前为止还不错...这是我不明白的部分： 当一个函数嵌套在另一个函数中并在未指定要调用的对象的
-
本文向大家介绍JavaScript中的函数嵌套使用，包括了JavaScript中的函数嵌套使用的使用技巧和注意事项，需要的朋友参考一下 在JavaScript1.2之前，函数定义是只允许在顶层全局代码，但1.2的JavaScript可以嵌套函数定义其他函数中也是可以的。 仍然存在的函数定义可以循环或条件之内不会出现限制。在函数定义这些限制只适用于函数声明与函数语句。 函数文本(在JavaScri
-
问题内容： Java编程语言是否有任何扩展使创建嵌套函数成为可能？在很多情况下，我需要创建在另一个方法或for循环的上下文中仅使用一次的方法。到目前为止，尽管用Javascript可以很容易地完成，但我迄今仍无法完成。 例如，这无法在标准Java中完成： 问题答案： Java 8引入了lambda。 该语法可在定义了一种方法的任何接口上使用。因此，您可以将其与一起使用，但不能与一起使用。 是jav
-
问题内容： 我试图理解reactjs中的一些概念，但是我无法理解函数的嵌套。我创建了以下示例来调查我的担忧。 在下面的示例中，我呈现了一些内容，这些内容的价值来自一系列嵌套函数。但是，出现错误“未捕获的TypeError：无法读取未定义的属性’renderInnerContent’”。您能帮我了解发生了什么以及如何解决此问题吗？我的主要动机是了解如何将事物抽象为不同的功能。 问题答案： 未在该函数
-
很抱歉，如果这是一个简单的问题，我对Node和Sinon相对较新。我正在努力弄清楚如何断言在Nodejs中调用了嵌套异步函数。 我用的是摩卡、柴、西农和请求(https://github.com/request/request)但我想我缺少了一些关于存根部分的基本信息。 my_app.js内的例子- 测试内部。我试图取消对请求的调用，并提供一些虚拟数据以返回。但我在创建存根的行中不断收到一个错误“