如何在路径图上仅显示重要的路径线？ [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","<->")部分）修改排除标准

^{由reprex package（v0.3.0）于2019-07-09创建}

已编辑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)