library(shiny)
library(dplyr)
library(qgraph)
library(IsingFit)
library(IsingSampler)
ui <- fluidPage (
includeScript("../../../Matomo-tquant.js"),
titlePanel("A Network Perspective on TquanT 2019"),
sidebarLayout(
sidebarPanel(
fluidRow(
span("This Shiny App shows the expected network of TquanT,
and the retrieved networks and their centrality.
For the expected network you can choose whether you
would like to display an unregularized network or a
regularized network. For the regularized network you
can set the value for gamma. The reproducible code and
instructions can be found at http://bit.do/tqtising"),
h5(""),
radioButtons("distribution", "Model type:", c("Unregularized" = "Unregularized", "Regularized" = "Regularized"), width = 12),
sliderInput("n", "Gamma", 0, 1, 0.01))),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Expected Network", plotOutput("Expected", width = "600px")),
tabPanel("Real Network", plotOutput("Distribution", width = "600px")),
tabPanel("Centrality Real Network", plotOutput("Centrality", width = "600px")),
img(src = "explanation.jpg", width = "600px")
)
)
))
server <- function(input, output){
# survey <- read.csv("https://gist.githubusercontent.com/psyguy/b974f73516a228eba34e5ed7c3152674/raw/d936632d0fe2bad60fa0c834fa2c54315cf9c030/TquanT-survey.csv", header = TRUE)
survey <- read.csv("TquanT-survey.csv", header = TRUE)
id <- c(1:nrow(survey)) %>% as.data.frame()
colnames(id) <- "id"
dat <- survey %>% dplyr::select(., -1) %>%
lapply(., function(x) ifelse(grepl("Yes", x), 1, -1)) %>%
as.data.frame()
dat <- id %>% cbind(dat)
expected <- matrix(NA, 14, 14)
colnames(expected) <- colnames(survey[,(-1)])
rownames(expected) <- colnames(survey[,(-1)])
expected[,1] <- c(rep(0, 4), 1, rep(0, 9))
expected[,2] <- c(rep(0, 5), 1, 0, 0, 1, rep(0, 5))
expected[,3] <- c(rep(0, 3), 1, rep(0, 2), 1, rep(0, 7))
expected[,4] <- c(rep(0, 2), 1, rep(0, 3), 1, rep(0, 2), 1, rep(0, 4))
expected[,5] <- c(1, rep(0, 7), 1, rep(0, 5))
expected[,6] <- c(0, 1, rep(0, 12))
expected[,7] <- c(0, 0, 1, 1, 0, 0, 0, 0, 0, 1, rep(0, 4))
expected[,8] <- c(rep(0, 8), 1, rep(0, 5))
expected[,9] <- c(0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, -1)
expected[,10] <- c(rep(0, 3), 1, rep(0, 2), 1, rep(0, 7))
expected[,11] <- c(rep(0, 11), 1, 0, 0)
expected[,12] <- c(rep(0, 8), 1, 0, 1, 0, 1, 0)
expected[,13] <- c(rep(0, 11), 1, 0, 0)
expected[,14] <- c(rep(0, 8), -1, rep(0, 5))
Names <- c("Scb", "FdO", "R", "Tpc", "FnF", "FdS", "Mth", "Cmm", "CmA", "TpE",
"Ass", "Rcm", "Slc", "Exp")
Groups <- c("Social", "Food", "Skills", "Organisation",
"Social", "Food", "Skills", "Organisation",
"Evaluation", "Organisation", "Other", "Evaluation",
"Other", "Other")
output$Expected <- renderPlot({
e <- qgraph(expected, labels = Names, layout = "circular",
weighted = TRUE, bidirectional = TRUE, directed = FALSE,
groups = Groups, legend = FALSE)
plot(e)
})
output$Distribution <- renderPlot({
if (input$distribution == "Unregularized") {unregnetwork <- EstimateIsing(data = as.matrix(dat[,(-1)]))
x <- qgraph(unregnetwork$graph, labels = Names, layout = "circular", tuning = 0.25, sampleSize = nrow(dat), groups = Groups, legend = FALSE, names = Names)}
else if (input$distribution == "Regularized") {Res <- IsingFit(x = as.matrix(dat[,(-1)]), family = "binomial", gamma = input$n, plot=FALSE)
x <- qgraph(Res$weiadj, labels = Names, layout = "circular", tuning = 0.25, sampleSize = nrow(dat), nodeNames = Names, vsize = 6, groups = Groups, legend = FALSE)}
plot(x)
})
output$Centrality <- renderPlot({
if (input$distribution == "Unregularized") {unregnetwork <- EstimateIsing(data = as.matrix(dat[,(-1)]))
x <- qgraph(unregnetwork$graph, labels = Names, layout = "circular", tuning = 0.25,sampleSize = nrow(dat), groups = Groups, nodeNames = Names)}
else if (input$distribution == "Regularized") {Res <- IsingFit(x = as.matrix(dat[,(-1)]), family = "binomial", gamma = input$n, plot=FALSE)
x <- qgraph(Res$weiadj, labels = Names, layout = "circular", tuning = 0.25, sampleSize = nrow(dat), nodeNames = Names, legend = FALSE, vsize = 6, groups = Groups)}
centralityPlot(x)
})
}
shinyApp(ui = ui, server = server)
