@@ -8,6 +8,7 @@ score_subnetwork <- function(df_node, df_edge, beta) {
88 )
99}
1010
11+ # ' @noRd
1112score_subnetwork_shuffle <- function (node_prize , edge_cost , beta ) {
1213 c(
1314 mean(node_prize ),
@@ -60,6 +61,16 @@ subsample_network <- function(df_node, df_edge, ct_edge, n_edges) {
6061 )
6162}
6263
64+ # ' @noRd
65+ gamma_score <- function (x , inverse = FALSE ) {
66+ if (inverse ) { x <- (- x ) }
67+ x <- x - min(x )
68+ v <- x [- 1 ]
69+ shape <- mean(v )^ 2 / stats :: var(v )
70+ scale <- stats :: var(v ) / mean(v )
71+ stats :: pgamma(x [1 ], shape , scale = scale , lower.tail = FALSE )
72+ }
73+
6374# ' Analyze Network Pathways
6475# '
6576# ' Starting at each ligand-receptor pair in the final network, analyze small
@@ -97,7 +108,7 @@ analyze_pathways <- function(type_a, type_b, dir_out, depth, ntrial) {
97108 fpath_net <- file.path(dir_out , " IntegratedNetwork.cfg" )
98109 fpath_out <- file.path(dir_out_ana , " PathwayScores.txt" )
99110 fpath_pval <- file.path(dir_out , " PCSF_EdgeTestValues.txt" )
100- fpath_net <- file.path(dir_out , " PCSF_Network.txt" )
111+ # fpath_net <- file.path(dir_out, "PCSF_Network.txt")
101112 fnames_sub <- dir(dir_out_ptw )
102113
103114 # stop if input file doesn't exist,
@@ -118,18 +129,18 @@ analyze_pathways <- function(type_a, type_b, dir_out, depth, ntrial) {
118129 # load in file
119130 df_pval <- suppressMessages(vroom :: vroom(fpath_pval , progress = FALSE ))
120131 beta <- df_pval [order(df_pval $ pval )[1 ], " beta" , drop = TRUE ]
121- df_net <- suppressMessages(vroom :: vroom(
122- fpath_net , progress = FALSE , na = c(" " , " NA" , " -Inf" )
123- ))
132+ # df_net <- suppressMessages(vroom::vroom(
133+ # fpath_net, progress = FALSE, na = c("", "NA", "-Inf")
134+ # ))
124135
125136 # create node table
126- df_net_nodes <- data.frame (rbind(
127- as.matrix(df_net [, c(" node1" , " node1_prize" )]),
128- as.matrix(df_net [, c(" node2" , " node2_prize" )])
129- ))
137+ # df_net_nodes <- data.frame(rbind(
138+ # as.matrix(df_net[, c("node1", "node1_prize")]),
139+ # as.matrix(df_net[, c("node2", "node2_prize")])
140+ # ))
130141
131142 # create edge table
132- df_net_edges <- as.data.frame(df_net [, c(" node1" , " node2" , " cost" )])
143+ # df_net_edges <- as.data.frame(df_net[, c("node1", "node2", "cost")])
133144
134145 # set column names
135146 names(df_net_nodes ) <- c(" node" , " prize" )
@@ -180,16 +191,16 @@ analyze_pathways <- function(type_a, type_b, dir_out, depth, ntrial) {
180191 }
181192
182193 # calculate p-value
183- pscores <- apply(scores , 2 , function (x ) {
184- (match(x [1 ], sort(x )) - 1 ) / (length(x ) - 1 )
185- })
194+ # pscores <- apply(scores, 2, function(x) {
195+ # (match(x[1], sort(x)) - 1) / (length(x) - 1)
196+ # })
186197
187198 # extract node score
188- pprize <- 1 - pscores [1 ]
199+ # pprize <- 1 - pscores[1]
189200 # extract edge score
190- pcost <- pscores [2 ]
201+ # pcost <- pscores[2]
191202 # extract potential score
192- ppot <- 1 - pscores [3 ]
203+ # ppot <- 1 - pscores[3]
193204
194205 # new row of data
195206 row <- data.frame (
@@ -202,9 +213,9 @@ analyze_pathways <- function(type_a, type_b, dir_out, depth, ntrial) {
202213 mean_prize = scores [1 , 1 ],
203214 mean_cost = scores [1 , 2 ],
204215 potential = scores [1 , 3 ],
205- pval_prize = pprize ,
206- pval_cost = pcost ,
207- pval_potential = ppot
216+ pval_prize = gamma_score( scores [, 1 ]) ,
217+ pval_cost = gamma_score( - scores [, 2 ]) ,
218+ pval_potential = gamma_score( scores [, 3 ])
208219 )
209220
210221 # start or continue dataframe
0 commit comments