Zip plot is missing/overlapping confidence intervals.
ge-li opened this issue · 3 comments
ge-li commented
Describe the bug
Notice there are some overlapping or seemingly missing CIs. I suspect it's because of this snippet of code in the plot-types.R (line 128-137)
### Compute ranking for each data split
for (i in seq_along(data)) {
for (j in seq_along(data[[i]])) {
A <- rank(data[[i]][[j]][["z"]])
B <- max(A)
data[[i]][[j]][["rank"]] <- A / B
}
data[[i]] <- .br(data[[i]])
}
data <- .br(data)To Reproduce
I'll use a sampled data set from my simulation.
alpha_hat <- c(0.656359464634274,0.526704505967593,0.475676356717568,0.611939636587922,0.433070092974109,0.531604887583618,0.3642027920398,0.531331114468528,0.588184525037812,0.540509288564473,0.630490278895853,0.419239614571934,0.311393213642424,0.567859683275186,0.475294354930879,0.335069477933224,0.393376022987897,0.488597053641829,0.44111704925641,0.557230281119142,0.535521802048021,0.360641641250493,0.376916394535027,0.700009157933441,0.555590820626339,0.432729743038088,0.47602591651468,0.407165879254845,0.648791431736419,0.402439346836696,0.422020613532311,0.461372936266911,0.610453889026044,0.496020984616336,0.761399591470052,0.510093438756691,0.458627498094725,0.437950861818385,0.421842676858636,0.443855078787984,0.50969516325107,0.587861788774241,0.291916330122512,0.434125117893412,0.433454777024997,0.511627050589271,0.459155155336153,0.429396260785516,0.456188743738326,0.515155142417543,0.563332002383864,0.371271603813827,0.419740675799457,0.333860698365792,0.550980951167078,0.360815702482087,0.500727639504405,0.60203471591322,0.306630734081198,0.269764664128963,0.510332439298986,0.59799154560772,0.558552615764875,0.431083460127381,0.45976278550078,0.470787444713912,0.452324069240977,0.703791145336808,0.647075248755021,0.832873099582439,0.495935534495554,0.706556551771328,0.583224205575491,0.687724839249629,0.601849868297012,0.360831845580547,0.478834996706738,0.599706040542091,0.397495413439359,0.421958750530489,0.345298899443421,0.390183319076788,0.414163909071519,0.320115727483855,0.441042037469589,0.381943055461818,0.321881286547786,0.400309390417769,0.495307622132507,0.45342339815497,0.550015327079968,0.409066439214623,0.576445248812615,0.466516714928062,0.234683566538901,0.459852842421986,0.597533187100067,0.403086064443031,0.451341483478344,0.666399673328944,0.234458230000808,0.478848118448268,0.624614855114165,0.522972041510484,0.535158133007044,0.548072254219487,0.537181720821365,0.393642353453084,0.326127227582349,0.430601003638648,0.436634844609421,0.535971402274416,0.476503450580366,0.395516117032172,0.296819555672007,0.588739836506621,0.450412961897042,0.668888542609458,0.367039351829482,0.517593633344588,0.546332564525076,0.433356156007874,0.361247659864539,0.522646057074194,0.701978649558848,0.282893148712807,0.368777137029908,0.385916892048012,0.478428169180524,0.556735336661497,0.461782338107608,0.240889539175967,0.450442556936949,0.50395907501438,0.594767998824096,0.376631000454423,0.548667042325616,0.619626506280488,0.373297291489086,0.327423398242716,0.535797694529746,0.620001370086969,0.478428693647047,0.267380682893406,0.664936740364319,0.320958716760762,0.574130125264438,0.51683659026773,0.383530662423678,0.653676024926081,0.400056675628522,0.465787304179851,0.628506483741265,0.37416834008451,0.359278109711074,0.525553364014043,0.453795930785715,0.492027397507949,0.553506356133726,0.501756925805646,0.484465875220644,0.462224849453566,0.484083035949571,0.491544869953084,0.424319468574546,0.460388785526096,0.35218640663993,0.540480282117303,0.62107684275757,0.644100839717473,0.440324403747399,0.387972431408694,0.498022570557973,0.515264882653275,0.329038890471325,0.351338762916926,0.415220904394264,0.546514921861891,0.365011517557668,0.465330645969789,0.240349001740987,0.516012353672969,0.570196827720793,0.467949716267977,0.791813963666541,0.446265816875625,0.456659982044231,0.581921696646041,0.501456806088658,0.433932103817059,0.47819598563163,0.469649715706258,0.514535210015505,0.480760313244703,0.4826917981395,0.54125148252936,0.484310901487429,0.467584743003643,0.469866032133875,0.541475708763287)
alpha_se <- c(0.0877388154467468,0.0880965779931617,0.0871032776606541,0.0870952699388111,0.0860859772099564,0.0844096916262812,0.0847779508620272,0.0876910246069201,0.0874591696788071,0.0881192091567087,0.0888768086820969,0.0863118464597798,0.0831056940197959,0.0873145486068549,0.0841897599464942,0.0855609263238139,0.0857505076762107,0.0864398693651952,0.0852459947844958,0.0861676550845069,0.0853344112023075,0.0845581886908714,0.084562556477393,0.0887632345833936,0.0887708595029702,0.0834631767827538,0.0864141915945574,0.0862500598468023,0.0882076406070766,0.0852975369513632,0.0856892173201958,0.087308748973989,0.0872976041035144,0.0881334747993714,0.0908928205894117,0.0872485147785255,0.0868809047244885,0.0847561448220887,0.0860052294288993,0.0850672333592025,0.085545193545447,0.0878336356036802,0.082985657881651,0.0840846711437843,0.0858425442979095,0.0850820661220407,0.0852488529344636,0.0840337622612644,0.0852160043336433,0.0886245308952232,0.0885179064768261,0.0841318627048585,0.0864231415812021,0.0855925114070241,0.0885779377746889,0.0859240099529746,0.0867139916183447,0.0867056742865064,0.0850604611239242,0.0831182679445331,0.0847818967973359,0.086424804446052,0.0867490104857623,0.0848188685273843,0.0852141839616433,0.0861225047009766,0.0849519514593007,0.0877433604870608,0.0885318639357468,0.090695995893096,0.0869244122056348,0.0916963923068694,0.086388462540225,0.0908382152929422,0.0882429173575183,0.0847401873923082,0.0849225515128795,0.0875193377590677,0.0875068315575047,0.0852585816971395,0.08385447113872,0.0839859962066267,0.0852962831929812,0.0855989508915641,0.0858309887352697,0.0849566737404435,0.0839556902000267,0.0863805769063671,0.0849294951555101,0.0855723290403614,0.0864596848120583,0.0858742741180604,0.0899018655735256,0.0866704583505727,0.085091797765269,0.0844344369609142,0.0884664929065622,0.0845884380924548,0.0852570862815936,0.0895219654024349,0.0831617430271058,0.0869228284332124,0.087229139976361,0.0892452217149429,0.0880488652500995,0.0873585438532981,0.0857115173412019,0.085533600915808,0.0823869937765032,0.0841550814699975,0.0852316279093306,0.0862300147752962,0.0870915712316277,0.0876293288949928,0.0838083790323801,0.0872049493275479,0.0876130958680178,0.0873840948470912,0.0866888628464038,0.0848829346886492,0.0846121169369514,0.0856475790230622,0.084865955471184,0.0877627675089955,0.0883307166164756,0.0833776956154428,0.0845355334393845,0.0852651502251628,0.0871530694056119,0.0869473322272491,0.0856248393598056,0.0842310396350257,0.0851942616840299,0.0865559373810271,0.0863320837281201,0.0852141830301668,0.0863202108429177,0.087425506536314,0.087071603627396,0.0840080187145488,0.0851211925609332,0.0872372179847335,0.0872616328043539,0.0843151946801957,0.0905852973313057,0.0854785124063171,0.0885656377192217,0.0870511884010271,0.083701386255851,0.0889173373612042,0.0847990463514356,0.085206286226956,0.089164236315406,0.0854715264099306,0.0844259774674939,0.0872937976564537,0.0850787819383495,0.0874717112662698,0.0879503296185651,0.0856681094812232,0.0847651870036599,0.083889226966191,0.0897029284772413,0.0861083382370717,0.0835363826507567,0.0853061291719781,0.0839888077409142,0.0883860899643039,0.0882127469767168,0.0871186903772599,0.0839470030628867,0.0853619698527822,0.0860274629386376,0.0882814209472338,0.0837348518904601,0.0844389033173324,0.0846287395937193,0.0870233729653114,0.0846554097159615,0.0858466598604219,0.0825044485516709,0.0846911472880101,0.0866654946222681,0.0849506678475894,0.0898233360807913,0.0839726457354748,0.0856256441265963,0.0870032488395095,0.0852893933550954,0.0849672160314836,0.0848249319771885,0.0876146908692248,0.0866914277354994,0.0869564398271178,0.0854766334806529,0.0854470399926068,0.0855142243100405,0.08786827774222,0.0836169828656378,0.0847226220963862)
df <- data.frame(alpha_hat, alpha_se)
ss <- simsum(sample_data, estvarname = "alpha_hat", se = "alpha_se", true = 1, x = T)
autoplot(ss, "zip")Expected behaviour
Here's my basic implementation using the percent_rank() function.
df %>%
mutate(alpha_empse = sd(alpha_hat),
alpha_ci_lower = alpha_hat - qnorm(0.975) * alpha_se,
alpha_ci_upper = alpha_hat + qnorm(0.975) * alpha_se,
alpha_z_score = (alpha_hat - 1) / alpha_se) %>%
mutate(covering = alpha_ci_lower < 1 & 1 < alpha_ci_upper) %>%
mutate(ci_percent = percent_rank(abs(alpha_z_score))) %>%
ggplot(aes(y = ci_percent, x = alpha_hat, color = covering)) +
geom_linerange(aes(xmin = alpha_ci_lower, xmax = alpha_ci_upper))
# OR
df %>%
mutate(alpha_empse = sd(alpha_hat),
alpha_ci_lower = alpha_hat - qnorm(0.975) * alpha_se,
alpha_ci_upper = alpha_hat + qnorm(0.975) * alpha_se,
alpha_z_score = (alpha_hat - 1) / alpha_se) %>%
mutate(covering = alpha_ci_lower < 1 & 1 < alpha_ci_upper) %>%
mutate(ci_rank = rank(abs(alpha_z_score))) %>%
mutate(ci_percent = ci_rank / max(ci_rank)) %>%
ggplot(aes(y = ci_percent, x = alpha_hat, color = covering)) +
geom_linerange(aes(xmin = alpha_ci_lower, xmax = alpha_ci_upper))
System information:
R version 4.1.2 (2021-11-01)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Big Sur 11.5.2
Matrix products: default
LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] dplyr_1.0.7 ggplot2_3.3.5 rsimsum_0.11.1
loaded via a namespace (and not attached):
[1] Rcpp_1.0.7 pillar_1.6.4 compiler_4.1.2 plyr_1.8.6 tools_4.1.2 digest_0.6.28
[7] lifecycle_1.0.1 tibble_3.1.5 gtable_0.3.0 checkmate_2.0.0 pkgconfig_2.0.3 rlang_0.4.12
[13] cli_3.1.0 DBI_1.1.1 rstudioapi_0.13 xfun_0.28 fastmap_1.1.0 withr_2.4.2
[19] knitr_1.36 generics_0.1.0 vctrs_0.3.8 grid_4.1.2 tidyselect_1.1.1 glue_1.4.2
[25] R6_2.5.1 fansi_0.5.0 clipr_0.8.0 farver_2.1.0 purrr_0.3.4 magrittr_2.0.1
[31] scales_1.1.1 backports_1.2.1 ggridges_0.5.3 ellipsis_0.3.2 htmltools_0.5.2 assertthat_0.2.1
[37] colorspace_2.0-2 labeling_0.4.2 utf8_1.2.2 munsell_0.5.0 crayon_1.4.2
ellessenne commented
Hi!
Thanks for the bug report and the (very!) detailed reproducible example, I just pushed a possible fix for this.
Could you give it a go by installing the latest dev version with remotes::install_github("ellessenne/rsimsum")?
Thanks again,
Alessandro
ge-li commented
Great! I think your new commit solved the problem. Thank you, Alessandro!
ellessenne commented
Super, I'll prepare a new release for CRAN in the next few days.
And thanks very much again to you for reporting this!