SEM in R

library(psych)

all=read.csv(choose.files())

#Calculating_Cronbach's Alpha

covid_concern<- alpha(data.frame(all[c("CO2", "CO3", "CO5", "CO7")]))

attitude<- alpha(data.frame(all[c("SN3", "PBC1", "PBC2")]))

social_norm<- alpha(data.frame(all[c("CO4", "AT7", "SN1", "SN2", "PMO1")]))

perc_beh_control<- alpha(data.frame(all[c("AT2", "AT4", "AT5", "AT6")]))

perc_mor_obligation<-alpha(data.frame(all[c("CO8", "AT1")]))

####sem

library(lavaan)

library(semPlot)

#all=read.csv(choose.files())

model1<- '

# Structural model

CO=~CO2+ CO3 +CO5 +CO7

AT=~SN3+ PBC1+ PBC2

SN=~CO4+ AT7+ SN1+ SN2+ PMO1

PBC=~AT2+AT4+AT5+AT6

PMO=~CO8+AT1

# Covariance structure of exogenous variables

# New parameters (indirect effect)

#Regression

AT~CO

SN~CO

PBC~CO

PMO~AT

PMO~SN

PMO~PBC

                  '

fit1<- sem(model1, data=all)

fit1

summary(fit1, rsquare = TRUE,

        fit.measures = TRUE,

        standardized = TRUE)

fitMeasures(fit1)

semPaths(fit1, what="paths", whatLabels = "stand",

         rotation = 2,

         layout = "spring",

         posCol = "black",

         edge.width = 0.5, 

         style = "Lisrel",

         fade = T,

         edge.label.position = 0.55)

###############

# Extract the correlation matrix

all.cor <- cor(all[], method = "pearson", use = "pairwise.complete.obs")

all.cor

# Correlogram

corrplot(all.cor, order = "hclust",

         tl.col = "black", tl.srt = 80,

         addCoef.col = "black",

         number.cex = 0.8,

         cl.cex = 1,

         tl.cex = 0.8)

library(corrplot)

library(RColorBrewer)

#library(psych)

#corPlot(data, cex =1.2, main="", 

#       cex.lab = 1.2,

#        cex.axis =1.2,

#       cex.main = 1.2,

#      cex.sub = 1.2)

library(psych)

cor.plot(all.cor,numbers=TRUE,colors=TRUE,

         n=51,main=NULL,labels=NULL,

         cex =1,

         cex.lab = 1,

         cex.axis =1, #right side level

         cex.main = 1,

         cex.sub = 1)

Confusion Matrix for Any Model in R

 #Confusion matrix

# training

p<- predict(model, rail)

tab<- table(p, rail$OPS)

tab

1-sum(diag(tab))/sum(tab)

#testing

p1<- predict(model, test)

tab1<- table(p1, test$OPS)

tab1

1-sum(diag(tab1))/sum(tab1)

#end

library(e1071)

#data

confusionMatrix(rail$OPS, sample(rail$OPS))

newPrior <- c(.05, .8, .15, 0.5, 0.9)

names(newPrior) <- levels(rail$OPS)

cm <-confusionMatrix(rail$OPS, sample(rail$OPS))

#2

# extract the confusion matrix values as data.frame

cm_d <- as.data.frame(cm$table)

# confusion matrix statistics as data.frame

cm_st <-data.frame(cm$overall)

# round the values

cm_st$cm.overall <- round(cm_st$cm.overall,2)

# here we also have the rounded percentage values

cm_p <- as.data.frame(prop.table(cm$table))

cm_d$Perc <- round(cm_p$Freq*100,2)

#3

library(ggplot2)     # to plot

library(gridExtra)   # to put more

library(grid)        # plot together

# plotting the matrix

cm_d_p <-  ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+

  geom_tile() +

  geom_text(aes(label = paste("",Freq,",",Perc,"%")), color = 'red', size = 8) +

  theme_light() +

  guides(fill=FALSE) 

# plotting the stats

cm_st_p <-  tableGrob(cm_st)

# all together

grid.arrange(cm_d_p, cm_st_p,nrow = 1, ncol = 2, 

             top=textGrob("Confusion Matrix and Statistics",gp=gpar(fontsize=25,font=1)))

#search confusion matrix plot

###########################################################################

Sankey Plot

#Tawkir_ahmed_code

#Sankey_plot

 

library(networkD3)

## create a dataframe with 10 nodes

nodes = data.frame("name" = c("Node_0", "Node_1", "Node_2", "Node_3", "Node_4", "Node_5",

                              "Node_6", "Node_7", "Node_8", "Node_9"))

## create edges with weights

links = as.data.frame(matrix(c(0, 5, 2, # node 0 -> node 5 with weight 2

                               0, 9, 2, # node 0 -> node 9 with weight 2

                               0, 6, 2, # node 0 -> node 5 with weight 2

                               1, 6, 1, # node 1 -> node 6 with weight 1

                               1, 7, 3, # node 1 -> node 7 with weight 3

                               1, 8, 2, # node 1 -> node 8 with weight 2

                               2, 9, 3, # node 2 -> node 9 with weight 3

                               3, 5, 1, # node 3 -> node 5 with weight 1

                               3, 8, 1, # node 3 -> node 8 with weight 1

                               3, 9, 5, # node 3 -> node 9 with weight 5

                               4, 9, 2,  # node 4 -> node 9 with weight 2

                               4, 6, 2  # node 4 -> node 6 with weight 2

), byrow = TRUE, ncol = 3))

## set column names for links

names(links) = c("source", "target", "value")

## add edge types for coloring purpose

links$group = c("type_0",

                "type_0",

                "type_0",

                "type_1",

                "type_1", 

                "type_1",

                "type_2",

                "type_3",

                "type_3",

                "type_3",

                "type_4",

                "type_4")

## Create custom color list using d3 for each node

node_color <- 'd3.scaleOrdinal() .domain(["Node_0", "Node_1", "Node_2", "Node_3", "Node_4", 

"Node_5", "Node_6", "Node_7", "Node_8", "Node_9", "type_0", "type_1", "type_2", 

"type_3", "type_4"]) .range(["#bf5b17", "#beaed4", "#fdc086" , "#386cb0", "#7fc97f", 

"#bf5b17", "#beaed4", "#fdc086" , "#386cb0", "#7fc97f", "#bf5b17", "#beaed4", "#fdc086" , "#386cb0", "#7fc97f"])'

## Draw Sankey Diagram

p = sankeyNetwork(Links = links, Nodes = nodes,

                  Source = "source", Target = "target",

                  Value = "value", NodeID = "name",

                  fontSize = 16, nodeWidth = 40,

                  colourScale = node_color,

                  LinkGroup="group")

p