Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commitda06467

Browse files
authored
Merge pull request#27 from permaverse/fix-quarto-vignettes
Properly load data in vignettes
2 parents627ea12 +17a690d commitda06467

24 files changed

+149
-44
lines changed

‎data-raw/anova-vignette.R‎

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -58,8 +58,7 @@ out <- list(
5858
grid=pf$grid
5959
)
6060

61-
saveRDS(out,"data-raw/df_1anova.rds")
62-
61+
saveRDS(out,"inst/vignette-data/anova-df1.rds")
6362

6463
# M-ANOVA -------------------------------------------------------------------
6564

@@ -123,8 +122,6 @@ out <- list(
123122
grid=pf$grid
124123
)
125124

126-
saveRDS(out,"data-raw/df_2anova.rds")
127-
125+
saveRDS(out,"inst/vignette-data/anova-df2.rds")
128126

129127
stopCluster(cl)
130-

‎data-raw/build-sysdata.R‎

Lines changed: 0 additions & 22 deletions
This file was deleted.

‎data-raw/exactness-vignette.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -67,4 +67,4 @@ progressr::with_progress({
6767

6868
alpha_estimates
6969

70-
saveRDS(alpha_estimates,"data-raw/alpha.rds")
70+
saveRDS(alpha_estimates,"inst/vignette-data/exactness-alpha.rds")

‎data-raw/flipr-vignette.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ pfa$set_grid(
4848
pfa$set_nperms(nperms)
4949
pfa$evaluate_grid(grid=pfa$grid)
5050

51-
saveRDS(pfa,"data-raw/pfa.rds")
51+
saveRDS(pfa,"inst/vignette-data/flipr-pfa.rds")
5252

5353
# Scenario B --------------------------------------------------------------
5454

@@ -79,7 +79,7 @@ pfb$set_grid(
7979
pfb$set_nperms(nperms)
8080
pfb$evaluate_grid(grid=pfb$grid)
8181

82-
saveRDS(pfb,"data-raw/pfb.rds")
82+
saveRDS(pfb,"inst/vignette-data/flipr-pfb.rds")
8383

8484
# Scenario C --------------------------------------------------------------
8585

@@ -110,4 +110,4 @@ pfc$set_grid(
110110
pfc$set_nperms(nperms)
111111
pfc$evaluate_grid(grid=pfb$grid)
112112

113-
saveRDS(pfc,"data-raw/pfc.rds")
113+
saveRDS(pfc,"inst/vignette-data/flipr-pfc.rds")

‎data-raw/parallelization-vignette.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -99,5 +99,4 @@ df_parallelization <- list(
9999
time_with_future=time_with_future
100100
)
101101

102-
saveRDS(df_parallelization,"data-raw/df_parallelization.rds")
103-
102+
saveRDS(df_parallelization,"inst/vignette-data/parallelization-df.rds")

‎data-raw/plausibility-vignette.R‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -85,7 +85,7 @@ df_mean <- tibble(
8585
) %>%
8686
pivot_longer(-delta)
8787

88-
saveRDS(df_mean,"data-raw/df_mean.rds")
88+
saveRDS(df_mean,"inst/vignette-data/plausibility-df-mean.rds")
8989

9090
# Inference on the standard deviation -------------------------------------
9191

@@ -151,7 +151,7 @@ df_sd <- tibble(
151151
) %>%
152152
pivot_longer(-rho)
153153

154-
saveRDS(df_sd,"data-raw/df_sd.rds")
154+
saveRDS(df_sd,"inst/vignette-data/plausibility-df-sd.rds")
155155

156156
# Inference on both the mean and the standard deviation -------------------
157157

@@ -208,7 +208,7 @@ if (requireNamespace("interp", quietly = TRUE)) {
208208

209209
df_fisher<-pf$grid
210210

211-
saveRDS(df_fisher,"data-raw/df_fisher.rds")
211+
saveRDS(df_fisher,"inst/vignette-data/plausibility-df-fisher.rds")
212212

213213
# Tippett combining function
214214
pf$set_aggregator("tippett")
@@ -236,4 +236,4 @@ if (requireNamespace("interp", quietly = TRUE)) {
236236

237237
df_tippett<-pf$grid
238238

239-
saveRDS(df_tippett,"data-raw/df_tippett.rds")
239+
saveRDS(df_tippett,"inst/vignette-data/plausibility-df-tippett.rds")

‎data-raw/wip-rayshader.R‎

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
pf<- readRDS("~/Downloads/pf-1anova.rds")
2+
3+
upsample_grid<-function(grid,n=100L) {
4+
nms<- colnames(grid)
5+
pval_mat<-tidyr::pivot_wider(grid,names_from=nms[2],values_from=pvalue)
6+
pval_mat<- as.matrix(pval_mat[,-1])
7+
old_x<- sort(unique(pf$grid[[nms[1]]]))
8+
old_y<- sort(unique(pf$grid[[nms[2]]]))
9+
itp<-interp::bilinear.grid(old_x,old_y,pval_mat,nx=n,ny=n)
10+
out<-tidyr::crossing(x=itp$x,y=itp$y)
11+
dplyr::mutate(out,pvalue= c(itp$z))
12+
}
13+
14+
plot_pvalue_surface<-function(pf,n=100L) {
15+
p1<-pf$grid|>
16+
upsample_grid(n=n)|>
17+
ggplot(aes(x,y,z=pvalue))+
18+
geom_contour_filled(binwidth=0.05)+
19+
geom_contour(color="black",binwidth=0.05)+
20+
scale_x_continuous(expand= c(0,0))+
21+
scale_y_continuous(expand= c(0,0))+
22+
coord_fixed()+
23+
theme(legend.position="none")+
24+
labs(
25+
title="Contour plot of the p-value surface",
26+
subtitle="Using Fisher's non-parametric combination",
27+
x= expression(mu[2]-mu[1]),
28+
y= expression(mu[3]-mu[1]),
29+
fill="p-value"
30+
)
31+
32+
if (!requireNamespace("rayshader",quietly=TRUE)) {
33+
return(p1)
34+
}
35+
36+
p2<-pf$grid|>
37+
upsample_grid(n=n)|>
38+
ggplot(aes(x,y))+
39+
geom_tile(aes(fill=pvalue))+
40+
geom_contour(aes(z=pvalue),color="black",binwidth=0.05)+
41+
scale_x_continuous(expand= c(0,0))+
42+
scale_y_continuous(expand= c(0,0))+
43+
coord_fixed()+
44+
scale_fill_gradientn(colours= terrain.colors(10))+
45+
theme(legend.position="none")+
46+
labs(
47+
title="Contour plot of the p-value surface",
48+
subtitle="Using Fisher's non-parametric combination",
49+
x= expression(mu[2]-mu[1]),
50+
y= expression(mu[3]-mu[1]),
51+
fill="p-value"
52+
)
53+
54+
rayshader::plot_gg(
55+
p1,ggobj_height=p2,
56+
multicore=TRUE,raytrace=TRUE,width=7,height=4,
57+
scale=300,windowsize= c(1400,866),zoom=0.6,phi=30,theta=30
58+
)
59+
}
60+
61+
plot_pvalue_surface(pf,n=50L)

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp