Bölmə 9: Fisher Information Funksiyası
Kompüter Adaptiv Testləşmə (CAT) Tədrisi
CAT Tədrisi
2025-07-12
1 Giriş
Fisher Information Funksiyası CAT sistemlərinin ürəyindədir. Bu funksiya hər bir tapşırığın müəyyən qabiliyyət səviyyəsində nə qədər məlumat verə biləcəyini ölçür və adaptiv item seçiminin əsasını təşkil edir.
Fisher Information nəzəriyyəsi IRT-nin riyazi əsaslarından biridir və CAT-da optimal tapşırıq seçimi üçün ən vacib alətdir. Bu bölmədə Fisher Information funksiyasının riyazi əsaslarını, hesablanma metodlarını və praktiki tətbiqlərini öyrənəcəksiniz.
2 Fisher Information Nəzəriyyəsinin Əsasları
2.1 Riyazi Təməl
# Fisher Information nəzəriyyəsinin izahı
explain_fisher_information <- function() {
cat("=== FISHER INFORMATION NƏZƏRİYYƏSİ ===\n\n")
cat("Fisher Information parametr qiymətləndirilməsinin dəqiqliyini ölçür.\n")
cat("3PL model üçün Fisher Information tənliyi:\n\n")
cat("I(θ) = a² × [P'(θ)]² / [P(θ) × Q(θ)]\n\n")
cat("Burada:\n")
cat("• P(θ) = c + (1-c) × [1/(1 + e^(-a(θ-b)))]\n")
cat("• Q(θ) = 1 - P(θ)\n")
cat("• P'(θ) = birinci törəmə\n\n")
cat("Sadələşdirilmiş forma:\n")
cat("I(θ) = a² × (P-c)² × Q / [(1-c)² × P]\n\n")
cat("Fisher Information xüsusiyyətləri:\n")
cat("✓ Həmişə qeyri-mənfi\n")
cat("✓ Yüksək ayrıd edicilik → Yüksək məlumat\n")
cat("✓ θ ≈ b olduqda maksimum\n")
cat("✓ 1/√I(θ) = Standart xəta\n")
}
explain_fisher_information()## === FISHER INFORMATION NƏZƏRİYYƏSİ ===
##
## Fisher Information parametr qiymətləndirilməsinin dəqiqliyini ölçür.
## 3PL model üçün Fisher Information tənliyi:
##
## I(θ) = a² × [P'(θ)]² / [P(θ) × Q(θ)]
##
## Burada:
## • P(θ) = c + (1-c) × [1/(1 + e^(-a(θ-b)))]
## • Q(θ) = 1 - P(θ)
## • P'(θ) = birinci törəmə
##
## Sadələşdirilmiş forma:
## I(θ) = a² × (P-c)² × Q / [(1-c)² × P]
##
## Fisher Information xüsusiyyətləri:
## ✓ Həmişə qeyri-mənfi
## ✓ Yüksək ayrıd edicilik → Yüksək məlumat
## ✓ θ ≈ b olduqda maksimum
## ✓ 1/√I(θ) = Standart xəta2.2 Əsas Fisher Information Funksiyası
# Fisher Information funksiyası
fisher_information <- function(theta, a, b, c) {
# 3PL model üçün Fisher Information
# P(θ) və Q(θ) hesablayın
P <- c + (1 - c) * plogis(a * (theta - b))
Q <- 1 - P
# Xüsusi halları yoxlayın
if (P <= 0 || P >= 1 || Q <= 0) {
return(0)
}
# Fisher Information hesablayın
# I(θ) = a² × (P-c)² × Q / [(1-c)² × P]
numerator <- a^2 * (P - c)^2 * Q
denominator <- (1 - c)^2 * P
if (denominator > 0) {
info <- numerator / denominator
return(info)
} else {
return(0)
}
}
# Vektor versiyası
fisher_information_vector <- function(theta, a, b, c) {
# Çoxlu theta dəyərləri üçün
sapply(theta, function(t) fisher_information(t, a, b, c))
}
# Nümunə hesablama
theta_test <- 0.5
a_test <- 1.5
b_test <- 0.0
c_test <- 0.2
info_value <- fisher_information(theta_test, a_test, b_test, c_test)
cat("Nümunə Fisher Information:\n")## Nümunə Fisher Information:## θ = 0.5 , a = 1.5 , b = 0 , c = 0.2## I(θ) = 0.3584## SE = 1.67053 Item Information Funksiyalarının Vizuallaşdırılması
3.1 Tək Tapşırıq üçün Information Əyrisi
# Tək tapşırıq üçün information əyrisi
plot_single_item_information <- function(a, b, c, theta_range = c(-4, 4), title = NULL) {
if(is.null(title)) {
title <- paste("Item Information Funksiyası (a =", a, ", b =", b, ", c =", c, ")")
}
# Theta aralığı
theta <- seq(theta_range[1], theta_range[2], 0.05)
# Information hesablayın
information <- fisher_information_vector(theta, a, b, c)
# P(θ) də hesablayın müqayisə üçün
prob <- c + (1 - c) * plogis(a * (theta - b))
# Məlumatlar frame
data <- data.frame(
theta = theta,
information = information,
probability = prob
)
# İki y-axis qrafiki
p1 <- ggplot(data, aes(x = theta)) +
geom_line(aes(y = information), color = "blue", size = 1.5) +
geom_area(aes(y = information), alpha = 0.3, fill = "lightblue") +
labs(title = title,
x = "Qabiliyyət Səviyyəsi (θ)",
y = "Fisher Information") +
theme_minimal() +
geom_vline(xintercept = b, linetype = "dashed", color = "red", alpha = 0.7) +
annotate("text", x = b + 0.5, y = max(information) * 0.8,
label = paste("b =", b), color = "red")
# ICC və Information birlikdə
# Information-u 0-1 aralığına normallaşdır
max_info <- max(information)
data$info_scaled <- information / max_info
p2 <- ggplot(data, aes(x = theta)) +
geom_line(aes(y = probability, color = "ICC"), size = 1.2) +
geom_line(aes(y = info_scaled, color = "Information (scaled)"), size = 1.2) +
scale_color_manual(values = c("ICC" = "blue", "Information (scaled)" = "red"),
name = "Funksiya") +
labs(title = "ICC və Information Müqayisəsi",
x = "Qabiliyyət Səviyyəsi (θ)",
y = "Dəyər (0-1)") +
theme_minimal() +
geom_vline(xintercept = b, linetype = "dashed", alpha = 0.5) +
theme(legend.position = "bottom")
# Statistik məlumatlar
max_info_theta <- theta[which.max(information)]
cat("=== INFORMATION FUNKSİYASI STATİSTİKALARI ===\n")
cat("Maksimum məlumat:", round(max(information), 4), "\n")
cat("Maksimum məlumat θ-da:", round(max_info_theta, 3), "\n")
cat("θ = b nöqtəsində məlumat:", round(fisher_information(b, a, b, c), 4), "\n")
cat("θ = 0 nöqtəsində məlumat:", round(fisher_information(0, a, b, c), 4), "\n")
# Qrafiklər
grid.arrange(p1, p2, ncol = 1)
return(data)
}
# Nümunə item information
if(!exists("item_bank")) {
# Sadə bank yaradılması
set.seed(12345)
item_bank <- data.frame(
item_id = 1:20,
a = runif(20, 0.8, 2.5),
b = rnorm(20, 0, 1),
c = runif(20, 0.1, 0.25)
)
}
# İlk tapşırıq üçün information əyrisi
item_info_1 <- plot_single_item_information(
item_bank$a[1],
item_bank$b[1],
item_bank$c[1]
)## === INFORMATION FUNKSİYASI STATİSTİKALARI ===
## Maksimum məlumat: 0.6739
## Maksimum məlumat θ-da: 0
## θ = b nöqtəsində məlumat: 0.6575
## θ = 0 nöqtəsində məlumat: 0.6739
3.2 Müxtəlif Parametrlərlə Information Müqayisəsi
# Müxtəlif parametrlərin information-a təsiri
compare_parameter_effects <- function() {
theta <- seq(-4, 4, 0.05)
# 1. Ayrıd edicilik parametrinin təsiri
a_values <- c(0.5, 1.0, 1.5, 2.0, 2.5)
b_fixed <- 0
c_fixed <- 0.2
a_effects_data <- data.frame()
for(a_val in a_values) {
info <- fisher_information_vector(theta, a_val, b_fixed, c_fixed)
temp_data <- data.frame(
theta = theta,
information = info,
parameter = paste("a =", a_val),
param_type = "Ayrıd Edicilik"
)
a_effects_data <- rbind(a_effects_data, temp_data)
}
p1 <- ggplot(a_effects_data, aes(x = theta, y = information, color = parameter)) +
geom_line(size = 1.2) +
labs(title = "Ayrıd Edicilik Parametrinin Information-a Təsiri",
subtitle = paste("b =", b_fixed, ", c =", c_fixed),
x = "θ", y = "Fisher Information", color = "Parametr") +
theme_minimal() +
scale_color_viridis_d() +
theme(legend.position = "bottom")
# 2. Çətinlik parametrinin təsiri
b_values <- c(-2, -1, 0, 1, 2)
a_fixed <- 1.5
b_effects_data <- data.frame()
for(b_val in b_values) {
info <- fisher_information_vector(theta, a_fixed, b_val, c_fixed)
temp_data <- data.frame(
theta = theta,
information = info,
parameter = paste("b =", b_val),
param_type = "Çətinlik"
)
b_effects_data <- rbind(b_effects_data, temp_data)
}
p2 <- ggplot(b_effects_data, aes(x = theta, y = information, color = parameter)) +
geom_line(size = 1.2) +
labs(title = "Çətinlik Parametrinin Information-a Təsiri",
subtitle = paste("a =", a_fixed, ", c =", c_fixed),
x = "θ", y = "Fisher Information", color = "Parametr") +
theme_minimal() +
scale_color_viridis_d() +
theme(legend.position = "bottom")
# 3. Təsadüfi cavab parametrinin təsiri
c_values <- c(0.0, 0.1, 0.2, 0.3, 0.4)
c_effects_data <- data.frame()
for(c_val in c_values) {
info <- fisher_information_vector(theta, a_fixed, b_fixed, c_val)
temp_data <- data.frame(
theta = theta,
information = info,
parameter = paste("c =", c_val),
param_type = "Təsadüfi Cavab"
)
c_effects_data <- rbind(c_effects_data, temp_data)
}
p3 <- ggplot(c_effects_data, aes(x = theta, y = information, color = parameter)) +
geom_line(size = 1.2) +
labs(title = "Təsadüfi Cavab Parametrinin Information-a Təsiri",
subtitle = paste("a =", a_fixed, ", b =", b_fixed),
x = "θ", y = "Fisher Information", color = "Parametr") +
theme_minimal() +
scale_color_viridis_d() +
theme(legend.position = "bottom")
# Bütün qrafiklər
grid.arrange(p1, p2, p3, ncol = 1)
return(list(a_effects = a_effects_data, b_effects = b_effects_data, c_effects = c_effects_data))
}
# Parametr təsirlərinin müqayisəsi
parameter_effects <- compare_parameter_effects()
4 Test Information Funksiyası
4.1 Test Information Hesablanması
# Test Information Funksiyası hesablanması
calculate_test_information <- function(item_bank, theta_range = c(-4, 4)) {
cat("=== TEST INFORMATION FUNKSİYASI HESABLAMASI ===\n")
# Theta nöqtələri
theta <- seq(theta_range[1], theta_range[2], 0.1)
# Hər tapşırıq üçün information matrix
n_items <- nrow(item_bank)
n_theta <- length(theta)
item_info_matrix <- matrix(0, nrow = n_theta, ncol = n_items)
cat("Hər tapşırıq üçün information hesablanır...\n")
for(i in 1:n_items) {
a <- item_bank$a[i]
b <- item_bank$b[i]
c <- item_bank$c[i]
# Bu tapşırıq üçün information
item_info <- fisher_information_vector(theta, a, b, c)
item_info_matrix[, i] <- item_info
if(i %% 20 == 0) cat("İşlənilən:", i, "/", n_items, "\n")
}
# Test information (bütün tapşırıqların cəmi)
test_information <- rowSums(item_info_matrix)
# Standard error
standard_error <- 1 / sqrt(test_information)
standard_error[is.infinite(standard_error)] <- NA
# Reliability
reliability <- 1 - 1/test_information
reliability[reliability < 0] <- 0
# Nəticə data frame
tif_data <- data.frame(
theta = theta,
test_information = test_information,
standard_error = standard_error,
reliability = reliability
)
# Statistikalar
cat("\n=== TIF STATİSTİKALARI ===\n")
cat("Maksimum test information:", round(max(test_information), 2), "\n")
cat("Maksimum info θ-da:", round(theta[which.max(test_information)], 2), "\n")
cat("θ = 0 nöqtəsində information:", round(test_information[theta == 0], 2), "\n")
cat("Minimum SE:", round(min(standard_error, na.rm = TRUE), 3), "\n")
cat("θ = 0 nöqtəsində SE:", round(standard_error[theta == 0], 3), "\n")
return(list(
tif_data = tif_data,
item_info_matrix = item_info_matrix,
theta = theta
))
}
# Test information hesablayın
if(nrow(item_bank) < 50) {
# Daha böyük bank yaradın
set.seed(12345)
item_bank <- data.frame(
item_id = 1:100,
a = runif(100, 0.8, 2.5),
b = rnorm(100, 0, 1.2),
c = runif(100, 0.1, 0.25)
)
}
tif_results <- calculate_test_information(item_bank)## === TEST INFORMATION FUNKSİYASI HESABLAMASI ===
## Hər tapşırıq üçün information hesablanır...
## İşlənilən: 20 / 100
## İşlənilən: 40 / 100
## İşlənilən: 60 / 100
## İşlənilən: 80 / 100
## İşlənilən: 100 / 100
##
## === TIF STATİSTİKALARI ===
## Maksimum test information: 23.3
## Maksimum info θ-da: 0.3
## θ = 0 nöqtəsində information: 22.79
## Minimum SE: 0.207
## θ = 0 nöqtəsində SE: 0.2094.2 TIF Vizuallaşdırması
# Test Information Funksiyası vizuallaşdırması
visualize_test_information <- function(tif_results) {
tif_data <- tif_results$tif_data
# 1. Test Information əyrisi
p1 <- ggplot(tif_data, aes(x = theta, y = test_information)) +
geom_line(size = 1.5, color = "blue") +
geom_area(alpha = 0.3, fill = "lightblue") +
labs(title = "Test Information Funksiyası",
subtitle = paste("Ümumi", nrow(item_bank), "tapşırıq"),
x = "Qabiliyyət Səviyyəsi (θ)",
y = "Test Information") +
theme_minimal() +
geom_vline(xintercept = 0, linetype = "dashed", alpha = 0.5) +
annotate("text", x = 0.5, y = max(tif_data$test_information) * 0.9,
label = paste("Max:", round(max(tif_data$test_information), 1)))
# 2. Standard Error əyrisi
p2 <- ggplot(tif_data, aes(x = theta, y = standard_error)) +
geom_line(size = 1.5, color = "red") +
geom_ribbon(aes(ymin = 0, ymax = standard_error), alpha = 0.3, fill = "lightcoral") +
geom_hline(yintercept = c(0.25, 0.35, 0.5), linetype = "dashed", alpha = 0.7) +
labs(title = "Standart Xəta Funksiyası",
x = "Qabiliyyət Səviyyəsi (θ)",
y = "Standart Xəta") +
theme_minimal() +
annotate("text", x = 3, y = 0.25, label = "SE = 0.25", size = 3) +
annotate("text", x = 3, y = 0.35, label = "SE = 0.35", size = 3) +
annotate("text", x = 3, y = 0.5, label = "SE = 0.50", size = 3)
# 3. Reliability əyrisi
p3 <- ggplot(tif_data, aes(x = theta, y = reliability)) +
geom_line(size = 1.5, color = "green") +
geom_ribbon(aes(ymin = 0, ymax = reliability), alpha = 0.3, fill = "lightgreen") +
geom_hline(yintercept = c(0.8, 0.9, 0.95), linetype = "dashed", alpha = 0.7) +
labs(title = "Etibarlılıq Funksiyası",
x = "Qabiliyyət Səviyyəsi (θ)",
y = "Etibarlılıq") +
theme_minimal() +
ylim(0, 1) +
annotate("text", x = 3, y = 0.8, label = "r = 0.80", size = 3) +
annotate("text", x = 3, y = 0.9, label = "r = 0.90", size = 3) +
annotate("text", x = 3, y = 0.95, label = "r = 0.95", size = 3)
# 4. TIF və SE birlikdə (ikiqat y-axis)
# SE-ni ters çevirin (yüksək info = aşağı SE)
max_info <- max(tif_data$test_information)
tif_data$se_inverted <- max_info * (1 - tif_data$standard_error/max(tif_data$standard_error, na.rm = TRUE))
p4 <- ggplot(tif_data, aes(x = theta)) +
geom_line(aes(y = test_information, color = "Test Information"), size = 1.5) +
geom_line(aes(y = se_inverted, color = "SE (inverted)"), size = 1.5) +
scale_color_manual(values = c("Test Information" = "blue", "SE (inverted)" = "red"),
name = "Metrik") +
labs(title = "TIF və SE Qarşılıqlı Əlaqəsi",
x = "Qabiliyyət Səviyyəsi (θ)",
y = "Dəyər") +
theme_minimal() +
theme(legend.position = "bottom")
# Layout
grid.arrange(p1, p2, p3, p4, ncol = 2)
}
# TIF vizuallaşdırması
visualize_test_information(tif_results)
5 Adaptiv Item Seçimi
5.1 Maximum Fisher Information (MFI) Metodu
# Tapşırıq seçmə funksiyası (MFI metodu)
select_next_item <- function(theta_current, item_bank, administered_items = c()) {
# Hal-hazırda istifadə edilməmiş tapşırıqlar
available_items <- setdiff(1:nrow(item_bank), administered_items)
if (length(available_items) == 0) {
return(NULL) # Tapşırıq qalmayıb
}
# Hər mövcud tapşırıq üçün Fisher Information hesabla
fisher_values <- sapply(available_items, function(i) {
fisher_information(theta_current,
item_bank$a[i],
item_bank$b[i],
item_bank$c[i])
})
# Ən yüksək informasiya verən tapşırığı seç
best_item_index <- available_items[which.max(fisher_values)]
return(list(
item_index = best_item_index,
information = max(fisher_values),
available_count = length(available_items),
all_information = fisher_values,
available_items = available_items
))
}
# Item seçimi simulyasiyası
simulate_item_selection <- function(item_bank, true_theta = 0, max_items = 10) {
cat("=== ADAPTIV TAPŞIRIQ SEÇİMİ SİMULYASİYASI ===\n")
cat("Həqiqi θ:", true_theta, "\n")
cat("Maksimum tapşırıq sayı:", max_items, "\n\n")
administered_items <- c()
responses <- c()
theta_estimates <- c()
information_values <- c()
se_values <- c()
current_theta <- 0 # Başlanğıc qiymətləndirmə
for(item_num in 1:max_items) {
cat("--- TAPŞIRIQ", item_num, "---\n")
# Növbəti tapşırığı seç
selection_result <- select_next_item(current_theta, item_bank, administered_items)
if(is.null(selection_result)) {
cat("Tapşırıq qalmadı!\n")
break
}
selected_item <- selection_result$item_index
expected_info <- selection_result$information
cat("Seçilən tapşırıq:", selected_item, "\n")
cat("Gözlənilən information:", round(expected_info, 4), "\n")
# Tapşırıq parametrləri
a <- item_bank$a[selected_item]
b <- item_bank$b[selected_item]
c <- item_bank$c[selected_item]
cat("Parametrlər: a =", round(a, 3), ", b =", round(b, 3), ", c =", round(c, 3), "\n")
# Cavabı simulyasiya et
true_prob <- c + (1 - c) * plogis(a * (true_theta - b))
response <- rbinom(1, 1, true_prob)
cat("Həqiqi P(doğru):", round(true_prob, 3), "\n")
cat("Simulyasiya cavabı:", response, "\n")
# Məlumatları yaddaşda saxla
administered_items <- c(administered_items, selected_item)
responses <- c(responses, response)
information_values <- c(information_values, expected_info)
# Theta-nı yenidən qiymətləndir (sadə MLE)
if(length(responses) >= 2) {
current_theta <- estimate_theta_mle(administered_items, responses, item_bank)
}
theta_estimates <- c(theta_estimates, current_theta)
# SE hesabla
total_info <- 0
for(j in 1:length(administered_items)) {
item_idx <- administered_items[j]
total_info <- total_info + fisher_information(current_theta,
item_bank$a[item_idx],
item_bank$b[item_idx],
item_bank$c[item_idx])
}
current_se <- ifelse(total_info > 0, 1/sqrt(total_info), 1)
se_values <- c(se_values, current_se)
cat("Yeni θ qiymətləndirilməsi:", round(current_theta, 3), "\n")
cat("Cari SE:", round(current_se, 3), "\n")
cat("θ xətası:", round(abs(current_theta - true_theta), 3), "\n\n")
}
# Nəticələr
results <- data.frame(
Item_Number = 1:length(administered_items),
Item_ID = administered_items,
Response = responses,
Theta_Estimate = theta_estimates,
SE = se_values,
Information = information_values,
Theta_Error = abs(theta_estimates - true_theta)
)
cat("=== FINAL NƏTİCƏLƏR ===\n")
cat("İstifadə edilən tapşırıq sayı:", length(administered_items), "\n")
cat("Final θ qiymətləndirilməsi:", round(tail(theta_estimates, 1), 3), "\n")
cat("Həqiqi θ:", true_theta, "\n")
cat("Final xəta:", round(tail(results$Theta_Error, 1), 3), "\n")
cat("Final SE:", round(tail(se_values, 1), 3), "\n")
return(results)
}
# Sadə MLE qiymətləndirici
estimate_theta_mle <- function(item_indices, responses, item_bank, max_iter = 10) {
theta <- 0 # Başlanğıc dəyər
for(iter in 1:max_iter) {
first_deriv <- 0
second_deriv <- 0
for(i in 1:length(item_indices)) {
item_idx <- item_indices[i]
response <- responses[i]
a <- item_bank$a[item_idx]
b <- item_bank$b[item_idx]
c <- item_bank$c[item_idx]
P <- c + (1 - c) * plogis(a * (theta - b))
Q <- 1 - P
if(P > 0.001 && P < 0.999) { # Numerical stability
first_deriv <- first_deriv + a * (response - P) / (P * Q) * (P - c)
second_deriv <- second_deriv - a^2 * (P - c)^2 / (P * Q) +
a^2 * (response - P) * (P - c) * (Q - P) / (P^2 * Q^2)
}
}
if(abs(second_deriv) > 0.001) {
theta_new <- theta - first_deriv / second_deriv
if(abs(theta_new - theta) < 0.001) break
theta <- theta_new
}
}
# Extreme dəyərləri məhdudlaşdır
theta <- pmax(-4, pmin(4, theta))
return(theta)
}
# Nümunə item seçimi simulyasiyası
set.seed(123)
selection_results <- simulate_item_selection(item_bank, true_theta = 0.5, max_items = 8)## === ADAPTIV TAPŞIRIQ SEÇİMİ SİMULYASİYASI ===
## Həqiqi θ: 0.5
## Maksimum tapşırıq sayı: 8
##
## --- TAPŞIRIQ 1 ---
## Seçilən tapşırıq: 65
## Gözlənilən information: 1.1361
## Parametrlər: a = 2.466 , b = -0.097 , c = 0.151
## Həqiqi P(doğru): 0.842
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 0
## Cari SE: 0.938
## θ xətası: 0.5
##
## --- TAPŞIRIQ 2 ---
## Seçilən tapşırıq: 70
## Gözlənilən information: 1.0152
## Parametrlər: a = 2.409 , b = -0.083 , c = 0.186
## Həqiqi P(doğru): 0.839
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 0.665
## Cari SE: 0.938
## θ xətası: 0.165
##
## --- TAPŞIRIQ 3 ---
## Seçilən tapşırıq: 4
## Gözlənilən information: 0.8866
## Parametrlər: a = 2.306 , b = 0.422 , c = 0.198
## Həqiqi P(doğru): 0.635
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 0.758
## Cari SE: 0.743
## θ xətası: 0.258
##
## --- TAPŞIRIQ 4 ---
## Seçilən tapşırıq: 31
## Gözlənilən information: 0.8336
## Parametrlər: a = 2.148 , b = 0.774 , c = 0.158
## Həqiqi P(doğru): 0.459
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 0.854
## Cari SE: 0.641
## θ xətası: 0.354
##
## --- TAPŞIRIQ 5 ---
## Seçilən tapşırıq: 37
## Gözlənilən information: 0.8012
## Parametrlər: a = 2.277 , b = 0.806 , c = 0.244
## Həqiqi P(doğru): 0.495
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 0.922
## Cari SE: 0.569
## θ xətası: 0.422
##
## --- TAPŞIRIQ 6 ---
## Seçilən tapşırıq: 98
## Gözlənilən information: 0.7533
## Parametrlər: a = 2.075 , b = 1.02 , c = 0.157
## Həqiqi P(doğru): 0.371
## Simulyasiya cavabı: 0
## Yeni θ qiymətləndirilməsi: 0.863
## Cari SE: 0.503
## θ xətası: 0.363
##
## --- TAPŞIRIQ 7 ---
## Seçilən tapşırıq: 51
## Gözlənilən information: 0.6976
## Parametrlər: a = 2.44 , b = 0.269 , c = 0.203
## Həqiqi P(doğru): 0.711
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 0.897
## Cari SE: 0.468
## θ xətası: 0.397
##
## --- TAPŞIRIQ 8 ---
## Seçilən tapşırıq: 27
## Gözlənilən information: 0.7087
## Parametrlər: a = 1.988 , b = 0.992 , c = 0.147
## Həqiqi P(doğru): 0.38
## Simulyasiya cavabı: 1
## Yeni θ qiymətləndirilməsi: 1.002
## Cari SE: 0.448
## θ xətası: 0.502
##
## === FINAL NƏTİCƏLƏR ===
## İstifadə edilən tapşırıq sayı: 8
## Final θ qiymətləndirilməsi: 1.002
## Həqiqi θ: 0.5
## Final xəta: 0.502
## Final SE: 0.448##
## Tapşırıq seçimi nəticələri:## Item_Number Item_ID Response Theta_Estimate SE Information Theta_Error
## 1 1 65 1 0.0000000 0.9382046 1.1360695 0.5000000
## 2 2 70 1 0.6654146 0.9380333 1.0151846 0.1654146
## 3 3 4 1 0.7575729 0.7434146 0.8865897 0.2575729
## 4 4 31 1 0.8538493 0.6405560 0.8335830 0.3538493
## 5 5 37 1 0.9224456 0.5686201 0.8011843 0.4224456
## 6 6 98 0 0.8625864 0.5033772 0.7533159 0.3625864
## 7 7 51 1 0.8966814 0.4684973 0.6976145 0.3966814
## 8 8 27 1 1.0023198 0.4480295 0.7087087 0.50231985.2 Item Seçimi Strategiyalarının Müqayisəsi
# Müxtəlif item seçimi strategiyalarının müqayisəsi
compare_selection_strategies <- function(item_bank, true_theta = 0, max_items = 15) {
cat("=== TAPŞIRIQ SEÇİMİ STRATEGİYALARININ MÜQAYİSƏSİ ===\n\n")
strategies <- c("MFI", "Random", "Difficulty_Matching")
results_all <- list()
for(strategy in strategies) {
cat("Strategiya:", strategy, "\n")
administered_items <- c()
responses <- c()
theta_estimates <- c()
se_values <- c()
current_theta <- 0
for(item_num in 1:max_items) {
# Strategiyaya görə item seç
if(strategy == "MFI") {
# Maximum Fisher Information
selection <- select_next_item(current_theta, item_bank, administered_items)
if(is.null(selection)) break
selected_item <- selection$item_index
} else if(strategy == "Random") {
# Təsadüfi seçim
available_items <- setdiff(1:nrow(item_bank), administered_items)
if(length(available_items) == 0) break
selected_item <- sample(available_items, 1)
} else if(strategy == "Difficulty_Matching") {
# Çətinlik uyğunlaşdırması (b ≈ θ)
available_items <- setdiff(1:nrow(item_bank), administered_items)
if(length(available_items) == 0) break
difficulty_differences <- abs(item_bank$b[available_items] - current_theta)
best_match_idx <- which.min(difficulty_differences)
selected_item <- available_items[best_match_idx]
}
# Cavabı simulyasiya et
a <- item_bank$a[selected_item]
b <- item_bank$b[selected_item]
c <- item_bank$c[selected_item]
true_prob <- c + (1 - c) * plogis(a * (true_theta - b))
response <- rbinom(1, 1, true_prob)
administered_items <- c(administered_items, selected_item)
responses <- c(responses, response)
# Theta qiymətləndirilməsi
if(length(responses) >= 2) {
current_theta <- estimate_theta_mle(administered_items, responses, item_bank)
}
theta_estimates <- c(theta_estimates, current_theta)
# SE hesablama
total_info <- sum(sapply(administered_items, function(idx) {
fisher_information(current_theta, item_bank$a[idx],
item_bank$b[idx], item_bank$c[idx])
}))
current_se <- ifelse(total_info > 0, 1/sqrt(total_info), 1)
se_values <- c(se_values, current_se)
}
# Nəticələri saxla
results_all[[strategy]] <- data.frame(
Strategy = strategy,
Item_Number = 1:length(theta_estimates),
Theta_Estimate = theta_estimates,
SE = se_values,
Theta_Error = abs(theta_estimates - true_theta)
)
cat("Final θ:", round(tail(theta_estimates, 1), 3),
"| Final SE:", round(tail(se_values, 1), 3),
"| Final error:", round(tail(abs(theta_estimates - true_theta), 1), 3), "\n\n")
}
return(results_all)
}
# Strategiyaları müqayisə et
set.seed(456)
strategy_comparison <- compare_selection_strategies(item_bank, true_theta = 1.0, max_items = 12)## === TAPŞIRIQ SEÇİMİ STRATEGİYALARININ MÜQAYİSƏSİ ===
##
## Strategiya: MFI
## Final θ: 1.064 | Final SE: 0.376 | Final error: 0.064
##
## Strategiya: Random
## Final θ: 0.086 | Final SE: 0.566 | Final error: 0.914
##
## Strategiya: Difficulty_Matching
## Final θ: 3.748 | Final SE: 1.351 | Final error: 2.7485.3 Strategiya Müqayisəsi Vizuallaşdırması
# Strategiya müqayisəsi vizuallaşdırması
visualize_strategy_comparison <- function(strategy_results) {
# Bütün nəticələri birləşdir
combined_data <- do.call(rbind, strategy_results)
# 1. Theta konvergensiyası
p1 <- ggplot(combined_data, aes(x = Item_Number, y = Theta_Estimate, color = Strategy)) +
geom_line(size = 1.2) +
geom_point(size = 2) +
geom_hline(yintercept = 1.0, linetype = "dashed", color = "red") + # True theta
labs(title = "Theta Qiymətləndirilməsinin Konvergensiyası",
subtitle = "Həqiqi θ = 1.0",
x = "Tapşırıq Nömrəsi", y = "θ Qiymətləndirilməsi") +
theme_minimal() +
scale_color_viridis_d() +
theme(legend.position = "bottom")
# 2. Standart xəta azalması
p2 <- ggplot(combined_data, aes(x = Item_Number, y = SE, color = Strategy)) +
geom_line(size = 1.2) +
geom_point(size = 2) +
geom_hline(yintercept = c(0.25, 0.35), linetype = "dashed", alpha = 0.7) +
labs(title = "Standart Xəta Azalması",
x = "Tapşırıq Nömrəsi", y = "Standart Xəta") +
theme_minimal() +
scale_color_viridis_d() +
theme(legend.position = "bottom") +
annotate("text", x = max(combined_data$Item_Number) * 0.8, y = 0.25,
label = "SE = 0.25", size = 3) +
annotate("text", x = max(combined_data$Item_Number) * 0.8, y = 0.35,
label = "SE = 0.35", size = 3)
# 3. Xəta azalması
p3 <- ggplot(combined_data, aes(x = Item_Number, y = Theta_Error, color = Strategy)) +
geom_line(size = 1.2) +
geom_point(size = 2) +
labs(title = "Theta Xətasının Azalması",
x = "Tapşırıq Nömrəsi", y = "|θ - θ_true|") +
theme_minimal() +
scale_color_viridis_d() +
theme(legend.position = "bottom")
# 4. Final performans müqayisəsi
final_performance <- combined_data %>%
group_by(Strategy) %>%
summarise(
Final_Theta_Error = last(Theta_Error),
Final_SE = last(SE),
Items_Used = max(Item_Number),
.groups = 'drop'
)
p4 <- ggplot(final_performance, aes(x = Strategy, y = Final_Theta_Error, fill = Strategy)) +
geom_col() +
geom_text(aes(label = round(Final_Theta_Error, 3)), vjust = -0.5) +
labs(title = "Final Theta Xətası Müqayisəsi",
x = "Strategiya", y = "Final |θ - θ_true|") +
theme_minimal() +
theme(legend.position = "none") +
scale_fill_viridis_d()
# Layout
grid.arrange(p1, p2, p3, p4, ncol = 2)
# Performans cədvəli
cat("\n=== STRATEGİYA PERFORMANS MÜQAYİSƏSİ ===\n")
print(final_performance)
return(final_performance)
}
# Strategiya müqayisəsi vizuallaşdırması
performance_comparison <- visualize_strategy_comparison(strategy_comparison)
##
## === STRATEGİYA PERFORMANS MÜQAYİSƏSİ ===
## # A tibble: 3 × 4
## Strategy Final_Theta_Error Final_SE Items_Used
## <chr> <dbl> <dbl> <int>
## 1 Difficulty_Matching 2.75 1.35 12
## 2 MFI 0.0638 0.376 12
## 3 Random 0.914 0.566 126 Təkmilləşdirilmiş Information Metodları
6.1 Weighted Information və Bayesian Seçim
# Təkmilləşdirilmiş information metodları
weighted_information_selection <- function(theta_current, item_bank, administered_items = c(),
theta_prior_sd = 1.0, content_balance = TRUE) {
available_items <- setdiff(1:nrow(item_bank), administered_items)
if(length(available_items) == 0) return(NULL)
# 1. Bayesian Expected Information
# Prior: N(0, σ²) paylanması ilə
theta_points <- seq(-4, 4, 0.2)
prior_weights <- dnorm(theta_points, 0, theta_prior_sd)
prior_weights <- prior_weights / sum(prior_weights)
# Hər mövcud tapşırıq üçün expected information
expected_info <- numeric(length(available_items))
for(i in 1:length(available_items)) {
item_idx <- available_items[i]
a <- item_bank$a[item_idx]
b <- item_bank$b[item_idx]
c <- item_bank$c[item_idx]
# Expected information across prior distribution
item_info_values <- sapply(theta_points, function(t) {
fisher_information(t, a, b, c)
})
expected_info[i] <- sum(item_info_values * prior_weights)
}
# 2. Content balancing (əgər tələb olunursa)
if(content_balance && "content_area" %in% names(item_bank)) {
# İstifadə edilmiş məzmun sahələri
used_content <- item_bank$content_area[administered_items]
content_counts <- table(used_content)
# Available items üçün content areas
available_content <- item_bank$content_area[available_items]
# Az istifadə edilmiş content-ə bonus ver
total_used <- length(administered_items)
content_bonus <- numeric(length(available_items))
for(i in 1:length(available_items)) {
content_area <- available_content[i]
if(content_area %in% names(content_counts)) {
usage_rate <- content_counts[content_area] / total_used
} else {
usage_rate <- 0
}
# Az istifadə edilmiş content-ə daha yüksək bonus
content_bonus[i] <- max(0, 0.3 - usage_rate) # 0.3 = target usage rate
}
# Information-a content bonus əlavə et
adjusted_info <- expected_info * (1 + content_bonus)
} else {
adjusted_info <- expected_info
}
# Ən yüksək adjusted information-lu item-i seç
best_item_idx <- which.max(adjusted_info)
selected_item <- available_items[best_item_idx]
return(list(
item_index = selected_item,
expected_information = expected_info[best_item_idx],
adjusted_information = adjusted_info[best_item_idx],
content_bonus = if(content_balance) content_bonus[best_item_idx] else 0,
available_count = length(available_items)
))
}
# Exposure control ilə item seçimi
exposure_controlled_selection <- function(theta_current, item_bank, administered_items = c(),
exposure_rates = NULL, max_exposure = 0.3) {
available_items <- setdiff(1:nrow(item_bank), administered_items)
if(length(available_items) == 0) return(NULL)
# Exposure rates yoxsa, hamısını 0 götür
if(is.null(exposure_rates)) {
exposure_rates <- rep(0, nrow(item_bank))
}
# Fisher information hesabla
fisher_values <- sapply(available_items, function(i) {
fisher_information(theta_current, item_bank$a[i], item_bank$b[i], item_bank$c[i])
})
# Exposure penalty tətbiq et
current_exposures <- exposure_rates[available_items]
exposure_penalty <- pmax(0, (current_exposures - max_exposure * 0.5) / (max_exposure * 0.5))
# Adjusted information (exposure penalty ilə)
adjusted_info <- fisher_values * (1 - exposure_penalty)
# Yüksək exposure-lu itemləri çıxar
valid_items <- current_exposures < max_exposure
if(sum(valid_items) == 0) {
# Hamısının exposure-u yüksəkdirsə, ən az exposure-lu seç
selected_idx <- which.min(current_exposures)
} else {
# Valid itemlər arasından ən yüksək adjusted info-lu seç
valid_adjusted_info <- adjusted_info
valid_adjusted_info[!valid_items] <- -Inf
selected_idx <- which.max(valid_adjusted_info)
}
selected_item <- available_items[selected_idx]
return(list(
item_index = selected_item,
information = fisher_values[selected_idx],
adjusted_information = adjusted_info[selected_idx],
exposure_rate = current_exposures[selected_idx],
exposure_penalty = exposure_penalty[selected_idx]
))
}
# Nümunə advanced seçim
if("content_area" %in% names(item_bank)) {
cat("=== TƏKMİLLƏŞDİRİLMİŞ İTEM SEÇİMİ NÜMUNƏSİ ===\n")
advanced_selection <- weighted_information_selection(
theta_current = 0.8,
item_bank = item_bank,
administered_items = c(1, 5, 10, 23),
content_balance = TRUE
)
cat("Seçilən tapşırıq:", advanced_selection$item_index, "\n")
cat("Expected information:", round(advanced_selection$expected_information, 4), "\n")
cat("Adjusted information:", round(advanced_selection$adjusted_information, 4), "\n")
cat("Content bonus:", round(advanced_selection$content_bonus, 4), "\n")
} else {
cat("Content area məlumatı yoxdur, sadə MFI istifadə edilir.\n")
}## Content area məlumatı yoxdur, sadə MFI istifadə edilir.7 Information Funksiyası Diagnostikası
7.1 Information Keyfiyyət Təhlili
# Information funksiyası keyfiyyət təhlili
analyze_information_quality <- function(item_bank, theta_range = c(-3, 3)) {
cat("=== INFORMATION KEYFİYYƏT TƏHLİLİ ===\n\n")
theta_points <- seq(theta_range[1], theta_range[2], 0.2)
n_items <- nrow(item_bank)
# Hər item üçün information profili
item_info_profiles <- matrix(0, nrow = length(theta_points), ncol = n_items)
for(i in 1:n_items) {
a <- item_bank$a[i]
b <- item_bank$b[i]
c <- item_bank$c[i]
info_profile <- fisher_information_vector(theta_points, a, b, c)
item_info_profiles[, i] <- info_profile
}
# Item keyfiyyət metriklər
item_quality <- data.frame(
Item_ID = 1:n_items,
Max_Information = apply(item_info_profiles, 2, max),
Peak_Theta = theta_points[apply(item_info_profiles, 2, which.max)],
Information_Range = apply(item_info_profiles, 2, function(x) sum(x > max(x) * 0.5) * 0.2),
Average_Information = apply(item_info_profiles, 2, mean)
)
# Test coverage təhlili
total_info_by_theta <- rowSums(item_info_profiles)
coverage_analysis <- data.frame(
Theta = theta_points,
Total_Information = total_info_by_theta,
SE = 1 / sqrt(total_info_by_theta),
Item_Count_Above_1 = rowSums(item_info_profiles > 1.0),
Item_Count_Above_0_5 = rowSums(item_info_profiles > 0.5)
)
# Zəif theta bölgələri
weak_regions <- coverage_analysis[coverage_analysis$Total_Information <
quantile(coverage_analysis$Total_Information, 0.25), ]
cat("INFORMATION COVERAGE ANALİZİ:\n")
cat("Maksimum test information:", round(max(total_info_by_theta), 2), "\n")
cat("Minimum test information:", round(min(total_info_by_theta), 2), "\n")
cat("Information aralığı:", round(max(total_info_by_theta) - min(total_info_by_theta), 2), "\n")
if(nrow(weak_regions) > 0) {
cat("\nZəif information bölgələri (θ):\n")
print(weak_regions$Theta)
} else {
cat("\nZəif information bölgəsi tapılmadı.\n")
}
# Yüksək keyfiyyətli itemlər
high_quality_items <- item_quality[item_quality$Max_Information >
quantile(item_quality$Max_Information, 0.75), ]
cat("\nYüksək keyfiyyətli tapşırıq sayı:", nrow(high_quality_items), "\n")
cat("Orta maksimum information:", round(mean(item_quality$Max_Information), 3), "\n")
# Vizuallaşdırma
# 1. Information heatmap
heatmap_data <- expand.grid(Theta = theta_points, Item = 1:min(50, n_items)) # İlk 50 item
heatmap_data$Information <- as.vector(item_info_profiles[, 1:min(50, n_items)])
p1 <- ggplot(heatmap_data, aes(x = Theta, y = Item, fill = Information)) +
geom_tile() +
scale_fill_viridis_c(name = "Information") +
labs(title = "Item Information Heatmap (İlk 50 tapşırıq)",
x = "Qabiliyyət Səviyyəsi (θ)", y = "Tapşırıq ID") +
theme_minimal()
# 2. Test information profili
p2 <- ggplot(coverage_analysis, aes(x = Theta, y = Total_Information)) +
geom_line(size = 1.5, color = "blue") +
geom_area(alpha = 0.3, fill = "lightblue") +
labs(title = "Test Information Profili",
x = "Qabiliyyət Səviyyəsi (θ)", y = "Test Information") +
theme_minimal()
# 3. Item keyfiyyət paylanması
p3 <- ggplot(item_quality, aes(x = Max_Information)) +
geom_histogram(bins = 20, fill = "lightgreen", alpha = 0.7, color = "black") +
geom_vline(xintercept = mean(item_quality$Max_Information),
color = "red", linetype = "dashed") +
labs(title = "Maksimum Information Paylanması",
x = "Maksimum Information", y = "Tapşırıq Sayı") +
theme_minimal()
grid.arrange(p1, p2, p3, ncol = 1)
return(list(
item_quality = item_quality,
coverage_analysis = coverage_analysis,
weak_regions = weak_regions,
item_info_profiles = item_info_profiles
))
}
# Information keyfiyyət təhlili
info_quality <- analyze_information_quality(item_bank)## === INFORMATION KEYFİYYƏT TƏHLİLİ ===
##
## INFORMATION COVERAGE ANALİZİ:
## Maksimum test information: 23.25
## Minimum test information: 2.95
## Information aralığı: 20.29
##
## Zəif information bölgələri (θ):
## [1] -3.0 -2.8 -2.6 -2.4 -2.2 -2.0 2.8 3.0
##
## Yüksək keyfiyyətli tapşırıq sayı: 25
## Orta maksimum information: 0.532
8 Nəticə
Bu bölmədə Fisher Information Funksiyasının CAT sistemlərindəki əsas rolunu öyrəndik. Fisher Information adaptiv item seçiminin riyazi əsasını təşkil edir və test dəqiqliyini maksimallaşdırmaq üçün vacibdir.
8.1 Əsas Nəticələr
- Fisher Information parametr qiymətləndirilməsinin dəqiqliyini ölçür
- 3PL model üçün Information hesablanması xüsusi diqqət tələb edir
- MFI metodu ən effektiv adaptiv item seçim strategiyasıdır
- Test Information individual item informationlarının cəmidir
- Təkmilləşdirilmiş metodlar content balance və exposure control daxil edir
- Information keyfiyyəti bank effektivliyini müəyyən edir
8.2 Praktiki Tövsiyələr
Item seçimi üçün həmişə Fisher Information istifadə edin
Content balance və exposure control əlavə edin
Information keyfiyyətini müntəzəm monitorinq edin
Zəif theta bölgələrində əlavə itemlər hazırlayın
Test information profilini optimize edin
8.3 Növbəti Addımlar
Bölmə 10: CAT Simulyasiyaları və Dayanma Kriteriyaları
Bölmə 11: CAT Performansının Optimallaşdırılması
Bölmə 12: Real Vaxtda CAT Sistemi İdarəetməsi
Qeyd: Fisher Information CAT sistemlərinin ən vacib riyazi komponentidir. Düzgün hesablanması və tətbiqi test keyfiyyətini birbaşa təsir edir.