library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.3.2
## Warning: package 'ggplot2' was built under R version 4.3.1
## Warning: package 'tibble' was built under R version 4.3.1
## Warning: package 'tidyr' was built under R version 4.3.1
## Warning: package 'readr' was built under R version 4.3.2
## Warning: package 'purrr' was built under R version 4.3.1
## Warning: package 'dplyr' was built under R version 4.3.1
## Warning: package 'stringr' was built under R version 4.3.1
## Warning: package 'forcats' was built under R version 4.3.2
## Warning: package 'lubridate' was built under R version 4.3.2
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ltm)
## Warning: package 'ltm' was built under R version 4.3.3
## Loading required package: MASS
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select
##
## Loading required package: msm
## Warning: package 'msm' was built under R version 4.3.3
## Loading required package: polycor
## Warning: package 'polycor' was built under R version 4.3.3
df_or <- read.csv2("basak_sayisal_veriler.csv")
df <- df_or[-43,]
#glimpse(df)
extract_factors <- function (df,what,howmany,reduce=0){
cat("________________ START --> ", what, "_____________________")
cat("\n")
center <- function(x) { return (x - mean(x))}
df_sub <- df %>% dplyr::select(starts_with(what)) %>% mutate(across(everything(), center))
CA <- round(cronbach.alpha(df_sub) $ alpha,2)
cat("\n")
cat("cronbach_alpa =", CA)
cat("\n")
if (reduce != 0) df_sub=df_sub[,-reduce]
FA<- df_sub%>%factanal(.,howmany, scores ="regression",rotation="promax")
print(FA $ loadings)
explained <- 1-FA $ uniquenesses
barplot(explained,cex.names=0.7, col=1:length(explained),
main="explained proportions by factor analysis")
cat("\n")
cat("explained_proportions:");cat("\n")
print( 1-FA $ uniquenesses);cat("\n")
cat("likelihood ratio test | p-value:", FA $ PVAL); cat("\n")
if(FA $ PVAL<0.05) print("factors are not sufficient")
else cat("\n", "factors are sufficient")
cat("\n")
cat("________________ END _____________________")
outcome <-list(FA,df_sub)
return(outcome)
}
see_sur <- extract_factors(df,"far_sur",2)
## ________________ START --> far_sur _____________________
##
## cronbach_alpa = 0.92
##
## Loadings:
## Factor1 Factor2
## far_sur_kaynak 1.031
## far_sur_gelecek 0.439 0.459
## far_sur_adil_is 0.772
## far_sur_toplum 0.943 -0.143
## far_sur_cevre_koruma 0.786 0.101
## far_sur_paydas 0.444 0.378
## far_sur_eko_performans 0.139 0.533
## far_sur_calisan_hak 0.715 0.170
## far_sur_tarim 0.660 -0.105
##
## Factor1 Factor2
## SS loadings 3.467 1.779
## Proportion Var 0.385 0.198
## Cumulative Var 0.385 0.583
##
## explained_proportions:
## far_sur_kaynak far_sur_gelecek far_sur_adil_is
## 0.9435916 0.7231282 0.7080690
## far_sur_toplum far_sur_cevre_koruma far_sur_paydas
## 0.6964625 0.7537155 0.6064055
## far_sur_eko_performans far_sur_calisan_hak far_sur_tarim
## 0.4214697 0.7336435 0.3367582
##
## likelihood ratio test | p-value: 0.06571096
##
## factors are sufficient
## ________________ END _____________________
see_cev <- extract_factors(df,"far_yon",2)
## ________________ START --> far_yon _____________________
##
## cronbach_alpa = 0.91
##
## Loadings:
## Factor1 Factor2
## far_yon_belge 0.895 -0.112
## far_yon_kultur 0.538 0.365
## far_yon_mevzuat 0.972
## far_yon_cevre_politika 0.885
## far_yon_sur_hedef 0.590 0.358
## far_yon_yesil -0.156 0.982
## far_yon_marka 0.741
##
## Factor1 Factor2
## SS loadings 3.193 1.794
## Proportion Var 0.456 0.256
## Cumulative Var 0.456 0.712
##
## explained_proportions:
## far_yon_belge far_yon_kultur far_yon_mevzuat
## 0.6783997 0.6884389 0.8406211
## far_yon_cevre_politika far_yon_sur_hedef far_yon_yesil
## 0.7693462 0.7621866 0.7807642
## far_yon_marka
## 0.5910206
##
## likelihood ratio test | p-value: 0.0003119813
## [1] "factors are not sufficient"
##
## ________________ END _____________________
see_eko <- extract_factors(df,"far_eko",2)
## ________________ START --> far_eko _____________________
##
## cronbach_alpa = 0.82
##
## Loadings:
## Factor1 Factor2
## far_eko_verimlilik 0.848
## far_eko_satin_alma 0.789 0.101
## far_eko_teknoloji 0.859 -0.124
## far_eko_maliyet 1.002
## far_eko_karlilik 0.861
##
## Factor1 Factor2
## SS loadings 2.079 1.772
## Proportion Var 0.416 0.354
## Cumulative Var 0.416 0.770
##
## explained_proportions:
## far_eko_verimlilik far_eko_satin_alma far_eko_teknoloji far_eko_maliyet
## 0.7418780 0.6954261 0.6686745 0.9950000
## far_eko_karlilik
## 0.7549499
##
## likelihood ratio test | p-value: 0.5763713
##
## factors are sufficient
## ________________ END _____________________
#{r} see_cev <- extract_factors(df,"far_cev",5) see_sos <- extract_factors(df,"far_sos",5) see_pay <- extract_factors(df,"far_pay",4) see_yon <- extract_factors(df,"far_yon",3) see_eko <- extract_factors(df,"far_eko",2) see_birim <- extract_factors(df,"far_birim",4) see_itici <- extract_factors(df,"far_itici",4) see_engel <- extract_factors(df,"far_engel",2) see_arac <- extract_factors(df,"far_arac",4, reduce=10)