ZedXL/quickbuild.R at master · Hugemiler/ZedXL · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
# quickbuild

  require(ZedXL)
  set.seed(102528)

  modelScores <- compute.model.scores(type = "gscore",
                                      gscoreLogPath,
                                      lovoalignLogPath,
                                      proq3listLocation,
                                      computeproq3)

  optimumXlinkMirttable <- create.xlink.mirttable(
    prepare.topolink.logs(
      read.topolink.output(mode,
                           loglistLocation,
                           topolinkLogsDirectory)
    )
  )

  freqlist <- colnames(optimumXlinkMirttable)[order(-colSums(optimumXlinkMirttable))][1:nconst]

  bestcstcol <- optimumXlinkMirttable[which(modelScores$`TM-Score` == max(modelScores$`TM-Score`)), ]
  bestcstlist <- colnames(bestcstcol)[bestcstcol == 1]

  optimumSimilarityTable <- create.dissimilarity.matrix(mode = "similarity",
                                                        diagonal = 1,
                                                        alignlistPath,
                                                        compactlogPath,
                                                        nmodels = nrow(optimumXlinkMirttable))

  ## Appendind DavisConsensus to modelScores table

  modelScores$davisconsensus <- imperialist.score(mode = 'consensus',
                                                  models = rownames(optimumSimilarityTable),
                                                  similarityTable = optimumSimilarityTable)

  ## Digesting the optimumXlinkMirttable

  optimumXlinkMirttable <- digest.xlink.mirttable(optimumXlinkMirttable)

  ### Classical Analysis

  optimumDescript <- ltm::descript(optimumXlinkMirttable)

  ## Computation of restrictionScores

  globalCronbachAlpha <- optimumDescript$alpha[1]

  ### Creating the RestrictionScores table

  restrictionScores <- data.frame(bis = optimumDescript$bisCorr,
                                  right = optimumDescript$perc[,2],
                                  logit = optimumDescript$perc[,3],
                                  alpha = optimumDescript$alpha[-1],
                                  deltaAlpha = optimumDescript$alpha[2:length(optimumDescript$alpha)] - globalCronbachAlpha)

  restrictionScores$rscore <- restriction.differential.scores(type = "G-Score",
                                                              optimumXlinkMirttable,
                                                              modelScores)$rscore

  restrictionScores$biscore <- -apply(optimumXlinkMirttable, 2, function(x) {
    ltm::biserial.cor(optimumSimilarityTable[which(modelScores$davisconsensus == max(modelScores$davisconsensus)), ], x)})

  restrictionScores$biscore_best <- -apply(optimumXlinkMirttable, 2, function(x) {
    ltm::biserial.cor(optimumSimilarityTable[which(modelScores$`TM-Score` == max(modelScores$`TM-Score`)), ], x)})

  restrictionScores$biscore_native <- -apply(optimumXlinkMirttable, 2, function(x) {
    ltm::biserial.cor(modelScores$`TM-Score`, x)})

  if(computeproq3 == T) {

    restrictionScores$biscore_proq3.TM <- -apply(optimumXlinkMirttable, 2, function(x) {
      ltm::biserial.cor(optimumSimilarityTable[which(modelScores$ProQ3D.TM == max(modelScores$ProQ3D.TM)), ], x)})

  }

  restrictionScores <- attribute.crys.and.opt(restrictionScores, cryslistLocation, cryslistLocation)

  # Correlations and Charts

  ## Index Assignment

  maxIndex <- which(modelScores$`TM-Score` == max(modelScores$`TM-Score`))
  daviesIndex <- which(modelScores$`TM-Score` ==
                         modelScores$`TM-Score`[which(modelScores$davisconsensus == max(modelScores$davisconsensus))])

  if(computeproq3 == T) {
    proq3_TMIndex <- which(modelScores$ProQ3D.TM == max(modelScores$ProQ3D.TM))
  }
  # Protocol Termination

  ## Building the constraint lists

  bislist <- rownames(restrictionScores)[order(-restrictionScores$bis)][1:nconst]
  rscorelist <- rownames(restrictionScores)[order(-restrictionScores$rscore)][1:nconst]
  biscorelist <- rownames(restrictionScores)[order(-restrictionScores$biscore)][1:nconst]
  biscore_nativelist <- rownames(restrictionScores)[order(-restrictionScores$biscore_native)][1:nconst]
  biscore_bestlist <- rownames(restrictionScores)[order(-restrictionScores$biscore_best)][1:nconst]
  if(computeproq3 == T) {
    biscore_proq3_TMlist <- rownames(restrictionScores)[order(-restrictionScores$biscore_proq3.TM)][1:nconst]
  }

  ## Writing the constraint files

    write.table(x = write.rosetta.constraints(freqlist, table.location = distanceTableLocation),
                file = 'xl_freq', quote = FALSE, col.names = FALSE, row.names = FALSE)

    write.table(x = write.rosetta.constraints(bislist, table.location = distanceTableLocation),
                file = 'xl_bis', quote = FALSE, col.names = FALSE, row.names = FALSE)

    write.table(x = write.rosetta.constraints(biscorelist, table.location = distanceTableLocation),
                file = 'xl_biscre_consensus', quote = FALSE, col.names = FALSE, row.names = FALSE)

    write.table(x = write.rosetta.constraints(biscore_nativelist, table.location = distanceTableLocation),
                file = 'xl_biscore_native', quote = FALSE, col.names = FALSE, row.names = FALSE)

    write.table(x = write.rosetta.constraints(biscore_bestlist, table.location = distanceTableLocation),
                file = 'xl_biscore_best', quote = FALSE, col.names = FALSE, row.names = FALSE)

    write.table(x = write.rosetta.constraints(biscore_proq3_TMlist, table.location = distanceTableLocation),
                file = 'xl_biscore_proq3', quote = FALSE, col.names = FALSE, row.names = FALSE)