r - 如何在路径图上仅显示重要的路径线？ [R : lavaan, semPlot]

Question

我想对我使用 lavaan 制作的路径图进行更改和 semPlot包。

require(lavaan); require(semPlot)
head(mtcars)
model <-'
mpg ~ hp + gear + cyl
hp ~ cyl + disp
'
fit <- sem(model, "std", data = mtcars)
semPaths(fit, "std", fade = F, residuals = F)

因为 mpg <- gear和 mpg <- cyl不重要，我希望以透明的方式显示它(例如，将 * 添加到重要路径或防止不重要的路径出现在路径图上)。有没有办法做到这一点？

感谢您的支持!

Answer 1

我知道这是一个旧线程，但我在寻找这个时发现了它，并认为我应该为其他人提供我的解决方案。

require(lavaan); require(semPlot) ; require(tidyverse)
#> Loading required package: lavaan
#> This is lavaan 0.6-3
#> lavaan is BETA software! Please report any bugs.
#> Loading required package: semPlot
#> Registered S3 methods overwritten by 'huge':
#>   method    from   
#>   plot.sim  BDgraph
#>   print.sim BDgraph
#> Loading required package: tidyverse
model <-'
mpg ~ hp + gear + cyl
hp ~ cyl + disp
'
fit <- sem(model, "std", data = mtcars)

# got this warning, but simply ignored it.
#> Warning in lav_partable_check(lavpartable, categorical =
#> lavoptions$categorical, : lavaan WARNING: parameter table does not contain
#> thresholds

lavaan::standardizedSolution(fit) %>% dplyr::filter(!is.na(pvalue)) %>% arrange(desc(pvalue)) %>% mutate_if("is.numeric","round",3) %>% select(-ci.lower,-ci.upper,-z)
#>   lhs op  rhs est.std    se pvalue
#> 1 mpg  ~ gear   0.022 0.087  0.801
#> 2 mpg  ~  cyl  -0.166 0.260  0.524
#> 3 mpg  ~   hp  -0.694 0.242  0.004
#> 4  hp ~~   hp   0.101 0.034  0.003
#> 5  hp ~1       -2.674 0.600  0.000
#> 6  hp  ~ disp   0.444 0.094  0.000
#> 7  hp  ~  cyl   0.529 0.098  0.000
#> 8 mpg ~1        4.514 0.751  0.000
#> 9 mpg ~~  mpg   0.258 0.039  0.000

pvalue_cutoff <- 0.05

obj <- semPlot:::semPlotModel(fit)

# save a copy of the original, so we can compare it later and be sure we removed only what we intended to remove
original_Pars <- obj@Pars

check_Pars <- obj@Pars %>% dplyr::filter(!(edge %in% c("int","<->") | lhs == rhs)) # this is the list of paramater to sift thru
keep_Pars <- obj@Pars %>% dplyr::filter(edge %in% c("int","<->") | lhs == rhs) # this is the list of paramater to keep asis
test_against <- lavaan::standardizedSolution(fit) %>% dplyr::filter(pvalue < pvalue_cutoff, rhs != lhs)
test_against_rev <- test_against %>% rename(rhs2 = lhs,   # for some reason, the rhs and lhs are reversed in the standardizedSolution() output, for some of the values
                                            lhs = rhs) %>% # I'll have to reverse it myself, and test against both orders
    rename(rhs = rhs2)
checked_Pars <-
    check_Pars %>% semi_join(test_against, by = c("lhs", "rhs")) %>% bind_rows(
        check_Pars %>% semi_join(test_against_rev, by = c("lhs", "rhs"))
    )

obj@Pars <- keep_Pars %>% bind_rows(checked_Pars)

#let's verify by looking at the list of the edges we removed from the object
anti_join(original_Pars,obj@Pars)
#> Joining, by = c("label", "lhs", "edge", "rhs", "est", "std", "group", "fixed", "par")
#>   label  lhs edge rhs        est        std group fixed par
#> 1       gear   ~> mpg  0.1582792  0.0218978       FALSE   2
#> 2        cyl   ~> mpg -0.4956938 -0.1660012       FALSE   3

# great, let's plot
semPlot::semPaths(obj, "std",fade = F, residuals = F)

请注意，这是高度修补的，应根据您的需要修改排除标准(尤其是 (edge %in% c("int","<->") 部分)

创建于 2019-07-09 由 reprex package (v0.3.0)

已编辑 session_info()

#>  lavaan       * 0.6-3     2018-09-22 [1] CRAN (R 3.6.0)
#>  semPlot      * 1.1.1     2019-04-05 [1] CRAN (R 3.6.0)
#>  tidyverse    * 1.2.1     2017-11-14 [1] CRAN (R 3.6.0)