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

Commitd12ce40

Browse files
committed
Add log normal
1 parentd55b69e commitd12ce40

File tree

4 files changed

+245
-5
lines changed

4 files changed

+245
-5
lines changed

‎R Code/one sample/log normal sim.R‎

Lines changed: 235 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,235 @@
1+
library(LRTesteR)
2+
library(tidyverse)
3+
library(stringr)
4+
5+
################
6+
# Simulation settings
7+
################
8+
compiler::enableJIT(3)
9+
B<-5000
10+
N<-500
11+
12+
################
13+
# Type I
14+
################
15+
mus<- seq(-4,4,2)
16+
variances<- c(1,3,5)
17+
18+
sim_results<- tibble()
19+
for (muinmus) {
20+
for (varianceinvariances) {
21+
for (altin c("two.sided","less","greater")) {
22+
stats<- vector(mode="numeric",length=B)
23+
pvalues<- vector(mode="numeric",length=B)
24+
alts<- vector(mode="character",length=B)
25+
CI_LBs<- vector(mode="numeric",length=B)
26+
CI_UBs<- vector(mode="numeric",length=B)
27+
testName<-"log_normal_mu_one_sample"
28+
for (iin1:B) {
29+
set.seed(i)
30+
x<- rlnorm(n=N,mean=mu,sd=variance^.5)
31+
test<- log_normal_mu_one_sample(x,mu,alt)
32+
stats[i]<-test$statistic
33+
pvalues[i]<-test$p.value
34+
alts[i]<-test$alternative
35+
CI_LBs[i]<-test$conf.int[1]
36+
CI_UBs[i]<-test$conf.int[2]
37+
}
38+
temp<- tibble(test=testName,mu=mu,variance=variance,stat=stats,pvalue=pvalues,alt=alts,CI_LB=CI_LBs,CI_UB=CI_UBs)
39+
sim_results<-sim_results %>% bind_rows(temp)
40+
rm(stats,pvalues,alts,testName,temp,i)
41+
}
42+
43+
for (altin c("two.sided","less","greater")) {
44+
stats<- vector(mode="numeric",length=B)
45+
pvalues<- vector(mode="numeric",length=B)
46+
alts<- vector(mode="character",length=B)
47+
CI_LBs<- vector(mode="numeric",length=B)
48+
CI_UBs<- vector(mode="numeric",length=B)
49+
testName<-"log_normal_variance_one_sample"
50+
for (iin1:B) {
51+
set.seed(i)
52+
x<- rlnorm(n=N,mean=mu,sd=variance^.5)
53+
test<- log_normal_variance_one_sample(x,variance,alt)
54+
stats[i]<-test$statistic
55+
pvalues[i]<-test$p.value
56+
alts[i]<-test$alternative
57+
CI_LBs[i]<-test$conf.int[1]
58+
CI_UBs[i]<-test$conf.int[2]
59+
}
60+
temp<- tibble(test=testName,mu=mu,variance=variance,stat=stats,pvalue=pvalues,alt=alts,CI_LB=CI_LBs,CI_UB=CI_UBs)
61+
sim_results<-sim_results %>% bind_rows(temp)
62+
rm(stats,pvalues,alts,testName,temp,i)
63+
}
64+
}
65+
}
66+
67+
# Check structure
68+
sim_results %>%
69+
distinct(test) %>%
70+
nrow()==2
71+
72+
sim_results %>%
73+
distinct(mu) %>%
74+
nrow()== length(mus)
75+
76+
sim_results %>%
77+
distinct(variance) %>%
78+
nrow()== length(variances)
79+
80+
sim_results %>%
81+
distinct(alt) %>%
82+
nrow()==3
83+
84+
sim_results %>%
85+
pull(pvalue) %>%
86+
min(na.rm=TRUE)>=0
87+
88+
sim_results %>%
89+
pull(pvalue) %>%
90+
max(na.rm=TRUE)<=1
91+
92+
all(sim_results$CI_LB<sim_results$CI_UB)
93+
94+
# save
95+
sim_results %>%
96+
saveRDS("results/log_normal_type_one.rds")
97+
98+
rm(x,test,alt,mu,mus,variance,variances)
99+
100+
################
101+
# Type II
102+
################
103+
104+
mu0<-0
105+
variance0<-1
106+
muEffectSizes<- seq(-.20,.20,.05) %>%
107+
round(2) %>%
108+
setdiff(0)
109+
110+
sim_results<- tibble()
111+
for (muEffectSizeinmuEffectSizes) {
112+
if (muEffectSize<0) {
113+
for (altin c("two.sided","less")) {
114+
stats<- vector(mode="numeric",length=B)
115+
pvalues<- vector(mode="numeric",length=B)
116+
alts<- vector(mode="character",length=B)
117+
testName<-"log_normal_mu_one_sample"
118+
for (iin1:B) {
119+
set.seed(i)
120+
x<- rlnorm(n=N,mean=mu0+muEffectSize,sd=variance0^.5)
121+
test<- log_normal_mu_one_sample(x,mu0,alt)
122+
stats[i]<-test$statistic
123+
pvalues[i]<-test$p.value
124+
alts[i]<-test$alternative
125+
}
126+
temp<- tibble(test=testName,effectSize=muEffectSize,stat=stats,pvalue=pvalues,alt=alts)
127+
sim_results<-sim_results %>% bind_rows(temp)
128+
rm(stats,pvalues,alts,testName,temp,i)
129+
}
130+
}else {
131+
for (altin c("two.sided","greater")) {
132+
stats<- vector(mode="numeric",length=B)
133+
pvalues<- vector(mode="numeric",length=B)
134+
alts<- vector(mode="character",length=B)
135+
testName<-"log_normal_mu_one_sample"
136+
for (iin1:B) {
137+
set.seed(i)
138+
x<- rlnorm(n=N,mean=mu0+muEffectSize,sd=variance0^.5)
139+
test<- log_normal_mu_one_sample(x,mu0,alt)
140+
stats[i]<-test$statistic
141+
pvalues[i]<-test$p.value
142+
alts[i]<-test$alternative
143+
}
144+
temp<- tibble(test=testName,effectSize=muEffectSize,stat=stats,pvalue=pvalues,alt=alts)
145+
sim_results<-sim_results %>% bind_rows(temp)
146+
rm(stats,pvalues,alts,testName,temp,i)
147+
}
148+
}
149+
}
150+
151+
rm(alt,muEffectSize,x)
152+
153+
mu0<-0
154+
variance0<-15
155+
varianceEffectSizes<- seq(-5,5,1) %>%
156+
setdiff(0)
157+
158+
for (varianceEffectSizeinvarianceEffectSizes) {
159+
if (varianceEffectSize<0) {
160+
for (altin c("two.sided","less")) {
161+
stats<- vector(mode="numeric",length=B)
162+
pvalues<- vector(mode="numeric",length=B)
163+
alts<- vector(mode="character",length=B)
164+
testName<-"log_normal_variance_one_sample"
165+
for (iin1:B) {
166+
set.seed(i)
167+
x<- rlnorm(n=N,mean=mu0,sd= (variance0+varianceEffectSize)^.5)
168+
test<- log_normal_variance_one_sample(x,variance0,alt)
169+
stats[i]<-test$statistic
170+
pvalues[i]<-test$p.value
171+
alts[i]<-test$alternative
172+
}
173+
temp<- tibble(test=testName,effectSize=varianceEffectSize,stat=stats,pvalue=pvalues,alt=alts)
174+
sim_results<-sim_results %>% bind_rows(temp)
175+
rm(stats,pvalues,alts,testName,temp,i)
176+
}
177+
}else {
178+
for (altin c("two.sided","greater")) {
179+
stats<- vector(mode="numeric",length=B)
180+
pvalues<- vector(mode="numeric",length=B)
181+
alts<- vector(mode="character",length=B)
182+
testName<-"log_normal_variance_one_sample"
183+
for (iin1:B) {
184+
set.seed(i)
185+
x<- rlnorm(n=N,mean=mu0,sd= (variance0+varianceEffectSize)^.5)
186+
test<- log_normal_variance_one_sample(x,variance0,alt)
187+
stats[i]<-test$statistic
188+
pvalues[i]<-test$p.value
189+
alts[i]<-test$alternative
190+
}
191+
temp<- tibble(test=testName,effectSize=varianceEffectSize,stat=stats,pvalue=pvalues,alt=alts)
192+
sim_results<-sim_results %>% bind_rows(temp)
193+
rm(stats,pvalues,alts,testName,temp,i)
194+
}
195+
}
196+
}
197+
198+
# Check structure
199+
sim_results %>%
200+
distinct(test) %>%
201+
nrow()==2
202+
203+
sim_results %>%
204+
distinct(alt) %>%
205+
nrow()==3
206+
207+
sim_results %>%
208+
distinct(alt,test) %>%
209+
nrow()==6
210+
211+
sim_results %>%
212+
filter(test=="log_normal_mu_one_sample") %>%
213+
distinct(effectSize) %>%
214+
nrow()== length(muEffectSizes)
215+
216+
sim_results %>%
217+
filter(test=="log_normal_variance_one_sample") %>%
218+
distinct(effectSize) %>%
219+
nrow()== length(varianceEffectSizes)
220+
221+
sim_results %>%
222+
pull(pvalue) %>%
223+
min(na.rm=TRUE)>=0
224+
225+
sim_results %>%
226+
pull(pvalue) %>%
227+
max(na.rm=TRUE)<=1
228+
229+
# save
230+
sim_results %>%
231+
saveRDS("results/log_normal_type_two.rds")
232+
233+
rm(alt,varianceEffectSize,x,test)
234+
235+
rm(list= ls())

‎R Code/sampling distribution/check type I.R‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ load_df <- function(fn) {
1717

1818
fns<- c(
1919
"gaussian_type_one.rds",
20+
"log_normal_type_one.rds",
2021
"gamma_type_one_rate.rds",
2122
"gamma_type_one_scale.rds",
2223
"gamma_type_one_shape.rds",
@@ -46,7 +47,7 @@ typeI %>%
4647

4748
typeI %>%
4849
distinct(test) %>%
49-
nrow()==17
50+
nrow()==19
5051

5152
typeI %>%
5253
distinct(alt) %>%
@@ -145,6 +146,7 @@ load_df <- function(fn) {
145146

146147
fns<- c(
147148
"gaussian_type_one_one_way.rds",
149+
"log_normal_type_one_one_way.rds",
148150
"gamma_type_one_rate_one_way.rds",
149151
"gamma_type_one_scale_one_way.rds",
150152
"gamma_type_one_shape_one_way.rds",
@@ -169,7 +171,7 @@ typeI %>%
169171

170172
typeI %>%
171173
distinct(test) %>%
172-
nrow()==18
174+
nrow()==20
173175

174176
typeI %>%
175177
distinct(alt) %>%

‎R Code/sampling distribution/check type II.R‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ load_df <- function(fn) {
1717

1818
fns<- c(
1919
"gaussian_type_two.rds",
20+
"log_normal_type_two.rds",
2021
"gamma_type_two_rate.rds",
2122
"gamma_type_two_scale.rds",
2223
"gamma_type_two_shape.rds",
@@ -41,7 +42,7 @@ typeII %>%
4142

4243
typeII %>%
4344
distinct(test) %>%
44-
nrow()==18
45+
nrow()==20
4546

4647
typeII %>%
4748
distinct(alt) %>%
@@ -86,6 +87,7 @@ load_df <- function(fn) {
8687

8788
fns<- c(
8889
"gaussian_type_two_one_way.rds",
90+
"log_normal_type_two_one_way.rds",
8991
"gamma_type_two_rate_one_way.rds",
9092
"gamma_type_two_scale_one_way.rds",
9193
"gamma_type_two_shape_one_way.rds",
@@ -109,7 +111,7 @@ typeII %>%
109111

110112
typeII %>%
111113
distinct(test) %>%
112-
nrow()==18
114+
nrow()==20
113115

114116
typeII %>%
115117
distinct(alt) %>%

‎R Code/sampling distribution/sampling distribution.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ load_df <- function(fn) {
1717

1818
fns<- c(
1919
"gaussian_type_one.rds",
20+
"log_normal_type_one.rds",
2021
"gaussian_type_one_one_way.rds",
2122
"gamma_type_one_rate.rds",
2223
"gamma_type_one_rate_one_way.rds",
@@ -55,7 +56,7 @@ typeI %>%
5556

5657
typeI %>%
5758
distinct(test) %>%
58-
nrow()==36
59+
nrow()==38
5960

6061
typeI %>%
6162
distinct(alt) %>%

0 commit comments

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