.Rhistory

library(igraph)
###
# 2. LOAD DATA
###
# This lab uses SSL.dat (social interaction) and TSL.dat (task
# interaction) from the S641 Semester 1 class in student_nets.
# The class is a biology 2 class at a public high school.
# load data:
data(studentnets.S641, package = "NetData")
# Reduce to non-zero edges and build a graph object
s641_full_nonzero_edges <- subset(s641_full_data_frame, (social_tie > 0 | task_tie > 0))
head(s641_full_nonzero_edges)
s641_full <- graph.data.frame(s641_full_nonzero_edges)
summary(s641_full)
# Create sub-graphs based on edge attributes and remove isolates
s641_social <- delete.edges(s641_full, E(s641_full)[get.edge.attribute(s641_full,name = "social_tie")==0])
s641_social <- delete.vertices(s641_social, V(s641_social)[degree(s641_social)==0])
summary(s641_social)
s641_task <- delete.edges(s641_full, E(s641_full)[get.edge.attribute(s641_full,name = "task_tie")==0])
s641_task <- delete.vertices(s641_task, V(s641_task)[degree(s641_task)==0])
summary(s641_task)
# Look at the plots for each sub-graph
social_layout <- layout.fruchterman.reingold(s641_social)
plot(s641_social, layout=social_layout, edge.arrow.size=.2)
# Note: click on the graph and then use the drop down menu to
# save any plot you like -- it will save as a pdf.
task_layout <- layout.fruchterman.reingold(s641_task)
plot(s641_task, layout=task_layout, edge.arrow.size=.2)
# Question #1 - what can you say about network centralization from these graphs?
### Task-layout graph is much more centralized than social_layout graph.
### 22 is the task center
### 22, 19, 21, 18, and 16 are the social centers
###
# 3. CALCULATE CENTRALITY MEASURES FOR SOCIAL
###
indegree_social <- degree(s641_social, mode='in')
indegree_social
outdegree_social <- degree(s641_social, mode='out')
outdegree_social
s641_social_undirected <- as.undirected(s641_social, mode='collapse')
ev_obj_social <- evcent(s641_social_undirected)
eigen_social <- ev_obj_social$vector
eigen_social
s641_social
?evcent
ev_obj_social <- evcent(s641_social, directed=T)
ev_obj_social
eigen_social_in <- evcent(s641_social, directed=T)$vector
eigen_social_in
?as.undirected
?evcent
str(evcent(s641_social, directed=T))
s641_social
str(evcent(s641_social, directed=T))
central_social <- data.frame(V(s641_social)$name, indegree_social, outdegree_social, incloseness_social, outcloseness_social, betweenness_social, eigen_social)
incloseness_social <- closeness(s641_social, mode='in')
incloseness_social
# Out-closeness
outcloseness_social <- closeness(s641_social, mode='out')
# the edge.betweenness() function.)
betweenness_social <- betweenness(s641_social)
central_social <- data.frame(V(s641_social)$name, indegree_social, outdegree_social, incloseness_social, outcloseness_social, betweenness_social, eigen_social)
central_social
barplot(central_social$indegree_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$outdegree_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$incloseness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$outcloseness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$betweenness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$eigen_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$incloseness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$outcloseness_social, names.arg=central_social$V.s641_social..name)
s641_full_nonzero_edges
plot(s641_social, layout=social_layout, edge.arrow.size=.2)
barplot(central_social$indegree_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$outdegree_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$incloseness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$incloseness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$outcloseness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$betweenness_social, names.arg=central_social$V.s641_social..name)
barplot(central_social$eigen_social, names.arg=central_social$V.s641_social..name)
cor(central_social[,2:7])
# Indegree
# We should have 20 entries, indicating 2 isolates.
indegree_task <- degree(s641_task, mode='in')
indegree_task
# Outdegree
outdegree_task <- degree(s641_task, mode='out')
outdegree_task
# In-closeness
incloseness_task <- closeness(s641_task, mode='in')
incloseness_task
# Out-closeness
outcloseness_task <- closeness(s641_task, mode='out')
outcloseness_task
# Betweenness. Note that the closeness measures arent very high
# for node 22, but the betweenness is off the charts.
betweenness_task <- betweenness(s641_task)
betweenness_task
# Eigenvector
s641_task_undirected <- as.undirected(s641_task, mode='collapse')
ev_obj_task <- evcent(s641_task_undirected)
eigen_task <-ev_obj_task$vector
eigen_task
# Generate a data frame with all centrality values
central_task <- data.frame(V(s641_task)$name, indegree_task, outdegree_task, incloseness_task, outcloseness_task, betweenness_task, eigen_task)
central_task
central_task[order(-central_task$indegree_task),]
# Outdegree: 22, 18 and 17
central_task[order(-central_task$outdegree_task),]
# Incloseness: 22, 18 and 17
central_task[order(-central_task$incloseness_task),]
barplot(central_task$indegree_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$outdegree_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$indegree_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$outdegree_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$incloseness_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$outcloseness_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$betweenness_task, names.arg=central_task$V.s641_task..name)
barplot(central_task$eigen_task, names.arg=central_task$V.s641_task..name)
connectednodes_social = as.numeric(levels(central_social$V.s641_social..name))[central_social$V.s641_social..name]
connectednodes_task = as.numeric(levels(central_task$V.s641_task..name))[central_task$V.s641_task..name]
length(connectednodes_social)
length(connectednodes_task)
?lm
numWeights
numWeights <- function(x) 10*x+x^2*(36/x-1)+x
numWeights
function(1)
numWeights(1)
numWeights(36)
numWeights(18)
plot(1:36, numWeights(1:36))
which.min(numWeights(1:36))
which.max(numWeights(1:36))
numWeights <- function(x) {
if (x <= 16)
10*x+x^2*(36/x-1)+x
else
10*x+x*(36-x)+(36-x)*1
}
plot(1:36, numWeights(1:36))
plot(1:36, unlist(lapply(1:36, numWeights)))
numWeights <- function(x) {
if (x <= 16)
10*x+x^2*(36/x-1)+x
else
10*x+x*(36-x)+(36-x)*1
}
plot(1:36, unlist(lapply(1:36, numWeights)))
which.min(numWeights(1:36)) # min is at 1 node per layer
which.max(numWeights(1:36)) # max is at 23 nodes
unlist(lapply(1:36, numWeights))
numWeights
10*23 + 23*16 + 16*1
which.min(unlist(lapply(1:36, numWeights))) # min is at 1 node per layer
which.max(unlist(lapply(1:36, numWeights))) # max is at 23 nodes
10*23 + 23*16 + 16*1
10*23 + 23*13 + 16*1
10*23 + 23*13 + 13*1
10*23 + 22*14 + 14*1
10*22 + 22*14 + 14*1
x <- 22
10*x+x^2*(36/x-1)+x
10*x+x*(36-x)+(36-x)*1
rm(x)
x
numWeights(7)
numWeights <- function(x) {
if (x <= 16)
10(x-1)+(x-1)^2(36/x-1)+36/x(x-1)+x
else
10(x-1)+(x-1)(36-x-1)+(36-x-1)+36-x
}
unlist(lapply(1:36, numWeights))
numWeights <- function(x) {
if (x <= 16)
10*(x-1)+(x-1)^2*(36/x-1)+36/x*(x-1)+x
else
10*(x-1)+(x-1)*(36-x-1)+(36-x-1)+36-x
}
unlist(lapply(1:36, numWeights))
x <- 2
10*(x-1)+(x-1)^2*(36/x-1)+36/x*(x-1)+x
10*(x-1)
(x-1)^2
(x-1)^2*(36/x-1)
(x-1)^2*(36/x-1)
(x-1)^2*(36/x-1) + 36/x
(x-1)^2*(36/x-1) + 36/x*(x-1)
(x-1)^2*(36/x-1) + 36/x*(x-1)+x
(x-1)^2*(36/x-1) + 36/x*(x-1)+x
(36/x-1) + 36/x*(x-1)+x
(36/x-1) + 36/x+x
(x-1)^2*(36/x-1) + 36/x*(x-1)+x
numWeights <- function(x) {
if (x <= 16)
10*(x-1)+(x-1)^2*(36/x-1)+(36/x-1)*(x-1)+x
else
10*(x-1)+(x-1)*(36-x-1)+(36-x-1)+36-x
}
numWeights(1)
numWeights(2)
unlist(lapply(1:36, numWeights))
which.min(unlist(lapply(1:36, numWeights))) # min is at 1 node per layer
which.max(unlist(lapply(1:36, numWeights))) # max is at 23 nodes
numWeights(220)
numWeights(22)
library(data.table)
dt <- data.table(a=runif(10E7), b=runif(10E7))
dt[,mean(pmin(a, b))]
dt <- data.table(a=runif(10E4), b=runif(10E4))
dt[,mean(pmin(a, b))]
dt[,plot(a)]
dt[,plot(b)]
source('C:/Users/chemishra/Desktop/Intern Work/DoS Chinese Cities/methods.R')
setwd("../Dropbox/College/3_Third Year/Summer Learning/Learning From Data/")
test1 <- read.csv("hw5-6-7Programs/testFile1.csv")
tests <- lapply(1:6, function(i) read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv")))
tests <- lapply(1:5, function(i) read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv")))
tests
tests <- lapply(1:5, function(i) read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), headers=F))
?read.csv
tests <- lapply(1:5, function(i) read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F))
tests
tests <- lapply(1:5, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
library(data.table)
tests <- lapply(1:5, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
tests
lapply(tests, function(dt) dt[,V6:=NULL])
tests <- lapply(tests, function(dt) dt[,V6:=NULL])
tests
lapply(tests, function(dt) dt[,V6:=V3 == V5])
lapply(1:5, function(i) tests[[i]][,"testRunNum":=i])
test <- rbindlist(tests)
test
?facet.grid
?facet
?facet.wrap
library(ggplot2S)
library(ggplot2)
ggplot(test, aes(V1, V2, fill=V6)) +
geom_point() +
facet_wrap(testRunNum)
ggplot(test, aes(V1, V2, fill=V6)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, col=V6)) +
geom_point() +
facet_wrap(~testRunNum)
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
lapply(tests, function(dt) dt[,V6:=V3 == V5])
lapply(1:6, function(i) tests[[i]][,"testRunNum":=i])
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, col=V6)) +
geom_point() +
facet_wrap(~testRunNum)
test
ggplot(test, aes(V1, V2, col=V3, size=V6)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, col=V3, size=-V6)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, col=V3, shape=)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, col=V3, shape=V6)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, col=V3, shape=V6, size=2)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, col=V3, shape=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
tests
lapply(tests, function(dt) dt[,V6:=V3 == V6])
lapply(1:6, function(i) tests[[i]][,"testRunNum":=i])
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, col=V3, shape=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=V3, col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=V3, col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
?aes
ggplot(test, aes(V1, V2, shape=factor(V5), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
lapply(tests, function(dt) dt[,V6:=V3 == V6])
lapply(1:6, function(i) tests[[i]][,"testRunNum":=i])
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, shape=factor(V5), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
invisible(lapply(tests, function(dt) dt[,V6:=V3 == V6]))
invisible(lapply(1:6, function(i) tests[[i]][,"testRunNum":=i]))
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, shape=factor(V5), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V6), col=V4, size=3)) +
facet_wrap(~testRunNum)
geom_point() +
ggplot(test, aes(V1, V2, shape=factor(V6), col=V4, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V6), col=V6, size=3)) +
facet_wrap(~testRunNum)
geom_point() +
ggplot(test, aes(V1, V2, shape=factor(V6), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
test
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
tests
invisible(lapply(tests, function(dt) dt[,V7:=V3 == V6]))
invisible(lapply(1:6, function(i) tests[[i]][,"testRunNum":=i]))
test <- rbindlist(tests)
test
ggplot(test, aes(V1, V2, shape=factor(V7), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V7), col=V6)) +
facet_wrap(~testRunNum)
geom_point() +
ggplot(test, aes(V1, V2, shape=factor(V7), col=V6)) +
geom_point() +
facet_wrap(~testRunNum)
i
i
i
ggplot(test, aes(V1, V2, shape=factor(V7), col=V6, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
test
ggplot(test, aes(V1, V2, shape=factor(V7), col=V4, size=3)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factorV3, col=V4, size=V7)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=V3, col=V4, size=V7)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=V7)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(-V3), col=V4, size=V7)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=-V7)) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(V7))) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(2,3))
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(4,6))
test
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(2,3))
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
invisible(lapply(tests, function(dt) dt[,V7:=V3 == V6]))
invisible(lapply(1:6, function(i) tests[[i]][,"testRunNum":=i]))
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(2,3))
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
invisible(lapply(tests, function(dt) dt[,V7:=V3 == V6]))
invisible(lapply(1:6, function(i) tests[[i]][,"testRunNum":=i]))
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(2,3))
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
invisible(lapply(tests, function(dt) dt[,V7:=V3 == V6]))
invisible(lapply(1:6, function(i) tests[[i]][,"testRunNum":=i]))
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(2,3))
tests <- lapply(1:6, function(i) data.table(read.csv(paste0("hw5-6-7Programs/testFile", i, ".csv"), header=F)))
invisible(lapply(tests, function(dt) dt[,V7:=V3 == V6]))
invisible(lapply(1:6, function(i) tests[[i]][,"testRunNum":=i]))
test <- rbindlist(tests)
ggplot(test, aes(V1, V2, shape=factor(V3), col=V4, size=factor(-1*V7))) +
geom_point() +
facet_wrap(~testRunNum) +
scale_size_discrete(range=c(2,3))