Skip to content

Commit

Permalink
latent distribution update
Browse files Browse the repository at this point in the history
  • Loading branch information
SeewooLi committed Apr 25, 2023
1 parent a97c344 commit 91e00e2
Show file tree
Hide file tree
Showing 4 changed files with 12 additions and 9 deletions.
4 changes: 2 additions & 2 deletions R/IRTest_Dich.R
Original file line number Diff line number Diff line change
Expand Up @@ -240,7 +240,7 @@ IRTest_Dich <- function(initialitem, data, range = c(-6,6), q = 121, model,
M1 <- M1step(E, item=initialitem, model=model)
initialitem <- M1[[1]]

ld_est <- latent_dist_est(method = latent_dist, Xk = E$Xk, posterior = E$fk, range=range, bandwidth=bandwidth, N=N)
ld_est <- latent_dist_est(method = latent_dist, Xk = E$Xk, posterior = E$fk, range=range, bandwidth=bandwidth, N=N, q=q)
Xk <- ld_est$Xk
Ak <- ld_est$posterior_density
# post_den <- E$fk/sum(E$fk)
Expand All @@ -256,7 +256,7 @@ IRTest_Dich <- function(initialitem, data, range = c(-6,6), q = 121, model,
message("\r","\r","Method = ",latent_dist,", EM cycle = ",iter,", Max-Change = ",diff,sep="",appendLF=FALSE)
flush.console()
}
bw <- c(SJPI$bw, SJPI$n)
bw <- ld_est$bw
}

# Davidian curve method
Expand Down
4 changes: 2 additions & 2 deletions R/IRTest_Mix.R
Original file line number Diff line number Diff line change
Expand Up @@ -288,7 +288,7 @@ if(nrow(data_D)!=nrow(data_P)){
initialitem_D <- M1_D[[1]]
initialitem_P <- M1_P[[1]]

ld_est <- latent_dist_est(method = latent_dist, Xk = E$Xk, posterior = E$fk, range=range, bandwidth=bandwidth)
ld_est <- latent_dist_est(method = latent_dist, Xk = E$Xk, posterior = E$fk, range=range, bandwidth=bandwidth, N=N, q=q)
Xk <- ld_est$Xk
Ak <- ld_est$posterior_density

Expand All @@ -299,7 +299,7 @@ if(nrow(data_D)!=nrow(data_P)){
message("\r","\r","Method = ",latent_dist,", EM cycle = ",iter,", Max-Change = ",diff,sep="",appendLF=FALSE)
flush.console()
}
bw <- c(SJPI$bw, SJPI$n)
bw <- ld_est$bw
}

# Davidian curve method
Expand Down
4 changes: 2 additions & 2 deletions R/IRTest_Poly.R
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,7 @@ IRTest_Poly <- function(initialitem, data, range = c(-6,6), q = 121, model,
M1 <- Mstep_Poly(E, item=initialitem, model=model)
initialitem <- M1[[1]]

ld_est <- latent_dist_est(method = latent_dist, Xk = E$Xk, posterior = E$fk, range=range, bandwidth=bandwidth)
ld_est <- latent_dist_est(method = latent_dist, Xk = E$Xk, posterior = E$fk, range=range, bandwidth=bandwidth, N=N, q=q)
Xk <- ld_est$Xk
Ak <- ld_est$posterior_density

Expand All @@ -239,7 +239,7 @@ IRTest_Poly <- function(initialitem, data, range = c(-6,6), q = 121, model,
message("\r","\r","Method = ",latent_dist,", EM cycle = ",iter,", Max-Change = ",diff,sep="",appendLF=FALSE)
flush.console()
}
bw <- c(SJPI$bw, SJPI$n)
bw <- ld_est$bw
}

# Davidian curve method
Expand Down
9 changes: 6 additions & 3 deletions R/non_exporting_functions.R
Original file line number Diff line number Diff line change
Expand Up @@ -462,13 +462,13 @@ lin_inex <- function(qp, qh, range, rule=2){
#################################################################################################################
# Latent distribution estimation
#################################################################################################################
latent_dist_est <- function(method, Xk, posterior, range, bandwidth = NULL, phipar=NULL){
latent_dist_est <- function(method, Xk, posterior, range,
bandwidth = NULL, phipar=NULL, N=NULL, q=NULL){
if(method=='EHM'){
post_den <- posterior/sum(posterior)
lin <- lin_inex(Xk, post_den, range = range)
}
if(method=='KDE'){
N <- sum(posterior)
post_den <- posterior/sum(posterior)
post_den <- lin_inex(Xk, post_den, range = range)$qh
nzindex <- round(post_den*N)!=0
Expand All @@ -494,7 +494,10 @@ latent_dist_est <- function(method, Xk, posterior, range, bandwidth = NULL, phip
return(
list(
posterior_density = lin$qh,
Xk = lin$qp
Xk = lin$qp,
if(method=='KDE'){
bw <- c(SJPI$bw, SJPI$n)
} else NULL
)
)
}
Expand Down

0 comments on commit 91e00e2

Please sign in to comment.