Browse code

'update'

claudia.cava authored on 15/04/2019 08:55:17
Showing 56 changed files

... ...
@@ -11,34 +11,64 @@
11 11
 #' @name StarBioTrek
12 12
 NULL
13 13
 
14
-#' Pathway data from KEGG
14
+
15
+#' pathway data list
15 16
 #' @docType data
16 17
 #' @keywords internal
17 18
 #' @name path
18
-#' @format A data frame with rows and  variables
19
+#' @format A list of dataframe
19 20
 NULL
20 21
 
21
-#' network data
22
+#' pathway data list
22 23
 #' @docType data
23 24
 #' @keywords internal
24
-#' @name netw
25
+#' @name Data_CANCER_normUQ_fil
26
+#' @format A dataframe with gene expression profiles
27
+NULL
28
+
29
+
30
+#' pathway data
31
+#' @docType data
32
+#' @keywords internal
33
+#' @name pathway
25 34
 #' @format A data frame with  rows and variables
26 35
 NULL
27 36
 
37
+#' network data for IPPI fucntion
38
+#' @docType data
39
+#' @keywords internal
40
+#' @name netw_IPPI
41
+#' @format A list
42
+NULL
43
+
28 44
 
45
+#' network data
46
+#' @docType data
47
+#' @keywords internal
48
+#' @name pathway_matrix
49
+#' @format A data frame with  rows and variables
50
+NULL
29 51
 
52
+#' network data
53
+#' @docType data
54
+#' @keywords internal
55
+#' @name netw
56
+#' @format A data frame with  rows and variables
57
+NULL
30 58
 
31
-#' TCGA data
59
+#' All pathways data from KEGG
32 60
 #' @docType data
33 61
 #' @keywords internal
34
-#' @name Data_CANCER_normUQ_filt
35
-#' @format A data frame with rows and variables
62
+#' @name path_KEGG
63
+#' @format A list of pathways with the involved genes
36 64
 NULL
37 65
 
66
+
67
+
38 68
 #' Score Matrix of pairwise pathway using euclidean distance
39 69
 #' @docType data
40 70
 #' @keywords internal
41
-#' @name score_euc_dist
71
+#' @name score_euc_dista
42 72
 #' @format A data frame with rows and variables
43 73
 NULL
44 74
 
... ...
@@ -55,10 +85,3 @@ NULL
55 85
 #' @name tumo
56 86
 #' @format A data frame with rows and variables
57 87
 NULL
58
-
59
-#' A matrix of gene expression for pathways given by the user. 
60
-#' @docType data
61
-#' @keywords internal
62
-#' @name list_path_plot
63
-#' @format A data frame with rows and variables
64
-NULL
65 88
\ No newline at end of file
... ...
@@ -1,225 +1,133 @@
1
-#' @title Get human KEGG pathway data.
2
-#' @description getKEGGdata creates a data frame with human KEGG pathway. Columns are the pathways and rows the genes inside those pathway 
3
-#' @param KEGG_path  variable
1
+#' @title Get general information inside pathways.
2
+#' @description GetData creates a list with genes inside the pathways. 
3
+#' @param species  variable. The user can select the species of interest from SELECT_path_species(path_spec) 
4
+#' @param pathwaydb variable. The user can select the pathway database of interest from SELECT_path_graphite(path_spec) 
4 5
 #' @export
5
-#' @importFrom KEGGREST keggList keggGet
6
-#' @importFrom org.Hs.eg.db org.Hs.egSYMBOL2EG
7
-#' @importFrom AnnotationDbi mappedkeys as.list
8
-#' @return dataframe with human pathway data
6
+#' @importFrom graphite pathways pathwayTitle
7
+#' @return a list of pathways
9 8
 #' @examples
10
-#' path<-getKEGGdata(KEGG_path="Transcript")
11
-getKEGGdata<-function(KEGG_path){
12
-if (KEGG_path=="Carb_met") {
13
-  mer<-select_path_carb(Carbohydrate)
14
-  c<-proc_path(mer)
15
-  a<-c[[2]]
9
+#' \dontrun{
10
+#' species="hsapiens"
11
+#' pathwaydb="pharmgkb"
12
+#' path<-GetData(species,pathwaydb)}
13
+GetData<-function(species,pathwaydb){
14
+  humanpath <- pathways(species, pathwaydb)
15
+  humanReactome<-humanpath
16
+  le<-list()
17
+  for (j in  1:length(humanReactome)){
18
+    e<-humanReactome[[j]]
19
+    print(paste0("Querying.............  ",pathwayTitle(e),"   ", j, " of ",length(humanReactome)," pathways"))
20
+    le[[j]]<-e
21
+  }
22
+  names(le)<- names(humanReactome)
23
+  return(le)
16 24
 }
17
-  if (KEGG_path=="Ener_met") {
18
-    mer<-select_path_en(Energy)
19
-    c<-proc_path(mer)
20
-    a<-c[[2]]
21
-  }
22
-  if (KEGG_path=="Lip_met") {
23
-    mer<-select_path_lip(Lipid)
24
-    c<-proc_path(mer)
25
-    a<-c[[2]]
26
-  }
27
-  if (KEGG_path=="Amn_met") {
28
-    mer<-select_path_amn(Aminoacid)
29
-    c<-proc_path(mer)
30
-    a<-c[[2]]
31
-  }
32
-  if (KEGG_path=="Gly_bio_met") {
33
-    mer<-select_path_gly(Glybio_met) 
34
-    c<-proc_path(mer)
35
-    a<-c[[2]]
36
-  }
37
-  if (KEGG_path=="Cof_vit_met") {
38
-    mer<-select_path_cofa(Cofa_vita_met)
39
-    c<-proc_path(mer)
40
-    a<-c[[2]]
41
-  }
42
-  if (KEGG_path=="Transcript") {
43
-    mer<-select_path_transc(Transcription)
44
-    c<-proc_path(mer)
45
-    a<-c[[2]]
46
-  }
47
-  if (KEGG_path=="Transl") {
48
-    mer<-select_path_transl(Translation)
49
-    c<-proc_path(mer)
50
-    a<-c[[2]]
51
-  }
52
-  if (KEGG_path=="Fold_degr") {
53
-    mer<-select_path_fold(Folding_sorting_and_degradation)
54
-    c<-proc_path(mer)
55
-    a<-c[[2]]
56
-  }
57
-  if (KEGG_path=="Repl_repair") {
58
-    mer<-select_path_repl(Replication_and_repair)
59
-    c<-proc_path(mer)
60
-    a<-c[[2]]
61
-  }
62
-  if (KEGG_path=="sign_transd") {
63
-    mer<-select_path_sign(Signal_transduction)
64
-    c<-proc_path(mer)
65
-    a<-c[[2]]
66
-  }
67
-  if (KEGG_path=="sign_mol_int") {
68
-    mer<-select_path_sign_mol(Signaling_molecules_and_interaction)
69
-    c<-proc_path(mer)
70
-    a<-c[[2]]
71
-  }
72
-  if (KEGG_path=="Transp_cat") {
73
-    mer<-select_path_transp_ca(Transport_and_catabolism)
74
-    c<-proc_path(mer)
75
-    a<-c[[2]]
76
-  }
77
-  if (KEGG_path=="cell_grow_d") {
78
-    mer<-select_path_cell_grow(Cell_growth_and_death)
79
-    c<-proc_path(mer)
80
-    a<-c[[2]]
81
-  }
82
-  if (KEGG_path=="cell_comm") {
83
-    mer<-select_path_cell_comm(Cellular_community)
84
-    c<-proc_path(mer)
85
-    a<-c[[2]]
86
-  }
87
-  if (KEGG_path=="imm_syst") {
88
-    mer<-select_path_imm_syst(Immune_system)
89
-    c<-proc_path(mer)
90
-    a<-c[[2]]
91
-  }
92
-  if (KEGG_path=="end_syst") {
93
-    mer<-select_path_end_syst(Endocrine_system)
94
-    c<-proc_path(mer)
95
-    a<-c[[2]]
96
-  }
97
-  if (KEGG_path=="circ_syst") {
98
-    mer<-select_path_circ_syst(Circulatory_system)
99
-    c<-proc_path(mer)
100
-    a<-c[[2]]
101
-  } 
102
-  if (KEGG_path=="dig_syst") {
103
-    mer<-select_path_dig_syst(Digestive_system)
104
-    c<-proc_path(mer)
105
-    a<-c[[2]]
106
-  } 
107
-  if (KEGG_path=="exc_syst") {
108
-    mer<-select_path_exc_syst(Excretory_system)
109
-    c<-proc_path(mer)
110
-    a<-c[[2]]
111
-  }  
112
-  if (KEGG_path=="nerv_syst") {
113
-    mer<-select_path_ner_syst(Nervous_system)
114
-    c<-proc_path(mer)
115
-    a<-c[[2]]
116
-  } 
117
-  if (KEGG_path=="sens_syst") {
118
-    mer<-select_path_sens_syst(Sensory_system)
119
-    c<-proc_path(mer)
120
-    a<-c[[2]]
121
-  } 
122
-if (KEGG_path=="KEGG_path") {
123
-  pathways.list <- keggList("pathway", "hsa")## returns the list of human pathways
124
-pathway.codes <- sub("path:", "", names(pathways.list))
125
-pathways.list<-list(pathways.list)
126
-pathways.list<-pathways.list[lapply(pathways.list,length)!=0] 
127
-list_pathkeg<-do.call("cbind", pathways.list)
128
-c<-list(pathway.codes,list_pathkeg)
129
-a<-c[[2]]
130 25
 
131
-}
132
-pathway.codes<-c[[1]]
133
-genes.by.pathway <- sapply(pathway.codes,
134
-                           function(pwid){
135
-                             pw <- keggGet(pwid)
136
-                             pw[[1]]$GENE[c(TRUE, FALSE)]
137
-                           })
138
-x <- org.Hs.egSYMBOL2EG
139
-mapped_genes <- mappedkeys(x)
140
-xx <- as.list(x[mapped_genes])
141
-top3 <- matrix(0, length(xx), length(genes.by.pathway))
142
-rownames(top3) <- names(xx)
143
-colnames(top3)<- names(genes.by.pathway)
144
-
145
-
146
-
147
-for (j in  1:length(xx)){
148
-  for (k in  1:length(genes.by.pathway)){
149
-    if (length(intersect(xx[[j]],genes.by.pathway[[k]])!=0)){
150
-      
151
-     
152
-      
153
-       top3[j,k]<-names(xx[j]) 
154
-    }
155
-  }
156
-}
157 26
 
27
+#' @title Get  genes inside pathways.
28
+#' @description GetPathData creates a list of genes inside the pathways. 
29
+#' @param path_ALL  variable. The user can select the variable as obtained by  GetData function
30
+#' @export
31
+#' @importFrom graphite nodes pathwayTitle
32
+#' @return a list of pathways
33
+#' @examples
34
+#' pathway_ALL_GENE<-GetPathData(path_ALL=path[1:3])
35
+GetPathData<-function(path_ALL){
36
+  le<-list()
37
+  for (j in  1:length(path_ALL)){
38
+    e<-path_ALL[[j]]
39
+    genes<-nodes(e,which = "proteins")
40
+    print(paste0("Downloading.............  ",pathwayTitle(e),"   ", j, " of ",length(path_ALL)," pathways"))
41
+    le[[j]]<-genes
42
+  }
43
+  names(le)<- names(path_ALL)
44
+  return(le)
45
+}
158 46
 
159 47
 
160
-for (j in  1:length(xx)){
161
-  for (k in  1:length(genes.by.pathway)){
162
-    if (length(intersect(xx[[j]],genes.by.pathway[[k]])!=0)){
163
-      
164 48
 
165 49
 
166
-     # top3[j,k]<-names(xx[j]) 
167
-    }
168
-  }
169
-}
170
-top3[top3 == 0] <- " "
171
-#a<-data.frame(pathways.list)
172
-#i <- sapply(a, is.factor)
173
-#a[i] <- lapply(a[i], as.character)
174
-rownames(a)<-sub("path:","",rownames(a))
175
-PROVA<-top3
176
-for( i in 1:ncol(PROVA)) {
177
-  if (colnames(PROVA)[i]==rownames(a)[i]){
178
-    colnames(PROVA)[i]<-a[i]
179
-}
180
-}
181
-return(PROVA)
50
+#' @title Get  interacting genes inside pathways.
51
+#' @description GetPathNet creates a list of genes inside the pathways. 
52
+#' @param path_ALL  variable. The user can select the variable as obtained by  GetData function
53
+#' @export
54
+#' @importFrom graphite edges pathwayTitle
55
+#' @return a list of pathways
56
+#' @examples
57
+#' pathway_net<-GetPathNet(path_ALL=path[1:3])
58
+GetPathNet<-function(path_ALL){
59
+  le<-list()
60
+  for (j in  1:length(path_ALL)){
61
+    e<-path_ALL[[j]]
62
+    genes<-edges(e,which = "proteins")
63
+    print(paste0("Downloading.............  ",pathwayTitle(e),"   ", j, " of ",length(path_ALL)," pathways"))
64
+    le[[j]]<-genes
65
+  }
66
+  names(le)<- names(path_ALL)
67
+  return(le)
182 68
 }
183 69
 
184 70
 
185
-#' @title Get network data.
71
+
72
+#' @title Get  interacting genes inside pathways.
73
+#' @description GetPathNet creates a list of genes inside the pathways. 
74
+#' @param path_ALL  variable. The user can select the variable as obtained by  GetData function
75
+#' @export
76
+#' @importFrom graphite nodes pathwayTitle convertIdentifiers
77
+#' @return a list of pathways
78
+#' @examples
79
+#' pathway<-ConvertedIDgenes(path_ALL=path[1:3])
80
+ConvertedIDgenes<-function(path_ALL){
81
+  le<-list()
82
+  for (j in  1:length(path_ALL)){
83
+    e<-path_ALL[[j]]
84
+    s1<-convertIdentifiers(e, "symbol")
85
+    genes<-nodes(s1,which = "proteins")
86
+    er <- sapply(strsplit(genes, split=':', fixed=TRUE), function(x) (x[2]))
87
+    print(paste0("Mapping Uniprot ID to Gene Symbol, using convertIdentifiers of graphite package..........  ",pathwayTitle(e),"   ", j, " of ",length(path_ALL)," pathways"))
88
+    #attr(mm, "names")<-NULL
89
+    le[[j]]<-er
90
+  }
91
+  names(le)<- names(path_ALL)
92
+  return(le)
93
+}
94
+  
95
+  
96
+ 
97
+
98
+#' @title Get network data from GeneMania.
186 99
 #' @description getNETdata creates a data frame with network data. 
187 100
 #' Network category can be filtered among: physical interactions, co-localization, genetic interactions and shared protein domain.
188 101
 #' @param network  variable. The user can use the following parameters 
189 102
 #' based on the network types to be used. PHint for Physical_interactions,
190 103
 #' COloc for Co-localization, GENint for Genetic_interactions and
191 104
 #' SHpd for Shared_protein_domains
192
-#' @param organism organism==NULL default value is homo sapiens
105
+#' @param organismID organism==NULL default value is homo sapiens.
193 106
 #' @export
194
-#' @importFrom SpidermiR SpidermiRquery_species SpidermiRquery_spec_networks SpidermiRdownload_net SpidermiRprepare_NET
195
-#' @return dataframe with gene-gene (or protein-protein interactions)
107
+#' @importFrom SpidermiR  SpidermiRquery_spec_networks SpidermiRdownload_net SpidermiRprepare_NET
108
+#' @return list with gene-gene (or protein-protein interactions)
196 109
 #' @examples
197
-#' organism="Saccharomyces_cerevisiae"
198
-#' netw<-getNETdata(network="SHpd",organism)
199
-getNETdata<-function(network,organism=NULL){
200
-  org_shar_pro<-SpidermiRquery_species(species)
201
-  if (is.null(organism)) {
202
-  net_shar_prot<-SpidermiRquery_spec_networks(organismID = org_shar_pro[6,],network)
203
-  out_net_shar_pro<-SpidermiRdownload_net(net_shar_prot)
204
-  geneSymb_net_shar_pro<-SpidermiRprepare_NET(organismID = org_shar_pro[6,],data = out_net_shar_pro)
205
-  }
206
-  if( !is.null(organism) ){
207
-    net_shar_prot<-SpidermiRquery_spec_networks(organismID = org_shar_pro[9,],network)
208
-    out_net_shar_pro<-SpidermiRdownload_net(net_shar_prot)
209
-    geneSymb_net_shar_pro<-SpidermiRprepare_NET(organismID = org_shar_pro[9,],data = out_net_shar_pro)
210
-}
211
-  ds_shar_pro<-do.call("rbind", geneSymb_net_shar_pro)
212
-  data_shar_pro<-as.data.frame(ds_shar_pro[!duplicated(ds_shar_pro), ]) 
213
-  sdc_shar_pro<-unlist(data_shar_pro$gene_symbolA,data_shar_pro$gene_symbolB)
214
-  m_shar_pro<-c(data_shar_pro$gene_symbolA)
215
-  m2_shar_pro<-c(data_shar_pro$gene_symbolB)
216
-  ss_shar_pro<-cbind(m_shar_pro,m2_shar_pro)
217
-  data_pr_shar_pro<-as.data.frame(ss_shar_pro[!duplicated(ss_shar_pro), ]) 
218
-  colnames(data_pr_shar_pro) <- c("m_shar_pro", "m2_shar_pro")
219
-return(data_pr_shar_pro)
110
+#' \dontrun{
111
+#' organismID="Saccharomyces_cerevisiae"
112
+#' netw<-getNETdata(network="SHpd",organismID)}
113
+getNETdata<-function(network,organismID=NULL){
114
+  if( is.null(organismID) ){
115
+    prr<-SpidermiRprepare_NET(organismID = 'Homo_sapiens',
116
+                         data = SpidermiRdownload_net(data = SpidermiRquery_spec_networks(organismID = 'Homo_sapiens',network 
117
+                                                                                          )))
118
+  }
119
+  if( !is.null(organismID) ){
120
+    prr<-SpidermiRprepare_NET(organismID,
121
+                              data = SpidermiRdownload_net(data = SpidermiRquery_spec_networks(organismID , 
122
+                                                                                               network)))
123
+  }
124
+  return(prr)
220 125
 }
221 126
 
222 127
 
223 128
 
224 129
 
225 130
 
131
+
132
+
133
+
... ...
@@ -1,405 +1,48 @@
1
-
2
-
3
-
4
-select_path_carb<-function(Carbohydrate){
5
-species<-c("- Homo sapiens (human)")  
6
-a<-paste("Glycolysis / Gluconeogenesis", species)
7
-b<-paste("Citrate cycle (TCA cycle)", species)
8
-c<-paste("Pentose phosphate pathway", species)
9
-d<-paste("Pentose and glucuronate interconversions", species)
10
-e<-paste("Fructose and mannose metabolism", species)
11
-f<-paste("Galactose metabolism", species)
12
-g<-paste("Ascorbate and aldarate metabolism", species)
13
-h<-paste("Starch and sucrose metabolism", species)
14
-i<-paste("Amino sugar and nucleotide sugar metabolism", species)
15
-l<-paste("Pyruvate metabolism", species)
16
-m<-paste("Glyoxylate and dicarboxylate metabolism", species)
17
-n<-paste("Propanoate metabolism", species)
18
-o<-paste("Butanoate metabolism", species)
19
-p<-paste("C5-Branched dibasic acid metabolism", species)
20
-q<-paste("Inositol phosphate metabolism", species)
21
-r<-paste("Enzymes", species)
22
-s<-paste("Compounds with biological roles",species)
23
-mer<-c(a,b,c,d,e,f,g,h,i,l,m,n,o,p,q,r,s)
24
-return(mer)
25
-}
26
-
27
-select_path_en<-function(Energy){
28
-  species<-c("- Homo sapiens (human)")  
29
-  r<-paste("Oxidative phosphorylation", species)
30
-  s<-paste("Photosynthesis", species)
31
-  t<-paste("Photosynthesis - antenna proteins", species)
32
-  v<-paste("Carbon fixation in photosynthetic organisms", species)
33
-  u<-paste("Carbon fixation pathways in prokaryotes", species)
34
-  z<-paste("Methane metabolism", species)
35
-  aa<-paste("Nitrogen metabolism", species)
36
-  ab<-paste("Sulfur metabolism", species)
37
-  mer<-c(r,s,t,v,u,z,aa,ab)
38
-  return(mer)
39
-}  
40
-  
41
-
42
-select_path_lip<-function(Lipid){ 
43
-  species<-c("- Homo sapiens (human)")  
44
-ac<-paste("Fatty acid biosynthesis", species)
45
-ad<-paste("Fatty acid elongation", species)
46
-ae<-paste("Fatty acid degradation", species)
47
-af<-paste("Synthesis and degradation of ketone bodies", species)
48
-ag<-paste("Cutin, suberine and wax biosynthesis", species)
49
-ah<-paste("Steroid biosynthesis", species)
50
-ai<-paste("Primary bile acid biosynthesis", species)
51
-al<-paste("Secondary bile acid biosynthesis", species)
52
-am<-paste("Steroid hormone biosynthesis", species)
53
-an<-paste("Glycerolipid metabolism", species)
54
-ao<-paste("Glycerophospholipid metabolism", species)
55
-ap<-paste("Ether lipid metabolism", species)
56
-aq<-paste("Sphingolipid metabolism", species)
57
-ar<-paste("Arachidonic acid metabolism", species)
58
-as<-paste("Linoleic acid metabolism", species)
59
-at<-paste("alpha-Linolenic acid metabolism", species)
60
-av<-paste("Biosynthesis of unsaturated fatty acids", species)
61
-
62
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am,an,ao,ap,aq,ar,as,at,av)
63
-return(mer)
64
-}
65
-
66
-
67
-
68
-
69
-select_path_amn<-function(Aminoacid){ 
70
-  species<-c("- Homo sapiens (human)")  
71
-ac<-paste("Alanine, aspartate and glutamate metabolism", species)
72
-ad<-paste("Glycine, serine and threonine metabolism", species)
73
-ae<-paste("Cysteine and methionine metabolism", species)
74
-af<-paste("Valine, leucine and isoleucine degradation", species)
75
-ag<-paste("Valine, leucine and isoleucine biosynthesis", species)
76
-ah<-paste("Lysine biosynthesis", species)
77
-ai<-paste("Lysine degradation", species)
78
-al<-paste("Arginine biosynthesis", species)
79
-am<-paste("Arginine and proline metabolism", species)
80
-an<-paste("Histidine metabolism", species)
81
-ao<-paste("Tyrosine metabolism", species)
82
-ap<-paste("Phenylalanine metabolism", species)
83
-aq<-paste("Tryptophan metabolism", species)
84
-ar<-paste("Phenylalanine, tyrosine and tryptophan biosynthesis", species)
85
-as<-paste("beta-Alanine metabolism", species)
86
-at<-paste("Taurine and hypotaurine metabolism", species)
87
-av<-paste("Phosphonate and phosphinate metabolism", species)
88
-au<-paste("Selenocompound metabolism", species)
89
-az<-paste("Cyanoamino acid metabolism", species)
90
-a<-paste("D-Glutamine and D-glutamate metabolism", species)
91
-b<-paste("D-Arginine and D-ornithine metabolism", species)
92
-c<-paste("D-Alanine metabolism", species)
93
-d<-paste("Glutathione metabolism", species)
94
-
95
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am,an,ao,ap,aq,ar,as,at,av,au,az,a,b,c,d)
96
-return(mer)
97
-}
98
-
99
-select_path_gly<-function(Glybio_met){ 
100
-  species<-c("- Homo sapiens (human)") 
101
-ac<-paste("N-Glycan biosynthesis", species)
102
-ad<-paste("Various types of N-glycan biosynthesis", species)
103
-ae<-paste("Mucin type O-Glycan biosynthesis", species)
104
-af<-paste("Other types of O-glycan biosynthesis", species)
105
-ag<-paste("Glycosaminoglycan biosynthesis - CS/DS", species)
106
-ah<-paste("Glycosaminoglycan biosynthesis - HS/Hep", species)
107
-ai<-paste("Glycosaminoglycan biosynthesis - KS", species)
108
-al<-paste("Glycosaminoglycan degradation", species)
109
-am<-paste("Glycosylphosphatidylinositol(GPI)-anchor biosynthesis", species)
110
-an<-paste("Glycosphingolipid biosynthesis - lacto and neolacto series", species)
111
-ao<-paste("Glycosphingolipid biosynthesis - globo series", species)
112
-ap<-paste("Glycosphingolipid biosynthesis - ganglio series", species)
113
-aq<-paste("Lipopolysaccharide biosynthesis", species)
114
-ar<-paste("Peptidoglycan biosynthesis", species)
115
-as<-paste("Other glycan degradation", species)
116
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am,an,ao,ap,aq,ar,as)
117
-return(mer)
118
-}
119
-
120
-
121
-
122
-select_path_cofa<-function(Cofa_vita_met){ 
123
-  species<-c("- Homo sapiens (human)")  
124
-ac<-paste("Thiamine metabolism", species)
125
-ad<-paste("Riboflavin metabolism", species)
126
-ae<-paste("Vitamin B6 metabolism", species)
127
-af<-paste("Nicotinate and nicotinamide metabolism", species)
128
-ag<-paste("Pantothenate and CoA biosynthesis", species)
129
-ah<-paste("Biotin metabolism", species)
130
-ai<-paste("Lipoic acid metabolism", species)
131
-al<-paste("Folate biosynthesis", species)
132
-am<-paste("One carbon pool by folate", species)
133
-an<-paste("Retinol metabolism", species)
134
-ao<-paste("Porphyrin and chlorophyll metabolism", species)
135
-ap<-paste("Ubiquinone and other terpenoid-quinone biosynthesis", species) 	
136
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am,an,ao,ap)
137
-return(mer)
138
-}
139
-
140
-select_path_transc<-function(Transcription){ 
141
-  species<-c("- Homo sapiens (human)")  
142
-ac<-paste("RNA polymerase", species)
143
-ad<-paste("Basal transcription factors", species)
144
-ae<-paste("Spliceosome", species)
145
-af<-paste("Transcription factors", species)
146
-ag<-paste("Transcription machinery", species)
147
-mer<-c(ac,ad,ae,af,ag)
148
-return(mer)
149
-}
150
-
151
-
152
-
153
-select_path_transl<-function(Translation){ 
154
-  species<-c("- Homo sapiens (human)")  
155
-ac<-paste("Ribosome", species)
156
-ad<-paste("Aminoacyl-tRNA biosynthesis", species)
157
-ae<-paste("RNA transport", species)
158
-af<-paste("mRNA surveillance pathway", species)
159
-ag<-paste("Ribosome biogenesis in eukaryotes", species)
160
-ah<-paste("Ribosomal proteins", species)
161
-ai<-paste("Ribosome biogenesis", species)
162
-al<-paste("Transfer RNA biogenesis", species)
163
-am<-paste("Translation factors", species)
164
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am)
165
-return(mer)
166
-}
167
-
168
-select_path_fold<-function(Folding_sorting_and_degradation){ 
169
-  species<-c("- Homo sapiens (human)")  
170
-ac<-paste("Protein export", species)
171
-ad<-paste("Protein processing in endoplasmic reticulum", species)
172
-ae<-paste("SNARE interactions in vesicular transport", species)
173
-af<-paste("Ubiquitin mediated proteolysis", species)
174
-ag<-paste("Sulfur relay system", species)
175
-ah<-paste("RNA degradation", species)
176
-ai<-paste("Chaperones and folding catalysts", species)
177
-al<-paste("SNAREs", species)
178
-am<-paste("Ubiquitin system", species)
179
-an<-paste("Proteasome", species)
180
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am,an)
181
-return(mer)
182
-}
183
-
184
-
185
-
186
-
187
-select_path_repl<-function(Replication_and_repair){ 
188
-  species<-c("- Homo sapiens (human)")  
189
-ac<-paste("DNA replication", species)
190
-ad<-paste("Base excision repair", species)
191
-ae<-paste("Nucleotide excision repair", species)
192
-af<-paste("Mismatch repair", species)
193
-ag<-paste("Homologous recombination", species)
194
-ah<-paste("Non-homologous end-joining", species)
195
-ai<-paste("Fanconi anemia pathway", species)
196
-al<-paste("DNA replication proteins", species)
197
-am<-paste("Chromosome", species)
198
-an<-paste("DNA repair and recombination", species)
199
-ao<-paste("proteins", species)
200
-mer<-c(ac,ad,ae,af,ag,ah,ai,al,am,an,ao)
201
-return(mer)
202
-}
203
-
204
-
205
-
206
-select_path_sign<-function(Signal_transduction){ 
207
-  species<-c("- Homo sapiens (human)")  
208
-a<-paste("Ras signaling pathway", species)
209
-b<-paste("Rap1 signaling pathway", species)
210
-c<-paste("MAPK signaling pathway", species)
211
-d<-paste("ErbB signaling pathway", species)
212
-e<-paste("Wnt signaling pathway", species)
213
-f<-paste("Notch signaling pathway", species)
214
-g<-paste("Hedgehog signaling pathway", species)
215
-h<-paste("TGF-beta signaling pathway", species)
216
-i<-paste("Hippo signaling pathway", species)
217
-l<-paste("VEGF signaling pathway", species)
218
-m<-paste("Jak-STAT signaling pathway", species)
219
-n<-paste("NF-kappa B signaling pathway", species)
220
-o<-paste("TNF signaling pathway", species)
221
-p<-paste("HIF-1 signaling pathway", species)
222
-q<-paste("FoxO signaling pathway", species)
223
-r<-paste("Calcium signaling pathway", species)
224
-s<-paste("Phosphatidylinositol signaling system", species)
225
-t<-paste("Phospholipase D signaling pathway", species)
226
-v<-paste("Sphingolipid signaling pathway", species)
227
-u<-paste("cAMP signaling pathway", species)
228
-z<-paste("cGMP-PKG signaling pathway", species)
229
-ab<-paste("PI3K-Akt signaling pathway", species)
230
-ac<-paste("AMPK signaling pathway", species)
231
-ad<-paste("mTOR signaling pathway", species)
232
-mer<-c(a,b,c,d,e,f,g,h,i,l,m,n,o,p,q,r,s,t,v,u,z,ab,ac,ad)
233
-return(mer)
234
-}
235
-
236
-
237
-select_path_sign_mol<-function(Signaling_molecules_and_interaction){ 
238
-  species<-c("- Homo sapiens (human)")  
239
-a<-paste("Neuroactive ligand-receptor interaction", species)
240
-b<-paste("Cytokine-cytokine receptor interaction", species)
241
-c<-paste("ECM-receptor interaction", species)
242
-d<-paste("Cell adhesion molecules (CAMs)", species)
243
-mer<-c(a,b,c,d)
244
-return(mer)
245
-}
246
-
247
-
248
-select_path_transp_ca<-function(Transport_and_catabolism){ 
249
-  species<-c("- Homo sapiens (human)")  
250
-a<-paste("Endocytosis", species)
251
-b<-paste("Phagosome", species)
252
-c<-paste("Lysosome", species)
253
-d<-paste("Peroxisome", species)
254
-e<-paste("Regulation of autophagy", species)
255
-mer<-c(a,b,c,d,e)
256
-return(mer)
257
-}
258
-
259
-select_path_cell_grow<-function(Cell_growth_and_death){ 
260
-  species<-c("- Homo sapiens (human)")  
261
-  a<-paste("Cell cycle", species)
262
-b<-paste("Apoptosis", species)
263
-c<-paste("p53 signaling pathway", species)
264
-mer<-c(a,b,c)
265
-return(mer)
266
-}
267
-
268
-
269
-select_path_cell_comm<-function(Cellular_community){ 
270
-  species<-c("- Homo sapiens (human)")  
271
-  a<-paste("Focal adhesion", species)
272
-b<-paste("Adherens junction", species)
273
-c<-paste("Tight junction", species)
274
-d<-paste("Gap junction", species)
275
-e<-paste("Signaling pathways regulating pluripotency of stem cells ", species)
276
-mer<-c(a,b,c,d,e)
277
-return(mer)
278
-}
279
-
280
-
281
-select_path_imm_syst<-function(Immune_system){
282
-  species<-c("- Homo sapiens (human)")  
283
-a<-paste("Hematopoietic cell lineage", species)
284
-b<-paste("Complement and coagulation cascades", species)
285
-c<-paste("Platelet activation", species)
286
-d<-paste("Toll-like receptor signaling pathway", species)
287
-e<-paste("Toll and Imd signaling pathway", species)
288
-f<-paste("NOD-like receptor signaling pathway", species)
289
-g<-paste("RIG-I-like receptor signaling pathway", species)
290
-h<-paste("Cytosolic DNA-sensing pathway", species)
291
-i<-paste("Natural killer cell mediated cytotoxicity", species)
292
-l<-paste("Antigen processing and presentation", species)
293
-m<-paste("T cell receptor signaling pathway", species)
294
-n<-paste("B cell receptor signaling pathway", species)
295
-o<-paste("Fc epsilon RI signaling pathway", species)
296
-p<-paste("Fc gamma R-mediated phagocytosis", species)
297
-q<-paste("Leukocyte transendothelial migration", species)
298
-r<-paste("Intestinal immune network for IgA production", species)
299
-s<-paste("Chemokine signaling pathway", species)
300
-
301
-mer<-c(a,b,c,d,e,f,g,h,i,l,m,n,o,p,q,r,s)
302
-return(mer)
1
+#' @title List of species
2
+#' @description List of species for network
3
+#' @param path_spec variable 
4
+#' @importFrom graphite pathwayDatabases
5
+#' @examples
6
+#' \dontrun{m<-SELECTpathspecies(path_spec)
7
+#' }
8
+SELECTpathspecies<-function(path_spec){
9
+  e<-pathwayDatabases()
10
+  return(e)
303 11
 }
304 12
 
13
+Uniform<-function(pathwayfrom){
14
+  mapped_genes<-pathwayfrom
15
+  xx <- unique(unlist(mapped_genes))
16
+  top3 <- matrix(0, length(xx), length(pathwayfrom))
17
+  rownames(top3) <- xx
18
+  colnames(top3)<- names(pathwayfrom)
19
+  for (j in  1:length(xx)){
20
+    for (k in  1:length(pathwayfrom)){
21
+      if (length(intersect(xx[[j]],pathwayfrom[[k]])!=0)){
22
+        
23
+        top3[j,k]<-xx[j]
24
+      }
25
+    }
26
+  }
27
+  top3[top3 == 0] <- " "
28
+return(top3)
29
+  }
305 30
 
306 31
 
307 32
 
308
-select_path_end_syst<-function(Endocrine_system){ 
309
-  species<-c("- Homo sapiens (human)")  
310
-a<-paste("Insulin secretion", species)
311
-b<-paste("Insulin signaling pathway", species)
312
-c<-paste("Glucagon signaling pathway", species)
313
-d<-paste("Regulation of lipolysis in adipocytes", species)
314
-e<-paste("Adipocytokine signaling pathway", species)
315
-f<-paste("PPAR signaling pathway", species)
316
-g<-paste("GnRH signaling pathway", species)
317
-h<-paste("Ovarian steroidogenesis", species)
318
-i<-paste("Estrogen signaling pathway", species)
319
-l<-paste("Progesterone-mediated oocyte maturation", species)
320
-m<-paste("Prolactin signaling pathway", species)
321
-n<-paste("Oxytocin signaling pathway", species)
322
-o<-paste("Thyroid hormone synthesis", species)
323
-p<-paste("Thyroid hormone signaling pathway", species)
324
-q<-paste("Melanogenesis", species)
325
-r<-paste("Renin secretion", species)
326
-s<-paste("Renin-angiotensin system", species)
327
-t<-paste("Aldosterone synthesis and secretion", species)
328
-
329
-
330
-mer<-c(a,b,c,d,e,f,g,h,i,l,m,n,o,p,q,r,s,t)
331
-return(mer)
332
-}
333 33
 
334 34
 
335
-select_path_circ_syst<-function(Circulatory_system){ 
336
-  species<-c("- Homo sapiens (human)")  
337
-  a<-paste("Cardiac muscle contraction", species)
338
-b<-paste("Adrenergic signaling in cardiomyocytes", species)
339
-c<-paste("Vascular smooth muscle contraction", species)
340
-mer<-c(a,b,c)
341
-return(mer)
342
-}
343 35
 
344 36
 
345
-select_path_dig_syst<-function(Digestive_system){ 
346
-  species<-c("- Homo sapiens (human)")  
347
-  a<-paste("Salivary secretion", species)
348
-b<-paste("Gastric acid secretion", species)
349
-c<-paste("Pancreatic secretion", species)
350
-d<-paste("Bile secretion", species)
351
-e<-paste("Carbohydrate digestion and absorption", species)
352
-f<-paste("Protein digestion and absorption", species)
353
-g<-paste("Fat digestion and absorption", species)
354
-h<-paste("Vitamin digestion and absorption", species)
355
-i<-paste("Mineral absorption", species)
356
-
357
-mer<-c(a,b,c,d,e,f,g,h,i)
358
-return(mer)
359
-}
360 37
 
361 38
 
362 39
 
363
-select_path_exc_syst<-function(Excretory_system){ 
364
-  species<-c("- Homo sapiens (human)")  
365
-  a<-paste("Vasopressin-regulated water reabsorption", species)
366
-b<-paste("Aldosterone-regulated sodium reabsorption", species)
367
-c<-paste("Endocrine and other factor-regulated calcium reabsorption", species)
368
-d<-paste("Proximal tubule bicarbonate reclamation", species)
369
-e<-paste("Collecting duct acid secretion", species)
370 40
 
371 41
 
372
-mer<-c(a,b,c,d,e)
373
-return(mer)
374
-}
375 42
 
376 43
 
377
-select_path_ner_syst<-function(Nervous_system){
378
-  species<-c("- Homo sapiens (human)")  
379
-a<-paste("Glutamatergic synapse", species)
380
-b<-paste("GABAergic synapse", species)
381
-c<-paste("Cholinergic synapse", species)
382
-d<-paste("Dopaminergic synapse", species)
383
-e<-paste("Serotonergic synapse", species)
384
-f<-paste("Long-term potentiation", species)
385
-g<-paste("Long-term depression", species)
386
-h<-paste("Retrograde endocannabinoid signaling", species)
387
-i<-paste("Synaptic vesicle cycle", species)
388
-l<-paste("Neurotrophin signaling pathway", species)
389
-
390
-mer<-c(a,b,c,d,e,f,g,h,i,l)
391
-return(mer)
392
-}
393
-
394
-
395
-select_path_sens_syst<-function(Sensory_system){ 
396
-  species<-c("- Homo sapiens (human)")  
397
-  a<-paste("Phototransduction", species)
398
-b<-paste("Olfactory transduction", species)
399
-c<-paste("Taste transduction", species)
400
-d<-paste("Inflammatory mediator regulation of TRP channels", species)
401
-mer<-c(a,b,c,d)
402
-return(mer)
44
+delete.NULLs  <-  function(xlist){   # delele null/empty entries in a list
45
+  xlist[unlist(lapply(xlist, nrow) != 0)]
403 46
 }
404 47
 
405 48
 
... ...
@@ -411,9 +54,9 @@ return(mer)
411 54
 #' @export
412 55
 #' @return a gene expression matrix of the samples with specified label
413 56
 #' @examples
414
-#' tumo<-SelectedSample(Dataset=Data_CANCER_normUQ_filt,typesample="tumor")[,2]
57
+#' tumo<-SelectedSample(Dataset=Data_CANCER_normUQ_fil,typesample="tumour")[,2]
415 58
 SelectedSample <- function(Dataset,typesample){
416
-  if( typesample =="tumor"){
59
+  if( typesample =="tumour"){
417 60
     Dataset <- Dataset[,which( as.numeric(substr(colnames(Dataset), 14, 15)) == 01) ]
418 61
   }
419 62
   
... ...
@@ -427,115 +70,284 @@ SelectedSample <- function(Dataset,typesample){
427 70
 
428 71
 
429 72
 #' @title Select the class of TCGA data
430
-#' @description select two labels from ID barcode
73
+#' @description select best performance
74
+#' @param performance_matrix  list of AUC value
431 75
 #' @param cutoff cut-off for AUC value
432
-#' @param auc.df list of AUC value
433 76
 #' @return a gene expression matrix with only pairwise pathway with a particular cut-off
434
-select_class<-function(auc.df,cutoff){
435
-ds<-do.call("rbind", auc.df)
436
-tmp_ordered <- as.data.frame(ds[order(ds,decreasing=TRUE),])
437
-colnames(tmp_ordered)<-'pathway'
438
-er<-as.data.frame(tmp_ordered$pathway>cutoff)
439
-ase<-tmp_ordered[tmp_ordered$pathway>cutoff,]
440
-rownames(er)<-rownames(tmp_ordered)
441
-er[,2]<-tmp_ordered$pathway
442
-lipid_metabolism<-er[1:length(ase),]
443
-return(lipid_metabolism)
77
+select_class<-function(performance_matrix,cutoff){
78
+  tmp_ordered <- as.data.frame(performance_matrix[order(performance_matrix[,1],decreasing=TRUE),])
79
+
80
+  er<-tmp_ordered[tmp_ordered[,1]>cutoff,]
81
+  #ase<-tmp_ordered[tmp_ordered$pathway>cutoff,]
82
+  #rownames(er)<-rownames(tmp_ordered)
83
+  #er[,2]<-tmp_ordered$pathway
84
+  #lipid_metabolism<-er[1:length(ase),]
85
+  return(er)
444 86
 }
445 87
 
446 88
 
447 89
 
448 90
 
449
-#' @title Process matrix TCGA data after the selection of pairwise pathway
450
-#' @description processing gene expression matrix
451
-#' @param measure matrix with measure of cross-talk among pathways
452
-#' @param list_perf output of the function select_class 
453
-#' @return a gene expression matrix for case study 1
454
-process_matrix<-function(measure,list_perf){
455
-scoreMatrix <- as.data.frame(measure[,3:ncol(measure)])
456
-for( i in 1: ncol(scoreMatrix)){
457
-  scoreMatrix[,i] <- as.numeric(as.character(scoreMatrix[,i]))
458
-}
459
-measure[,1] <- gsub(" ", "_", measure[,1])
460
-d<-sub('_-_Homo_sapiens_*', '', measure[,1])
461
-d_pr<- gsub("(human)", "", d, fixed="TRUE")
462
-d_pr <- gsub("_", "", d_pr)
463
-d_pr <- gsub("-", "", d_pr)
464
-measure[,2] <- gsub(" ", "_", measure[,2])
465
-d2<-sub('_-_Homo_sapiens_(human)*', '', measure[,2])
466
-d_pr2<- gsub("(human)", "", d2, fixed="TRUE")
467
-d_pr2 <- gsub("_", "", d_pr2)
468
-d_pr2 <- gsub("-", "", d_pr2)
469
-PathwaysPair <- paste( as.matrix(d_pr), as.matrix(d_pr2),sep="_" )
470
-rownames(scoreMatrix) <-PathwaysPair
471
-intera<-intersect(rownames(scoreMatrix),rownames(list_perf))
472
-path_bestlipd<-scoreMatrix[intera,]
473
-return(path_bestlipd)
91
+IPPIpath_net<-function(pathway,data){
92
+  lista_int<-list()
93
+  for (k in 1:ncol(pathway)){
94
+    print(colnames(pathway)[k])
95
+    currentPathway_genes<-pathway[,k]
96
+    colnames(data) <- c("gene_symbolA", "gene_symbolB")
97
+    i <- sapply(data, is.factor)
98
+    data[i] <- lapply(data[i], as.character)
99
+    ver<-unlist(data)
100
+    n<-unique(ver)
101
+    s<-intersect(n,currentPathway_genes)
102
+    g <- graph.data.frame(data,directed=FALSE)
103
+    g2 <- induced.subgraph(graph=g,vids=s)
104
+    aaa<-get.data.frame(g2)
105
+    colnames(aaa)[1] <- 'V1'
106
+    colnames(aaa)[2] <- 'V2'
107
+    lista_int[[k]]<-aaa
108
+    names(lista_int)[k]<-colnames(pathway)[k] 
109
+  }
110
+  return(lista_int)
474 111
 }
475 112
 
476 113
 
477 114
 
478
-process_matrix_cell_process<-function(measure_cell_process){
479
-score__cell_grow_d <- as.data.frame(measure_cell_process[,3:ncol(measure_cell_process)])
480
-for( i in 1: ncol(score__cell_grow_d)){
481
-  score__cell_grow_d[,i] <- as.numeric(as.character(score__cell_grow_d[,i]))
482
-}
483
-
484
-measure_cell_process[,1] <- gsub(" ", "_", measure_cell_process[,1])
485
-d<-sub('_-_Homo_sapiens_*', '', measure_cell_process[,1])
486
-
487
-d_pr<- gsub("(human)", "", d, fixed="TRUE")
488
-d_pr <- gsub("_", "", d_pr)
489
-d_pr <- gsub("-", "", d_pr)
490 115
 
491
-measure_cell_process[,2] <- gsub(" ", "_", measure_cell_process[,2])
492
-d2<-sub('_-_Homo_sapiens_(human)*', '', measure_cell_process[,2])
493
-d_pr2<- gsub("(human)", "", d2, fixed="TRUE")
494
-d_pr2 <- gsub("_", "", d_pr2)
495
-d_pr2 <- gsub("-", "", d_pr2)
496 116
 
497
-PathwaysPair <- paste( as.matrix(d_pr), as.matrix(d_pr2),sep="_" )
498
-rownames(score__cell_grow_d) <-PathwaysPair
499
-return(score__cell_grow_d)
500
-}
117
+IPPIlist_path_net<-function(lista_net,pathway){
118
+  v=list()
119
+  bn=list()
120
+  for (j in 1:length(lista_net)){
121
+    cf<-lista_net[[j]]
122
+    i <- sapply(cf, is.factor) 
123
+    cf[i] <- lapply(cf[i], as.character)
124
+    colnames(cf) <- c("m_shar_pro", "m2_shar_pro")
125
+    m<-c(cf$m_shar_pro)
126
+    m2<-c(cf$m2_shar_pro)
127
+    s<-c(m,m2)
128
+    fr<- unique(s)
129
+    n<-as.data.frame(fr)
130
+    if(length(n)==0){
131
+      v[[j]]<-NULL
132
+      
133
+    }
134
+    if(length(n)!=0){
135
+      i <- sapply(n, is.factor) 
136
+      n[i] <- lapply(n[i], as.character)
137
+      #for (k in  1:ncol(pathway)){
138
+      if (length(intersect(n$fr,pathway[,j]))==nrow(n)){
139
+        print(paste("List of genes interacting in the same pathway:",colnames(pathway)[j]))
140
+        aa<-intersect(n$fr,pathway[,j])
141
+        v[[j]]<-aa
142
+        names(v)[j]<-colnames(pathway)[j]
143
+      }
144
+    }}
145
+  return(v)}
501 146
 
502 147
 
503
-#' @title Get human KEGG pathway data.
504
-#' @description getKEGGdata creates a data frame with human KEGG pathway. Columns are the pathways and rows the genes inside those pathway 
505
-#' @param mer  output for example of select_path_carb
506
-#' @export
507
-#' @importFrom KEGGREST keggList
508
-#' @return dataframe with human pathway data
509
-proc_path<-function(mer){
510
-pathways.list <- keggList("pathway", "hsa")## returns the list of human pathways
511
-common<-intersect(pathways.list,mer)
512
-lo<-list()
513
-for (i in 1:length(pathways.list)){
514
-  if (length(intersect(pathways.list[[i]],common)!=0)){
515
-    lo[[i]]<-pathways.list[[i]]
516
-    names(lo)[[i]]<-names(pathways.list)[[i]]
517
-  }
518
-}
519
-pathways.list<-lo[lapply(lo,length)!=0] 
520
-pathway.codes <- sub("path:", "", names(pathways.list))
521
-b<-do.call("rbind", pathways.list)
522
-list_pathkegg<-list(pathway.codes,b)
523
-return(list_pathkegg)
524
-}
525 148
 
526 149
 
527 150
 
528
-delete.NULLs  <-  function(xlist){   # delele null/empty entries in a list
529
-  xlist[unlist(lapply(xlist, nrow) != 0)]
151
+check_chord <- function(mat, limit){
152
+  
153
+  if(all(colSums(mat) >= limit[2]) & all(rowSums(mat) >= limit[1])) return(mat)
154
+  
155
+  tmp <- mat[(rowSums(mat) >= limit[1]),]
156
+  mat <- tmp[,(colSums(tmp) >= limit[2])]
157
+  
158
+  mat <- check_chord(mat, limit)
159
+  return(mat)
530 160
 }
531 161
 
162
+bezier <- function(data, process.col){
163
+  x <- c()
164
+  y <- c()
165
+  Id <- c()
166
+  sequ <- seq(0, 1, by = 0.01)
167
+  N <- dim(data)[1]
168
+  sN <- seq(1, N, by = 2)
169
+  if (process.col[1] == '') col_rain <- grDevices::rainbow(N) else col_rain <- process.col
170
+  for (n in sN){
171
+    xval <- c(); xval2 <- c(); yval <- c(); yval2 <- c()
172
+    for (t in sequ){
173
+      xva <- (1 - t) * (1 - t) * data$x.start[n] + t * t * data$x.end[n]
174
+      xval <- c(xval, xva)
175
+      xva2 <- (1 - t) * (1 - t) * data$x.start[n + 1] + t * t * data$x.end[n + 1]
176
+      xval2 <- c(xval2, xva2)
177
+      yva <- (1 - t) * (1 - t) * data$y.start[n] + t * t * data$y.end[n]  
178
+      yval <- c(yval, yva)
179
+      yva2 <- (1 - t) * (1 - t) * data$y.start[n + 1] + t * t * data$y.end[n + 1]
180
+      yval2 <- c(yval2, yva2)			
181
+    }
182
+    x <- c(x, xval, rev(xval2))
183
+    y <- c(y, yval, rev(yval2))
184
+    Id <- c(Id, rep(n, 2 * length(sequ)))
185
+  }
186
+  df <- data.frame(lx = x, ly = y, ID = Id)
187
+  return(df)
188
+}
532 189
 
533 190
 
534
-
535
-
536
-
537
-
538
-
539
-
191
+#' @name GOChord
192
+#' @title Displays the relationship between genes and terms.
193
+#' @description The GOChord function generates a circularly composited overview 
194
+#'   of selected/specific genes and their assigned processes or terms. More 
195
+#'   generally, it joins genes and processes via ribbons in an intersection-like
196
+#'   graph. 
197
+#' @param data The matrix represents the binary relation (1= is related to, 0= 
198
+#'   is not related to) between a set of genes (rows) and processes (columns); a
199
+#'   column for the logFC of the genes is optional
200
+#' @param title The title (on top) of the plot
201
+#' @param space The space between the chord segments of the plot
202
+#' @param gene.order A character vector defining the order of the displayed gene
203
+#'   labels
204
+#' @param gene.size The size of the gene labels
205
+#' @param gene.space The space between the gene labels and the segement of the 
206
+#'   logFC
207
+#' @param nlfc Defines the number of logFC columns (default=1)
208
+#' @param lfc.col The fill color for the logFC specified in the following form: 
209
+#'   c(color for low values, color for the mid point, color for the high values)
210
+#' @param lfc.min Specifies the minimium value of the logFC scale (default = -3)
211
+#' @param lfc.max Specifies the maximum value of the logFC scale (default = 3)
212
+#' @param ribbon.col The background color of the ribbons
213
+#' @param border.size Defines the size of the ribbon borders
214
+#' @param process.label The size of the legend entries
215
+#' @param limit A vector with two cutoff values (default= c(0,0)). 
216
+#' @import ggplot2
217
+#' @import grDevices
218
+GOChord <- function(data, title, space, gene.order, gene.size, gene.space, nlfc = 1, lfc.col, lfc.min, lfc.max, ribbon.col, border.size, process.label, limit){
219
+  y <- id <- xpro <- ypro <- xgen <- ygen <- lx <- ly <- ID <- logFC <- NULL
220
+  Ncol <- dim(data)[2]
221
+  
222
+  if (missing(title)) title <- ''
223
+  if (missing(space)) space = 0
224
+  if (missing(gene.order)) gene.order <- 'none'
225
+  if (missing(gene.size)) gene.size <- 3
226
+  if (missing(gene.space)) gene.space <- 0.2
227
+  if (missing(lfc.col)) lfc.col <- c('brown1', 'azure', 'cornflowerblue')
228
+  if (missing(lfc.min)) lfc.min <- -10
229
+  if (missing(lfc.max)) lfc.max <- 10
230
+  if (missing(border.size)) border.size <- 0.5
231
+  if (missing (process.label)) process.label <- 11
232
+  if (missing(limit)) limit <- c(0, 0)
233
+  
234
+  if (gene.order == 'logFC') data <- data[order(data[, Ncol], decreasing = T), ]
235
+  if (gene.order == 'alphabetical') data <- data[order(rownames(data)), ]
236
+  if (sum(!is.na(match(colnames(data), 'logFC'))) > 0){
237
+    if (nlfc == 1){
238
+      cdata <- check_chord(data[, 1:(Ncol - 1)], limit)
239
+      lfc <- sapply(rownames(cdata), function(x) data[match(x,rownames(data)), Ncol])
240
+    }else{
241
+      cdata <- check_chord(data[, 1:(Ncol - nlfc)], limit)
242
+      lfc <- sapply(rownames(cdata), function(x) data[, (Ncol - nlfc + 1)])
243
+    }
244
+  }else{
245
+    cdata <- check_chord(data, limit)
246
+    lfc <- 0
247
+  }
248
+  if (missing(ribbon.col)) colRib <- grDevices::rainbow(dim(cdata)[2]) else colRib <- ribbon.col
249
+  nrib <- colSums(cdata)
250
+  ngen <- rowSums(cdata)
251
+  Ncol <- dim(cdata)[2]
252
+  Nrow <- dim(cdata)[1]
253
+  colRibb <- c()
254
+  for (b in 1:length(nrib)) colRibb <- c(colRibb, rep(colRib[b], 202 * nrib[b]))
255
+  r1 <- 1; r2 <- r1 + 0.1
256
+  xmax <- c(); x <- 0
257
+  for (r in 1:length(nrib)){
258
+    perc <- nrib[r] / sum(nrib)
259
+    xmax <- c(xmax, (pi * perc) - space)
260
+    if (length(x) <= Ncol - 1) x <- c(x, x[r] + pi * perc)
261
+  }
262
+  xp <- c(); yp <- c()
263
+  l <- 50
264
+  for (s in 1:Ncol){
265
+    xh <- seq(x[s], x[s] + xmax[s], length = l)
266
+    xp <- c(xp, r1 * sin(x[s]), r1 * sin(xh), r1 * sin(x[s] + xmax[s]), r2 * sin(x[s] + xmax[s]), r2 * sin(rev(xh)), r2 * sin(x[s]))
267
+    yp <- c(yp, r1 * cos(x[s]), r1 * cos(xh), r1 * cos(x[s] + xmax[s]), r2 * cos(x[s] + xmax[s]), r2 * cos(rev(xh)), r2 * cos(x[s]))
268
+  }
269
+  df_process <- data.frame(x = xp, y = yp, id = rep(c(1:Ncol), each = 4 + 2 * l))
270
+  xp <- c(); yp <- c(); logs <- NULL
271
+  x2 <- seq(0 - space, -pi - (-pi / Nrow) - space, length = Nrow)
272
+  xmax2 <- rep(-pi / Nrow + space, length = Nrow)
273
+  for (s in 1:Nrow){
274
+    xh <- seq(x2[s], x2[s] + xmax2[s], length = l)
275
+    if (nlfc <= 1){
276
+      xp <- c(xp, (r1 + 0.05) * sin(x2[s]), (r1 + 0.05) * sin(xh), (r1 + 0.05) * sin(x2[s] + xmax2[s]), r2 * sin(x2[s] + xmax2[s]), r2 * sin(rev(xh)), r2 * sin(x2[s]))
277
+      yp <- c(yp, (r1 + 0.05) * cos(x2[s]), (r1 + 0.05) * cos(xh), (r1 + 0.05) * cos(x2[s] + xmax2[s]), r2 * cos(x2[s] + xmax2[s]), r2 * cos(rev(xh)), r2 * cos(x2[s]))
278
+    }else{
279
+      tmp <- seq(r1, r2, length = nlfc + 1)
280
+      for (t in 1:nlfc){
281
+        logs <- c(logs, data[s, (dim(data)[2] + 1 - t)])
282
+        xp <- c(xp, (tmp[t]) * sin(x2[s]), (tmp[t]) * sin(xh), (tmp[t]) * sin(x2[s] + xmax2[s]), tmp[t + 1] * sin(x2[s] + xmax2[s]), tmp[t + 1] * sin(rev(xh)), tmp[t + 1] * sin(x2[s]))
283
+        yp <- c(yp, (tmp[t]) * cos(x2[s]), (tmp[t]) * cos(xh), (tmp[t]) * cos(x2[s] + xmax2[s]), tmp[t + 1] * cos(x2[s] + xmax2[s]), tmp[t + 1] * cos(rev(xh)), tmp[t + 1] * cos(x2[s]))
284
+      }}}
285
+  if(lfc[1] != 0){
286
+    if (nlfc == 1){
287
+      df_genes <- data.frame(x = xp, y = yp, id = rep(c(1:Nrow), each = 4 + 2 * l), logFC = rep(lfc, each = 4 + 2 * l))
288
+    }else{
289
+      df_genes <- data.frame(x = xp, y = yp, id = rep(c(1:(nlfc*Nrow)), each = 4 + 2 * l), logFC = rep(logs, each = 4 + 2 * l))  
290
+    }
291
+  }else{
292
+    df_genes <- data.frame(x = xp, y = yp, id = rep(c(1:Nrow), each = 4 + 2 * l))
293
+  }
294
+  aseq <- seq(0, 180, length = length(x2)); angle <- c()
295
+  for (o in aseq) if((o + 270) <= 360) angle <- c(angle, o + 270) else angle <- c(angle, o - 90)
296
+  df_texg <- data.frame(xgen = (r1 + gene.space) * sin(x2 + xmax2/2),ygen = (r1 + gene.space) * cos(x2 + xmax2 / 2),labels = rownames(cdata), angle = angle)
297
+  df_texp <- data.frame(xpro = (r1 + 0.15) * sin(x + xmax / 2),ypro = (r1 + 0.15) * cos(x + xmax / 2), labels = colnames(cdata), stringsAsFactors = FALSE)
298
+  cols <- rep(colRib, each = 4 + 2 * l)
299
+  x.end <- c(); y.end <- c(); processID <- c()
300
+  for (gs in 1:length(x2)){
301
+    val <- seq(x2[gs], x2[gs] + xmax2[gs], length = ngen[gs] + 1)
302
+    pros <- which((cdata[gs, ] != 0) == T)
303
+    for (v in 1:(length(val) - 1)){
304
+      x.end <- c(x.end, sin(val[v]), sin(val[v + 1]))
305
+      y.end <- c(y.end, cos(val[v]), cos(val[v + 1]))
306
+      processID <- c(processID, rep(pros[v], 2))
307
+    }
308
+  }
309
+  df_bezier <- data.frame(x.end = x.end, y.end = y.end, processID = processID)
310
+  df_bezier <- df_bezier[order(df_bezier$processID,-df_bezier$y.end),]
311
+  x.start <- c(); y.start <- c()
312
+  for (rs in 1:length(x)){
313
+    val<-seq(x[rs], x[rs] + xmax[rs], length = nrib[rs] + 1)
314
+    for (v in 1:(length(val) - 1)){
315
+      x.start <- c(x.start, sin(val[v]), sin(val[v + 1]))
316
+      y.start <- c(y.start, cos(val[v]), cos(val[v + 1]))
317
+    }
318
+  }	
319
+  df_bezier$x.start <- x.start
320
+  df_bezier$y.start <- y.start
321
+  df_path <- bezier(df_bezier, colRib)
322
+  if(length(df_genes$logFC) != 0){
323
+    tmp <- sapply(df_genes$logFC, function(x) ifelse(x > lfc.max, lfc.max, x))
324
+    logFC <- sapply(tmp, function(x) ifelse(x < lfc.min, lfc.min, x))
325
+    df_genes$logFC <- logFC
326
+  }
327
+  
328
+  g<- ggplot() +
329
+    geom_polygon(data = df_process, aes(x, y, group=id), fill='gray70', inherit.aes = F,color='black') +
330
+    geom_polygon(data = df_process, aes(x, y, group=id), fill=cols, inherit.aes = F,alpha=0.6,color='black') +	
331
+    geom_point(aes(x = xpro, y = ypro, size = factor(labels, levels = labels), shape = NA), data = df_texp) +
332
+    guides(size = guide_legend("Pathway", ncol = 4, byrow = T, override.aes = list(shape = 22, fill = unique(cols), size = 8))) +
333
+    theme(legend.text = element_text(size = process.label)) +
334
+    geom_text(aes(xgen, ygen, label = labels, angle = angle), data = df_texg, size = gene.size) +
335
+    geom_polygon(aes(x = lx, y = ly, group = ID), data = df_path, fill = colRibb, color = 'black', size = border.size, inherit.aes = F) +		
336
+    labs(title = title) + theme(axis.line = element_blank(), axis.text.x = element_blank(),
337
+                                axis.text.y = element_blank(), axis.ticks = element_blank(), axis.title.x = element_blank(),
338
+                                axis.title.y = element_blank(), panel.background = element_blank(), panel.border = element_blank(),
339
+                                panel.grid.major = element_blank(), panel.grid.minor = element_blank(), plot.background = element_blank())
340
+  
341
+  
342
+  if (nlfc >= 1){
343
+    g + geom_polygon(data = df_genes, aes(x, y, group = id, fill = logFC), inherit.aes = F, color = 'black') +
344
+      scale_fill_gradient2('score', space = 'Lab', low = lfc.col[3], mid = lfc.col[2], high = lfc.col[1], guide = guide_colorbar(title.position = "top", title.hjust = 0.5), 
345
+                           breaks = c(min(df_genes$logFC), max(df_genes$logFC)), labels = c(round(min(df_genes$logFC)), round(max(df_genes$logFC)))) +
346
+      theme(legend.position = 'bottom', legend.background = element_rect(fill = 'transparent'), legend.box = 'horizontal', legend.direction = 'horizontal')
347
+  }else{
348
+    g + geom_polygon(data = df_genes, aes(x, y, group = id), fill = 'gray50', inherit.aes = F, color = 'black')+
349
+      theme(legend.position = 'bottom', legend.background = element_rect(fill = 'transparent'), legend.box = 'horizontal', legend.direction = 'horizontal')
350
+  }
351
+}
540 352
 
541 353
 
... ...
@@ -1,17 +1,28 @@
1
-#' @title Get human KEGG pathway data and network data in order to define the common gene.
2
-#' @description path_net creates a list of network data for each human pathway. The network data will be generated when interacting genes belong to that pathway.  
3
-#' @param data  network data as provided by getNETdata
4
-#' @param pathway  pathway data as provided by getKEGGdata
1
+#' @title Get human KEGG pathway data and creates a network data.
2
+#' @description pathnet creates a list of network data for each human pathway. The network data will be generated when interacting genes belong to that pathway.  
3
+#' @param data  a list of network data as provided by getNETdata
4
+#' @param genes.by.pathway  a list of pathway data as provided by ConvertedIDgenes
5 5
 #' @importFrom igraph graph.data.frame induced.subgraph get.data.frame
6 6
 #' @export
7 7
 #' @return a list of network data for each pathway (interacting genes belong to that pathway)
8 8
 #' @examples
9
-#' lista_net<-path_net(pathway=path,data=netw)
10
-path_net<-function(pathway,data){
9
+#' lista_net<-pathnet(genes.by.pathway=pathway[1:5],data=netw)
10
+pathnet<-function(genes.by.pathway,data){
11
+  geneSymb_net_shar_pro<-data
12
+  ds_shar_pro<-do.call("rbind", geneSymb_net_shar_pro)
13
+  data_shar_pro<-as.data.frame(ds_shar_pro[!duplicated(ds_shar_pro), ]) 
14
+  sdc_shar_pro<-unlist(data_shar_pro$gene_symbolA,data_shar_pro$gene_symbolB)
15
+  m_shar_pro<-c(data_shar_pro$gene_symbolA)
16
+  m2_shar_pro<-c(data_shar_pro$gene_symbolB)
17
+  ss_shar_pro<-cbind(m_shar_pro,m2_shar_pro)
18
+  data_pr_shar_pro<-as.data.frame(ss_shar_pro[!duplicated(ss_shar_pro), ]) 
19
+  pathwayx<-  Uniform(genes.by.pathway)
20
+  data<-data_pr_shar_pro
21
+
11 22
   lista_int<-list()
12
-  for (k in 1:ncol(pathway)){
13
-    print(colnames(pathway)[k])
14
-    currentPathway_genes<-pathway[,k]
23
+  for (k in 1:ncol(pathwayx)){
24
+    print(colnames(pathwayx)[k])
25
+    currentPathway_genes<-pathwayx[,k]
15 26
     colnames(data) <- c("gene_symbolA", "gene_symbolB")
16 27
     i <- sapply(data, is.factor)
17 28
     data[i] <- lapply(data[i], as.character)
... ...
@@ -24,7 +35,7 @@ path_net<-function(pathway,data){
24 35
     colnames(aaa)[1] <- 'V1'
25 36
     colnames(aaa)[2] <- 'V2'
26 37
     lista_int[[k]]<-aaa
27
-    names(lista_int)[k]<-colnames(pathway)[k] 
38
+    names(lista_int)[k]<-colnames(pathwayx)[k] 
28 39
   }
29 40
   return(lista_int)
30 41
 }
... ...
@@ -32,16 +43,18 @@ path_net<-function(pathway,data){
32 43
 
33 44
 
34 45
 
35
-#' @title Get human KEGG pathway data and output of path_net in order to define the common genes.
36
-#' @description list_path_net creates a list of interacting genes for each human pathway.   
46
+#' @title Get human KEGG pathway data and the output of list_path_net  define the common genes.
47
+#' @description listpathnet creates a list of interacting genes for each human pathway.   
37 48
 #' @param lista_net  output of path_net
38
-#' @param pathway  pathway data as provided by getKEGGdata
49
+#' @param pathway_exp  pathway data as provided by getKEGGdata
39 50
 #' @export
40 51
 #' @return a list of genes for each pathway (interacting genes belong to that pathway)
41 52
 #' @examples
42
-#' lista_netw<-path_net(pathway=path,data=netw)
43
-#' list_path<-list_path_net(lista_net=lista_netw,pathway=path)
44
-list_path_net<-function(lista_net,pathway){
53
+#' lista_network<-pathnet(genes.by.pathway=pathway[1:5],data=netw)
54
+#' list_path<-listpathnet(lista_net=lista_network,pathway=pathway[1:5])
55
+listpathnet<-function(lista_net,pathway_exp){
56
+  top3<-  Uniform(pathway_exp)
57
+  pathway<-top3
45 58
 v=list()
46 59
 bn=list()
47 60
 for (j in 1:length(lista_net)){
... ...
@@ -56,9 +69,7 @@ for (j in 1:length(lista_net)){
56 69
   n<-as.data.frame(fr)
57 70
   if(length(n)==0){
58 71
     v[[j]]<-NULL
59
-    
60 72
   }
61
-  if(length(n)!=0){
62 73
   i <- sapply(n, is.factor) 
63 74
   n[i] <- lapply(n[i], as.character)
64 75
   #for (k in  1:ncol(pathway)){
... ...
@@ -68,31 +79,30 @@ for (j in 1:length(lista_net)){
68 79
     v[[j]]<-aa
69 80
     names(v)[j]<-colnames(pathway)[j]
70 81
   }
71
-}}
82
+}
72 83
 return(v)}
73 84
 
74 85
 
75 86
 
76 87
 
77
-#' @title Get human KEGG pathway data and a gene expression matrix in order to obtain a matrix with the gene expression for only pathways given in input .
78
-#' @description GE_matrix creates a matrix of gene expression for pathways given by the user.   
88
+#' @title Get human KEGG pathway data and a gene expression matrix in order to obtain a list with the gene expression for only pathways given in input .
89
+#' @description GE_matrix creates a list of gene expression for pathways given by the user.   
79 90
 #' @param DataMatrix  gene expression matrix (eg.TCGA data)
80
-#' @param pathway  pathway data as provided by getKEGGdata
91
+#' @param genes.by.pathway a list of pathway data as provided by GetData and ConvertedID_genes
81 92
 #' @export
82
-#' @return a matrix for each pathway ( gene expression level belong to that pathway)
93
+#' @return a list for each pathway ( gene expression level belong to that pathway)
83 94
 #' @examples
84
-#' list_path_gene<-GE_matrix(DataMatrix=tumo[,1:2],pathway=path)
85
-GE_matrix<-function(DataMatrix,pathway) {
86
-  path_name<-sub(' ', '_',colnames(pathway))
87
-d_pr<- gsub(" - Homo sapiens (human)", "", path_name, fixed="TRUE")
88
-colnames(pathway)<-d_pr
89
-#zz<-as.data.frame(rowMeans(DataMatrix))
95
+#' list_path_gene<-GE_matrix(DataMatrix=tumo[,1:2],genes.by.pathway=pathway[1:5])
96
+GE_matrix<-function(DataMatrix,genes.by.pathway) {
97
+  pathwayfrom<-genes.by.pathway
98
+  top3<-  Uniform(pathwayfrom)
99
+  pathway<-top3
90 100
 zz<-as.data.frame(DataMatrix)
91 101
 v<-list()
92 102
 for ( k in 1: ncol(pathway)){
93 103
   #k=2
94 104
   if (length(intersect(rownames(zz),pathway[,k])!=0)){
95
-    print(colnames(path)[k])
105
+    print(colnames(pathway)[k])
96 106
   currentPathway_genes_list_common <- intersect(rownames(zz), currentPathway_genes<-pathway[,k])
97 107
   currentPathway_genes_list_commonMatrix <- as.data.frame(zz[currentPathway_genes_list_common,])
98 108
   rownames(currentPathway_genes_list_commonMatrix)<-currentPathway_genes_list_common
... ...
@@ -100,27 +110,23 @@ for ( k in 1: ncol(pathway)){
100 110
   names(v)[k]<-colnames(pathway)[k]
101 111
   }
102 112
 }  
103
-#PEAmatrix <- matrix( 0,nrow(DataMatrix),ncol(pathway))
104
-#rownames(PEAmatrix) <- as.factor(rownames(DataMatrix))
105
-#colnames(PEAmatrix) <-  as.factor(colnames(pathway))
106
-#for (i in 1:length(v)){
107
-#PEAmatrix[v[[i]],i]<-zz[v[[i]],]
108
-#}
109
-#PEAmatrix<-PEAmatrix[which(rowSums(PEAmatrix) > 0),]
110 113
 return(v)
111 114
 }
112 115
 
113 116
 
114 117
 
115 118
 #' @title Get human KEGG pathway data and a gene expression matrix in order to obtain a matrix with the mean gene expression for only pathways given in input .
116
-#' @description GE_matrix creates a matrix of mean gene expression for pathways given by the user.