<jupyter_start><jupyter_text>Title<jupyter_code>require("igraph")
require(stats4)
nodeList <- read.table("D:\\2018 CorpNet\\Estimating-Network-Of-Directors\\Data\\nodelist.tsv")
#nodeList <- data.frame(t(matrix(c(1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 1, 7, 1, 8, 1, 9, 1, 10, 1), nrow=2, ncol=10)))
nodeList
femaleIDs <- nodeList[1][nodeList[2]==0]
maleIDs <- nodeList[1][nodeList[2]==1]
femaleIDs
maleIDs
nTotal <- nrow(nodeList[2])
nFemales <- length(femaleIDs)
nMales <- length(maleIDs)
nTotal
nFemales
nMales
edgeList <- read.table("D:\\2018 CorpNet\\Estimating-Network-Of-Directors\\Data\\full_graph.tsv")
colnames(edgeList) <- c("X1", "X2")
#edgeList <- data.frame(t(matrix(c(2,3,2,4,3,4,3,7,4,7,5,7,5,8,5,9,8,9), nrow=2, ncol=9)))
edgeList <- unique(rbind(edgeList, data.frame(cbind(edgeList[,2], edgeList[,1]))))
edgeList
edgeListFemaleToFemale <- edgeList[edgeList[,1] %in% femaleIDs & edgeList[,2] %in% femaleIDs,]
edgeListFemaleToFemale
edgeListFemaleToMale <- edgeList[edgeList[,1] %in% femaleIDs & edgeList[,2] %in% maleIDs,]
edgeListFemaleToMale
edgeListMaleToMale <- edgeList[edgeList[,1] %in% maleIDs & edgeList[,2] %in% maleIDs,]
edgeListMaleToMale
edgeListFemaleToBoth <- edgeList[edgeList[,1] %in% femaleIDs,]
edgeListFemaleToBoth
edgeListBothToBoth <- edgeList[(edgeList[,1] %in% femaleIDs & edgeList[,2] %in% femaleIDs) | (edgeList[,1] %in% maleIDs & edgeList[,2] %in% maleIDs),]
edgeListBothToBoth
edgeListMaleToBoth <- edgeList[edgeList[,2] %in% maleIDs,]
edgeListMaleToBoth
edgeListAll <- edgeList[edgeList[,1] %in% femaleIDs | (edgeList[,1] %in% maleIDs & edgeList[,2] %in% maleIDs),]
edgeListAll
edgeCount <- nrow(edgeList)/2
edgeCountFemaleToFemale <- nrow(edgeListFemaleToFemale)/2
edgeCountFemaleToMale <- nrow(edgeListFemaleToMale)
edgeCountMaleToMale <- nrow(edgeListMaleToMale)/2
edgeCount
edgeCountFemaleToFemale
edgeCountFemaleToMale
edgeCountMaleToMale
graphFemaleToFemale <- graph_from_data_frame(edgeListFemaleToFemale, directed=TRUE, vertices=nodeList)
graphFemaleToFemale
graphFemaleToMale <- graph_from_data_frame(edgeListFemaleToMale, directed=TRUE, vertices=nodeList)
graphFemaleToMale
graphMaleToMale <- graph_from_data_frame(edgeListMaleToMale, directed=TRUE, vertices=nodeList)
graphMaleToMale
graphFemaleToBoth <- graph_from_data_frame(edgeListFemaleToBoth, directed=TRUE, vertices=nodeList)
graphFemaleToBoth
graphBothToBoth <- graph_from_data_frame(edgeListBothToBoth, directed=TRUE, vertices=nodeList)
graphBothToBoth
graphMaleToBoth <- graph_from_data_frame(edgeListMaleToBoth, directed=TRUE, vertices=nodeList)
graphMaleToBoth
graphAll <- graph_from_data_frame(edgeListAll, directed=TRUE, vertices=nodeList)
graphAll
countsFemaleToFemale <- triad_census(graphFemaleToFemale)
countsFemaleToFemale
countsFemaleToMale <- triad_census(graphFemaleToMale)
countsFemaleToMale
countsMaleToMale <- triad_census(graphMaleToMale)
countsMaleToMale
countsFemaleToBoth <- triad_census(graphFemaleToBoth)
countsFemaleToBoth
countsBothToBoth <- triad_census(graphBothToBoth)
countsBothToBoth
graphMaleToBoth
countsMaleToBoth <- triad_census(graphMaleToBoth)
countsMaleToBoth
countsAll <- triad_census(graphAll)
countsAll
combinedCounts3 <- unname(t(data.frame(countsFemaleToFemale, countsFemaleToMale, countsMaleToMale, countsFemaleToBoth, countsBothToBoth, countsMaleToBoth, countsAll)))
combinedCounts3
nTotal == nFemales + nMales
sum(countsFemaleToFemale) == choose(nTotal, 3)
sum(countsFemaleToMale) == choose(nTotal, 3)
sum(countsMaleToMale) == choose(nTotal, 3)
sum(countsFemaleToBoth) == choose(nTotal, 3)
sum(countsBothToBoth) == choose(nTotal, 3)
sum(countsMaleToBoth) == choose(nTotal, 3)
sum(countsAll) == choose(nTotal, 3)
countTotalEquations <- matrix(c(1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1), nrow=4, ncol=20)
print(countTotalEquations)
edgeCountEquations <- matrix(c(0,0,0,0,0,0,1,0,0,0,0,0,2,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,0,0,2,0,0,0,1,0,2,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,2,0,0,0,1,0,1,0,0,0,1,0,2,0,0,0,0,0,0,0,1,0,0,0,0,0,2,0,0,0,0,0,3,0,0,0,0), nrow=6, ncol=20)
print(edgeCountEquations)
bicouloredFilteredEquations <- matrix(c(1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,1,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1), nrow=45, ncol=20)
print(bicouloredFilteredEquations)
answerTotalEquations <- function(na, nb){
    c((na)*(na-1)*(na-2)/6, (na)*(na-1)*(nb)/2, (na)*(nb)*(nb-1)/2, (nb)*(nb-1)*(nb-2)/6)
}
answerEdgeEquations <- function(na, nb, counts21, counts22, counts23){
    c((na-2)*counts21, (nb-2)*counts23, (nb)*counts21, (na)*counts23, (na-1)*counts22, (nb-1)*counts22)
}
filteredCountSelector <- matrix(c(1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1), nrow=7, ncol=16)
print(filteredCountSelector)
countOrderMap <- c(1,2,3,4,6,5,8,7,9,10,11,13,14,12,15,16)
countOrderMap
answerFilteredEquations <- function(filteredCountSelector, countOrderMap, combinedCounts3){
    result <- c()
    for (i in 1:7){
        for (j in 1:16){
            if (filteredCountSelector[i,j]==1){
                element <- countOrderMap[j]
                result <- c(result, combinedCounts3[i,element])
            }
        }
    }
    result
}
answer1 <- answerTotalEquations(nFemales, nMales)
answer1
answer2 <- answerEdgeEquations(nFemales, nMales, edgeCountFemaleToFemale, edgeCountFemaleToMale, edgeCountMaleToMale)
answer2
answer3 <- answerFilteredEquations(filteredCountSelector, countOrderMap, combinedCounts3)
answer3
answers <- c(answer1, answer2, answer3)
answers
allEquations <- rbind(countTotalEquations, edgeCountEquations, bicouloredFilteredEquations)
allEquations
counts3Float <- qr.solve(allEquations, answers)
print(counts3Float)
counts3 <- round(counts3Float)
counts3
all(allEquations %*% counts3 == answers)
degreesOfFreedomCompensator <- function(l, s, n){
    1/choose(l, 2) * 1/s * choose(n, 2)/choose(n, l)
}
degreesOfFreedomCompensatorValue <- degreesOfFreedomCompensator(3,3,nTotal)
degreesOfFreedomCompensatorValue
logLikelihoodFunction <- function(na,nb,counts,d,ps11,ps12,ps13,ps21,ps22,ps23,ps24){
    -(d*counts[1]*log((1-ps11)^3*(1-(3*ps21)/(-2+na+nb))^(-8+3*na)*(1-(3*ps22)/(-2+na+nb))^(3*nb))+d*counts[2]*log(3*(1-ps11)^2*(1-(3*ps21)/(-2+na+nb))^(-5+2*na)*(1-(3*ps22)/(-2+na+nb))^(2*nb)*(1-(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-3+na)*(1-(3*ps22)/(-2+na+nb))^nb))+d*counts[3]*log(3*(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^nb*(1-(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-3+na)*(1-(3*ps22)/(-2+na+nb))^nb)^2)+d*counts[4]*log((3*ps21)/(-2+na+nb)+(1-(3*ps21)/(-2+na+nb))*(1-(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-3+na)*(1-(3*ps22)/(-2+na+nb))^nb)^3)+d*counts[5]*log((1-ps11)*(1-ps12)^2*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^(-4+2*na+nb)*(1-(3*ps23)/(-2+na+nb))^(-2+2*nb))+d*counts[6]*log((1-ps12)^2*(1-(3*ps22)/(-2+na+nb))^(-3+2*na)*(1-(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^(-1+nb))*(1-(3*ps23)/(-2+na+nb))^(-2+2*nb))+d*counts[7]*log(2*(1-ps11)*(1-ps12)*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^(-2+na+nb)*(1-(3*ps23)/(-2+na+nb))^(-1+nb)*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-2+na)*(1-(3*ps23)/(-2+na+nb))^(-1+nb)))+d*counts[8]*log(2*(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^(-1+nb))*(1-(3*ps23)/(-2+na+nb))^(-1+nb)*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-2+na)*(1-(3*ps23)/(-2+na+nb))^(-1+nb)))+d*counts[9]*log((1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^nb*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-2+na)*(1-(3*ps23)/(-2+na+nb))^(-1+nb))^2)+d*counts[10]*log((3*ps22)/(-2+na+nb)+(1-(3*ps22)/(-2+na+nb))*(1-(1-ps11)*(1-(3*ps21)/(-2+na+nb))^(-2+na)*(1-(3*ps22)/(-2+na+nb))^(-1+nb))*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-2+na)*(1-(3*ps23)/(-2+na+nb))^(-1+nb))^2)+d*counts[11]*log((1-ps12)^2*(1-ps13)*(1-(3*ps22)/(-2+na+nb))^(-2+2*na)*(1-(3*ps23)/(-2+na+nb))^(-4+na+2*nb)*(1-(3*ps24)/(-2+na+nb))^(-2+nb))+d*counts[12]*log(2*(1-ps12)*(1-ps13)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(3*ps23)/(-2+na+nb))^(-2+na+nb)*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(3*ps23)/(-2+na+nb))^(-2+nb))*(1-(3*ps24)/(-2+na+nb))^(-2+nb))+d*counts[14]*log((1-ps13)*(1-(3*ps23)/(-2+na+nb))^na*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(3*ps23)/(-2+na+nb))^(-2+nb))^2*(1-(3*ps24)/(-2+na+nb))^(-2+nb))+d*counts[17]*log((1-ps13)^3*(1-(3*ps23)/(-2+na+nb))^(3*na)*(1-(3*ps24)/(-2+na+nb))^(-8+3*nb))+d*counts[18]*log(3*(1-ps13)^2*(1-(3*ps23)/(-2+na+nb))^(2*na)*(1-(3*ps24)/(-2+na+nb))^(-5+2*nb)*(1-(1-ps13)*(1-(3*ps23)/(-2+na+nb))^na*(1-(3*ps24)/(-2+na+nb))^(-3+nb)))+d*counts[19]*log(3*(1-ps13)*(1-(3*ps23)/(-2+na+nb))^na*(1-(3*ps24)/(-2+na+nb))^(-2+nb)*(1-(1-ps13)*(1-(3*ps23)/(-2+na+nb))^na*(1-(3*ps24)/(-2+na+nb))^(-3+nb))^2)+d*counts[13]*log((1-ps12)^2*(1-(3*ps22)/(-2+na+nb))^(-2+2*na)*(1-(3*ps23)/(-2+na+nb))^(-3+2*nb)*(1-(1-ps13)*(1-(3*ps23)/(-2+na+nb))^(-1+na)*(1-(3*ps24)/(-2+na+nb))^(-2+nb)))+d*counts[15]*log(2*(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(3*ps23)/(-2+na+nb))^(-1+nb)*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(3*ps23)/(-2+na+nb))^(-2+nb))*(1-(1-ps13)*(1-(3*ps23)/(-2+na+nb))^(-1+na)*(1-(3*ps24)/(-2+na+nb))^(-2+nb)))+d*counts[20]*log((3*ps24)/(-2+na+nb)+(1-(3*ps24)/(-2+na+nb))*(1-(1-ps13)*(1-(3*ps23)/(-2+na+nb))^na*(1-(3*ps24)/(-2+na+nb))^(-3+nb))^3)+d*counts[16]*log((3*ps23)/(-2+na+nb)+(1-(3*ps23)/(-2+na+nb))*(1-(1-ps12)*(1-(3*ps22)/(-2+na+nb))^(-1+na)*(1-(3*ps23)/(-2+na+nb))^(-2+nb))^2*(1-(1-ps13)*(1-(3*ps23)/(-2+na+nb))^(-1+na)*(1-(3*ps24)/(-2+na+nb))^(-2+nb))))
}
fit <- mle(logLikelihoodFunction, fixed=list(na=nFemales,nb=nMales,counts=counts3,d=degreesOfFreedomCompensatorValue), start=list(ps11=0.001,ps12=0.001,ps13=0.001,ps21=0.0001,ps22=0.0001,ps23=0.0001,ps24=0.0001), method="L-BFGS-B", lower=rep(1e-10,7), upper=rep(0.2,7))
fit
summary(fit)<jupyter_output><empty_output>
{'fraction_non_alphanumeric': 0.32286242230807993, 'fraction_numerical': 0.18125314967243406, 'mean_word_length': 9.444736842105263, 'pattern_counts': {'":': 0, '<': 64, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'chain_length': '1', 'dir': 'jupyter-structured-clean-dedup', 'id': '98383', 'license': 'Apache-2.0', 'n_tokens_mistral': 7461, 'n_tokens_neox': 6560, 'n_words': 456, 'path': 'Estimating Network Of Directors.ipynb', 'repo_name': 'Subgraph-Generation-Models/Estimating-Network-Of-Directors', 'size': '11906'}