├── .gitattributes ├── tests ├── testthat.R └── testthat │ └── test.flatworm.R ├── data ├── ABC.RData └── RankCorr.RData ├── .gitignore ├── .Rbuildignore ├── man ├── ABC.Rd ├── RankCorr.Rd └── flatworm.Rd ├── R ├── global_variables.R ├── data.R ├── util.rethinking.R └── flatworm.R ├── inst └── CITATION ├── NAMESPACE ├── .travis.yml ├── DESCRIPTION ├── README.md └── vignettes └── flatworm.Rmd /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto 2 | 3 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | test_check("flatworm") 3 | -------------------------------------------------------------------------------- /data/ABC.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjskay/flatworm/master/data/ABC.RData -------------------------------------------------------------------------------- /data/RankCorr.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mjskay/flatworm/master/data/RankCorr.RData -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | .project 3 | .settings 4 | .Rhistory 5 | .RData 6 | .Rproj* 7 | flatworm.Rproj 8 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^TODO$ 4 | ^.*\.md$ 5 | ^.*~$ 6 | ^\.gitignore$ 7 | ^\.gitattributes$ 8 | ^\.git$ 9 | ^\.travis\.yml$ 10 | -------------------------------------------------------------------------------- /tests/testthat/test.flatworm.R: -------------------------------------------------------------------------------- 1 | # Tests for flatworm 2 | # 3 | # Author: mjskay 4 | ############################################################################### 5 | 6 | library(testthat) 7 | library(flatworm) 8 | 9 | context("flatworm") 10 | 11 | # test_that("TBD", { 12 | # }) 13 | 14 | -------------------------------------------------------------------------------- /man/ABC.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{ABC} 5 | \alias{ABC} 6 | \title{Test data with five groups} 7 | \description{ 8 | Test data generated from a hierarchical model with normally-distributed errors and 5 groups (A, B, C, D, and E). 9 | } 10 | \keyword{datasets} 11 | \keyword{internal} 12 | 13 | -------------------------------------------------------------------------------- /man/RankCorr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{RankCorr} 5 | \alias{RankCorr} 6 | \title{Thinned posterior sample from a Bayesian analysis used for testing purposes.} 7 | \description{ 8 | Test data (details of the experiment are irrelevant). 9 | } 10 | \keyword{datasets} 11 | \keyword{internal} 12 | 13 | -------------------------------------------------------------------------------- /R/global_variables.R: -------------------------------------------------------------------------------- 1 | # Names that should be suppressed from global variable check by codetools 2 | # Names used broadly should be put here; Names used in specific files should 3 | # be put at the top of the corresponding file. 4 | # 5 | # Author: mjskay 6 | ############################################################################### 7 | 8 | # names used in dlpyr functions 9 | globalVariables(c(".")) 10 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | year <- sub("-.*", "", meta$Date) 2 | note <- sprintf("R package version %s", meta$Version) 3 | 4 | bibentry(bibtype = "Manual", 5 | title = "{tidybayes}: R package for composing/extracting tidy data from Bayesian samplers", 6 | author = c(person("Matthew", "Kay")), 7 | year = year, 8 | note = note, 9 | url = "https://github.com/mjskay/tidybayes") 10 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(flatworm,data.frame) 4 | S3method(flatworm,lm) 5 | S3method(flatworm,map) 6 | S3method(flatworm,map2stan) 7 | export(flatworm) 8 | import(dplyr) 9 | import(ggplot2) 10 | importFrom(lsmeans,recover.data) 11 | importFrom(magrittr,"%<>%") 12 | importFrom(modelr,seq_range) 13 | importFrom(stats,dnorm) 14 | importFrom(stats,lm) 15 | importFrom(stats,pnorm) 16 | importFrom(stats,predict) 17 | importFrom(stats,quantile) 18 | importFrom(stats,rstandard) 19 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: R 2 | sudo: false 3 | cache: packages 4 | 5 | # Be strict when checking our package 6 | warnings_are_errors: true 7 | 8 | # NOT_CRAN and options in .Rprofile are workarounds for "cyclic dependency check" error 9 | # see https://github.com/travis-ci/travis-ci/issues/4125 10 | env: 11 | global: 12 | - NOT_CRAN=true 13 | 14 | # update all packages before install 15 | # (should solve problem of stale packages in ubuntu R distro) 16 | # see https://github.com/travis-ci/travis-ci/issues/6850 17 | before_install: 18 | - Rscript -e 'update.packages(ask = FALSE)' 19 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | # Documentation of datasets 2 | # 3 | # Author: Matthew Kay 4 | ############################################################################### 5 | 6 | 7 | #' Thinned posterior sample from a Bayesian analysis used for testing purposes. 8 | #' 9 | #' Test data (details of the experiment are irrelevant). 10 | #' 11 | #' @name RankCorr 12 | #' @docType data 13 | #' @keywords datasets internal 14 | NULL 15 | 16 | #' Test data with five groups 17 | #' 18 | #' Test data generated from a hierarchical model with normally-distributed errors and 5 groups (A, B, C, D, and E). 19 | #' 20 | #' @name ABC 21 | #' @docType data 22 | #' @keywords datasets internal 23 | NULL 24 | -------------------------------------------------------------------------------- /R/util.rethinking.R: -------------------------------------------------------------------------------- 1 | # Utility functions for models from the "rethinking" package (e.g. map and map2stan models) 2 | # 3 | # Author: mjskay 4 | ############################################################################### 5 | 6 | #return the parameter name for the first link in the given model (or 7 | #the only one, if there is only one) 8 | first_link_name = function(fit) UseMethod("first_link_name", fit) 9 | first_link_name.map = function(fit) fit@links[[1]][[1]] 10 | first_link_name.map2stan = function(fit) fit@formula_parsed$lm[[1]]$parameter 11 | 12 | #return the expression for the first y (response) variable/expression as a quoted AST 13 | first_y_expr = function(fit) fit@formula[[1]][[2]] 14 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: flatworm 2 | Title: Flattened detrended QQ plots (flatworm plots) 3 | Version: 0.9.0.000001 4 | Date: 2015-10-28 5 | Authors@R: c(person("Matthew", "Kay", role = c("aut", "cre"), 6 | email = "mjskay@umich.edu")) 7 | Maintainer: Matthew Kay 8 | Description: Provides worm plots and flattened worm plots ("flatworm" plots), 9 | detrended QQ plots for regression diagnostics. 10 | Depends: 11 | R (>= 2.10) 12 | Imports: 13 | lazyeval, 14 | plyr, 15 | dplyr, 16 | tidyr, 17 | ggplot2, 18 | stringi, 19 | lsmeans, 20 | LaplacesDemon, 21 | coda, 22 | modelr, 23 | purrr, 24 | tibble, 25 | MASS, 26 | magrittr 27 | Suggests: 28 | ggstance, 29 | import, 30 | testthat, 31 | rstan, 32 | gamlss, 33 | runjags, 34 | rstanarm, 35 | brms 36 | Enhances: 37 | rethinking 38 | Remotes: rmcelreath/rethinking 39 | License: GPL (>= 2) 40 | BugReports: https://github.com/mjskay/flatworm/issues/new 41 | URL: https://github.com/mjskay/flatworm 42 | RoxygenNote: 5.0.1 43 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # flatworm: Flattened detrended QQ plots 2 | 3 | [![Build Status](https://travis-ci.org/mjskay/flatworm.png?branch=master)](https://travis-ci.org/mjskay/flatworm) 4 | 5 | _Matthew Kay, University of Michigan _ 6 | 7 | This project is a fork from [tidybayes](https://github.com/mjskay/tidybayes) 8 | that includes only the code for flatworm plots, which I felt was both secondary 9 | enough to that package (and applicable enough to other things) to deserve 10 | a separate package. Still a work in progress. 11 | 12 | ## Installation 13 | 14 | You can install the latest development version from GitHub with these R 15 | commands: 16 | 17 | ```r 18 | install.packages("devtools") 19 | devtools::install_github("mjskay/flatworm") 20 | ``` 21 | 22 | ## Examples 23 | 24 | TBD. 25 | 26 | ## Problems 27 | 28 | Should you encounter any issues with this package, contact Matthew Kay 29 | (). If you have found a bug, please file it [here] 30 | (https://github.com/mjskay/flatworm/issues/new) with minimal code to reproduce 31 | the issue. 32 | -------------------------------------------------------------------------------- /vignettes/flatworm.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flat worm plots" 3 | author: "Matthew Kay" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Flat Worm Plots} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | # Introduction 13 | 14 | This vignette covers some variaties of worm plots, and in particular introduces flatworm plots, a regression diagnostic plot used to assess residual fit---like a QQ plot, but modified to maximize the ability of humans to perceive deviations from model fit. 15 | 16 | # Setup 17 | 18 | ## Libraries and imports 19 | 20 | ## Required libraries 21 | 22 | If you are missing any of the packages below, use `install.packages("packagename")` to install them. 23 | The `import::` syntax requires the `import` package to be installed, and provides a simple way to 24 | import specific functions from a package without polluting your entire namespace (unlike `library()`) 25 | 26 | ```{r setup, results="hide", message=FALSE} 27 | library(dplyr) 28 | library(magrittr) #pipe syntax (%>%, %<>%, etc) 29 | library(ggplot2) 30 | library(gamlss) 31 | import::from(gamlss.dist, dTF, qTF, pTF, rTF) #the TF functions are a scaled and shifted t distribution 32 | ``` 33 | 34 | # Test of kurtosis 35 | 36 | ## Data 37 | 38 | Let's generate some data with varying levels of kurtosis 39 | 40 | ```{r} 41 | k = 100 42 | d = data_frame( 43 | mu = 0, 44 | sigma = 1, 45 | nu = seq(1,50,by=1) 46 | ) %>% 47 | group_by(mu, sigma, nu) %>% 48 | do(data_frame( 49 | x = rTF(k, .$mu, .$sigma, .$nu) 50 | )) 51 | ``` 52 | 53 | And a normal model: 54 | 55 | ```{r} 56 | dn = data_frame( 57 | x = rnorm(k, 0, 1) 58 | ) 59 | mn = lm(x ~ 1, data = dn) 60 | ``` 61 | 62 | Now let's fit the models: 63 | 64 | ```{r} 65 | m = d %>% 66 | group_by(nu) %>% 67 | do(model = lm(x ~ 1, data=.)) 68 | ``` 69 | 70 | 71 | ```{r} 72 | flatworm(m$model[[10]], ylim=6) 73 | + geom_vline(xintercept = c(-2,2)) 74 | flatworm(mn, cubic=T) 75 | wp(resid = rstandard(m$model[[10]])) 76 | wp(resid = rstandard(mn)) 77 | ``` 78 | 79 | # Test of skew 80 | 81 | Let's generate some data with varying levels of skew 82 | 83 | ```{r} 84 | k = 1000 85 | d = data_frame( 86 | mu = 0, 87 | sigma = 1, 88 | skew = seq(-100,100,by=10) 89 | ) %>% 90 | group_by(mu, sigma, skew) %>% 91 | do(data_frame( 92 | x = rST1(k, .$mu, .$sigma, .$skew, Inf) 93 | )) 94 | ``` 95 | 96 | And a normal model: 97 | 98 | ```{r} 99 | dn = data_frame( 100 | x = rnorm(k, 0, 1) 101 | ) 102 | mn = lm(x ~ 1, data = dn) 103 | ``` 104 | 105 | Now let's fit the models: 106 | 107 | ```{r} 108 | m = d %>% 109 | group_by(skew) %>% 110 | do(model = lm(x ~ 1, data=.)) 111 | ``` 112 | 113 | ```{r} 114 | flatworm(m$model[[0 + 11]], ylim=6, lines=FALSE, loess=TRUE, points=FALSE) + geom_vline(xintercept = c(-2,2)) 115 | wp(resid = rstandard(m$model[[-5 + 11]])) 116 | ``` 117 | 118 | -------------------------------------------------------------------------------- /man/flatworm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/flatworm.R 3 | \name{flatworm} 4 | \alias{flatworm} 5 | \alias{flatworm.data.frame} 6 | \alias{flatworm.lm} 7 | \alias{flatworm.map} 8 | \alias{flatworm.map2stan} 9 | \title{Flatworm plot for normalized quantile residuals} 10 | \usage{ 11 | flatworm(object, ...) 12 | 13 | \method{flatworm}{lm}(object, cols = NULL, ...) 14 | 15 | \method{flatworm}{map}(object, cols = NULL, y = NULL, ...) 16 | 17 | \method{flatworm}{map2stan}(object, cols = NULL, y = NULL, ...) 18 | 19 | \method{flatworm}{data.frame}(object, residual_z, cols = NULL, ylim = 6, 20 | points = TRUE, lines = FALSE, loess = TRUE, cubic = FALSE, 21 | z_cubic = FALSE, ...) 22 | } 23 | \arguments{ 24 | \item{object}{The object to generate diagnostics from, such as a model (for 25 | \code{flatworm.lm}, \code{flatworm.map}, ...) or a data frame of residuals 26 | (for \code{flatworm.data.frame}).} 27 | 28 | \item{...}{Additional arguments passed onto \code{flatworm.data.frame} by 29 | model-specific versions of \code{flatworm}. 30 | 31 | Flatworm implements a variant of a worm plot (See e.g. \code{\link[gamlss]{wp}}). 32 | Unlike the traditional worm plot, its x-axis is scaled in units of standard 33 | errors. Thus the arcs that define ~ +-2 SE in a worm plot (the region most 34 | residuals should be within) instead define a band, making it a more straightforward 35 | task to judge whether the residuals are contained within +- 2 SE. 36 | 37 | Model-specific versions of \code{flatworm} simply extract data and normalized 38 | residuals from a model and then pass them to \code{flatworm.data.frame}.} 39 | 40 | \item{cols}{Bare (unquoted) name of a column to facet over for generating 41 | multiple flatworm plots (i.e. small multiples). If cols is numeric, it 42 | will be split into quartiles; if is it a factor, into levels.} 43 | 44 | \item{y}{\code{map2stan} and \code{map} objects may contain multiple dependent 45 | variables; use \code{y} (as an unquoted expression) to specify the desired 46 | response to calculate residuals from (or \code{NULL} to use the first 47 | link function in the model).} 48 | 49 | \item{residual_z}{Bare name of the normalized residuals in \code{object}.} 50 | 51 | \item{ylim}{Limits of the y axis to plot. If a numeric vector of length 2, specifies 52 | min and max. If numeric vector of length 1, specifies abs(min) and max. If 53 | \code{NA} or \code{NULL}, the y limits are determined from the data.} 54 | 55 | \item{points}{Show residuals as points} 56 | 57 | \item{lines}{Show residuals as lines} 58 | 59 | \item{loess}{Show a \code{\link{loess}} fit to detrended residuals.} 60 | 61 | \item{cubic}{Show a cubic fit to detrended residuals.} 62 | 63 | \item{z_cubic}{Show a cubic fit to detrended residuals in z-space, translated onto the 64 | SE scale used by flatworm. This is the same fit used by \code{\link[gamlss]{wp}} 65 | displayed on the transformed y scale used by \code{flatworm}.} 66 | } 67 | \description{ 68 | Generates a flattened version of a detrended normal Q-Q plot (a worm plot) 69 | for regression diagnostics. 70 | } 71 | \seealso{ 72 | \code{\link[gamlss]{wp}} 73 | } 74 | 75 | -------------------------------------------------------------------------------- /R/flatworm.R: -------------------------------------------------------------------------------- 1 | # flatworm 2 | # 3 | # Author: mjskay 4 | ############################################################################### 5 | 6 | # Names that should be suppressed from global variable check by codetools 7 | # Names used broadly should be put in _global_variables.R 8 | globalVariables(c("expected_p","expected_z",".cuts",".worm_y","worm")) 9 | 10 | 11 | #' Flatworm plot for normalized quantile residuals 12 | #' 13 | #' Generates a flattened version of a detrended normal Q-Q plot (a worm plot) 14 | #' for regression diagnostics. 15 | #' 16 | #' @param object The object to generate diagnostics from, such as a model (for 17 | #' \code{flatworm.lm}, \code{flatworm.map}, ...) or a data frame of residuals 18 | #' (for \code{flatworm.data.frame}). 19 | #' @param cols Bare (unquoted) name of a column to facet over for generating 20 | #' multiple flatworm plots (i.e. small multiples). If cols is numeric, it 21 | #' will be split into quartiles; if is it a factor, into levels. 22 | #' @param y \code{map2stan} and \code{map} objects may contain multiple dependent 23 | #' variables; use \code{y} (as an unquoted expression) to specify the desired 24 | #' response to calculate residuals from (or \code{NULL} to use the first 25 | #' link function in the model). 26 | #' @param residual_z Bare name of the normalized residuals in \code{object}. 27 | #' @param ylim Limits of the y axis to plot. If a numeric vector of length 2, specifies 28 | #' min and max. If numeric vector of length 1, specifies abs(min) and max. If 29 | #' \code{NA} or \code{NULL}, the y limits are determined from the data. 30 | #' @param points Show residuals as points 31 | #' @param lines Show residuals as lines 32 | #' @param loess Show a \code{\link{loess}} fit to detrended residuals. 33 | #' @param cubic Show a cubic fit to detrended residuals. 34 | #' @param z_cubic Show a cubic fit to detrended residuals in z-space, translated onto the 35 | #' SE scale used by flatworm. This is the same fit used by \code{\link[gamlss]{wp}} 36 | #' displayed on the transformed y scale used by \code{flatworm}. 37 | #' @param ... Additional arguments passed onto \code{flatworm.data.frame} by 38 | #' model-specific versions of \code{flatworm}. 39 | #' 40 | #' Flatworm implements a variant of a worm plot (See e.g. \code{\link[gamlss]{wp}}). 41 | #' Unlike the traditional worm plot, its x-axis is scaled in units of standard 42 | #' errors. Thus the arcs that define ~ +-2 SE in a worm plot (the region most 43 | #' residuals should be within) instead define a band, making it a more straightforward 44 | #' task to judge whether the residuals are contained within +- 2 SE. 45 | #' 46 | #' Model-specific versions of \code{flatworm} simply extract data and normalized 47 | #' residuals from a model and then pass them to \code{flatworm.data.frame}. 48 | #' 49 | #' @seealso \code{\link[gamlss]{wp}} 50 | #' 51 | #' @import dplyr 52 | #' @import ggplot2 53 | #' @importFrom lsmeans recover.data 54 | #' @importFrom magrittr %<>% 55 | #' @importFrom stats dnorm pnorm lm predict quantile rstandard 56 | #' @importFrom modelr seq_range 57 | #' @export 58 | flatworm = function(object, ...) UseMethod("flatworm", object) 59 | #' @rdname flatworm 60 | #' @export 61 | flatworm.lm = function(object, cols = NULL, ...) { 62 | .cols = substitute(cols) 63 | 64 | #get data and standardized residuals 65 | data = recover.data(object) 66 | # r = residuals(object) %>% {./sd(.)} 67 | r = rstandard(object) 68 | if (is.character(data) && length(data) == 1) { 69 | #recover data will fail if there are no predictors and return a character 70 | data = data.frame( 71 | residual_z = r 72 | ) 73 | } 74 | else { 75 | data = cbind( 76 | recover.data(object), 77 | residual_z = r 78 | ) 79 | } 80 | 81 | eval(bquote(flatworm(data, residual_z, cols = .(.cols), ...))) 82 | } 83 | #' @rdname flatworm 84 | #' @export 85 | flatworm.map = function(object, cols = NULL, y = NULL, ...) { 86 | .cols = substitute(cols) 87 | .y = substitute(y) 88 | 89 | if (is.null(.y)) { 90 | .y = first_y_expr(object) 91 | } 92 | 93 | eval(bquote( 94 | tidy_sim(, object, .predicted) %>% 95 | summarise( 96 | residual_z = qnorm(mean(.predicted < .(.y))) 97 | ) %>% 98 | ungroup() %>% 99 | flatworm(residual_z, cols = .(.cols), ...) 100 | )) 101 | } 102 | #' @rdname flatworm 103 | #' @export 104 | flatworm.map2stan = flatworm.map 105 | #' @rdname flatworm 106 | #' @export 107 | flatworm.data.frame = function(object, residual_z, cols = NULL, 108 | ylim = 6, points = TRUE, lines = FALSE, 109 | loess = TRUE, cubic = FALSE, z_cubic = FALSE, 110 | ... 111 | ) { 112 | data = object 113 | .residual_z = substitute(residual_z) 114 | .cols = substitute(cols) 115 | ylim = if (is.numeric(ylim) && length(ylim) == 1) c(-ylim, ylim) else ylim 116 | 117 | add_cols = !is.null(.cols) 118 | if (add_cols) { 119 | #when cols is supplied, create a plot with worms split by `cols`. To do that 120 | #we'll need a factor in the data frame representing that split. This could be 121 | #an existing variable (if x is a factor or a logical) or could be cuts based on 122 | #quantiles of cols (if it is numeric) 123 | eval(bquote({ 124 | cols_value = data %$% .(.cols) 125 | if (is.factor(cols_value) || is.logical(cols_value) || length(unique(cols_value)) < 4) { 126 | data %<>% mutate(.cuts = .(.cols)) 127 | } 128 | else { 129 | data %<>% mutate(.cuts = cut(.(.cols), quantile(.(.cols)), include.lowest=TRUE)) 130 | } 131 | })) 132 | } 133 | else { 134 | data %<>% mutate(.cuts = "") 135 | } 136 | 137 | eval(bquote({ 138 | data %<>% 139 | arrange(.(.residual_z)) %>% 140 | group_by(.cuts) %>% 141 | mutate( 142 | expected_p = ppoints(n()), 143 | expected_z = qnorm(expected_p), 144 | se = (1/dnorm(expected_z)) * (sqrt(expected_p * (1 - expected_p)/n())) 145 | ) 146 | p = ggplot(data, aes(x = expected_z, y = (.(.residual_z) - expected_z)/se) ) 147 | })) 148 | 149 | if (points) { 150 | p = p + geom_point() 151 | } 152 | if (lines) { 153 | p = p + geom_line() 154 | } 155 | if (loess) { 156 | p = p + stat_smooth(se=FALSE, method="loess", color="red", span=0.25) 157 | } 158 | if (cubic) { 159 | p = p + stat_smooth(method=lm, se=FALSE, formula = y ~ poly(x, 3), color="red") 160 | } 161 | if (z_cubic) { 162 | #TODO: de-uglify this. Can't just do poly regression on original scale because 163 | #the shape of the fit curve near the se boundaries can be quite different 164 | eval(bquote(data %<>% mutate( 165 | .worm_y = .(.residual_z) - expected_z 166 | ))) 167 | m.worm = if (add_cols) { 168 | lm(.worm_y ~ poly(expected_z, 3)*.cuts, data = filter(data, is.finite(.worm_y))) 169 | } 170 | else { 171 | lm(.worm_y ~ poly(expected_z, 3), data = filter(data, is.finite(.worm_y))) 172 | } 173 | predictions = 174 | expand.grid( 175 | expected_z = seq_range(data$expected_z, n = 100), 176 | .cuts = unique(data$.cuts) 177 | ) %>% 178 | group_by(.cuts) %>% 179 | mutate( 180 | expected_p = pnorm(expected_z), 181 | se = (1/dnorm(expected_z)) * (sqrt(expected_p * (1 - expected_p)/sum(data$.cuts == .cuts[[1]]))) 182 | ) %>% 183 | ungroup %>% 184 | do(cbind(., worm = predict(m.worm, .)/.$se)) 185 | #p = p + stat_smooth(method = lm, formula = y ~ poly(x, 3), se=FALSE, color="red", size=1.5) 186 | p = p + geom_line(aes(y=worm), data=predictions, color="red", size=1.5) 187 | } 188 | if (add_cols) { 189 | p = p + facet_grid(. ~ .cuts) 190 | } 191 | if (is.numeric(ylim)) { 192 | p = p + coord_cartesian(ylim = ylim) 193 | } 194 | 195 | p = p + 196 | geom_vline(xintercept = 0, linetype="dashed") + 197 | geom_hline(yintercept = 0, linetype="dashed") + 198 | geom_hline(yintercept = c(-2,2)) 199 | 200 | p 201 | } 202 | --------------------------------------------------------------------------------