File Coverage

lib/Convert/Pheno/PXF.pm
Criterion Covered Total %
statement 119 137 86.8
branch 57 86 66.2
condition 4 11 36.3
subroutine 11 11 100.0
pod 0 3 0.0
total 191 248 77.0


line stmt bran cond sub pod time code
1             package Convert::Pheno::PXF;
2              
3 6     6   47 use strict;
  6         14  
  6         185  
4 6     6   34 use warnings;
  6         16  
  6         144  
5 6     6   32 use autodie;
  6         14  
  6         72  
6 6     6   35918 use feature qw(say);
  6         14  
  6         554  
7 6     6   3178 use Sys::Hostname;
  6         6912  
  6         372  
8 6     6   51 use Cwd qw(cwd abs_path);
  6         16  
  6         309  
9 6     6   44 use Convert::Pheno::Mapping;
  6         13  
  6         571  
10 6     6   44 use Exporter 'import';
  6         10  
  6         11919  
11             our @EXPORT = qw(do_pxf2bff get_metaData);
12              
13             #############
14             #############
15             # PXF2BFF #
16             #############
17             #############
18              
19             sub do_pxf2bff {
20              
21 26     26 0 56 my ( $self, $data ) = @_;
22 26         34 my $sth = $self->{sth};
23              
24             # *** IMPORTANT ****
25             # PXF three top-level elements are usually split in files:
26             # - phenopacket.json ( usually - 1 individual per file)
27             # - cohort.json (info on mutliple individuals)
28             # - family.json (info related to one or multiple individuals).
29             # These 3 files dont't contain their respective objects at the root level (/).
30             #
31             # However, top-elements might be combined into a single file (e.g., pxf.json),
32             # as a result, certain files may contain objects for top-level elements:
33             # - /phenopacket
34             # - /cohort
35             # - /family
36             #
37             # In this context, we only accept top-level phenopackets,
38             # while the other two types will be categorized as "info".
39              
40             # We create cursors for top-level elements
41             # 1 - phenopacket (mandatory)
42             my $phenopacket =
43 26 50       58 exists $data->{phenopacket} ? $data->{phenopacket} : $data;
44              
45             # 2, 3 - /cohort and /family (unlikely)
46             # NB: They usually contain info on many individuals and their own files)
47 26 50       53 my $cohort = exists $data->{family} ? $data->{cohort} : undef;
48 26 50       48 my $family = exists $data->{family} ? $data->{family} : undef;
49              
50             # Normalize the hash for medical_actions + medicalActions = medicalActions
51 26 50       68 if ( exists $phenopacket->{medical_actions} ) {
52              
53             # NB: The delete function returns the value of the deleted key-value pair
54 0         0 $phenopacket->{medicalActions} = delete $phenopacket->{medical_actions};
55             }
56              
57             # CNAG files have 'meta_data' nomenclature, but PXF documentation uses 'metaData'
58             # We search for both 'meta_data' and 'metaData' and simply display the
59 26 50       51 if ( exists $phenopacket->{meta_data} ) {
60              
61             # NB: The delete function returns the value of the deleted key-value pair
62 0         0 $phenopacket->{metaData} = delete $phenopacket->{meta_data};
63             }
64              
65             # Define defaults
66 26         42 my $default_date = '1900-01-01';
67 26         28 my $default_duration = 'P999Y';
68 26         28 my $default_value = -1;
69 26         28 my $default_timestamp = '1900-01-01T00:00:00Z';
70 26         50 my $default_iso8601duration = { iso8601duration => $default_duration };
71 26         52 my $default_ontology = { id => 'NCIT:NA0000', label => 'NA' };
72 26         51 my $default_quantity = {
73             unit => $default_ontology,
74             value => $default_value
75             };
76              
77             ####################################
78             # START MAPPING TO BEACON V2 TERMS #
79             ####################################
80              
81             # *** IMPORTANT ***
82             # biosamples => can not be mapped to individuals (is Biosamples)
83             # interpretations => does not have equivalent
84             # files => idem
85             # They will added to {info}
86              
87             # NB: In PXF some terms are = []
88              
89 26         28 my $individual;
90              
91             # ========
92             # diseases
93             # ========
94              
95 26 100       48 if ( exists $phenopacket->{diseases} ) {
96 18         23 for my $pxf_disease ( @{ $phenopacket->{diseases} } ) {
  18         71  
97 24         50 my $disease = $pxf_disease; # Ref-copy-only
98 24         52 $disease->{diseaseCode} = $disease->{term};
99             $disease->{ageOfOnset} = $disease->{onset}
100 24 100       57 if exists $disease->{onset};
101             $disease->{excluded} =
102             ( exists $disease->{negated} || exists $disease->{excluded} )
103 24 50 33     113 ? JSON::XS::true
104             : JSON::XS::false;
105              
106             # Clean analog terms if exist
107 24         107 for (qw/term onset/) {
108             delete $disease->{$_}
109 48 100       119 if exists $disease->{$_};
110             }
111              
112 24         29 push @{ $individual->{diseases} }, $disease;
  24         68  
113             }
114             }
115              
116             # ========
117             # ethnicity
118             # ========
119             # NA
120              
121             # ========
122             # exposures
123             # ========
124 26 50       53 if ( exists $phenopacket->{exposures} ) {
125 0         0 for my $pxf_exposure ( @{ $phenopacket->{exposures} } ) {
  0         0  
126 0         0 my $exposure = $pxf_exposure; # Ref-copy-only
127 0         0 $exposure->{exposureCode} = $exposure->{type};
128             $exposure->{date} =
129 0         0 substr( $exposure->{occurrence}{timestamp}, 0, 10 );
130              
131             # Required properties
132 0         0 $exposure->{ageAtExposure} = $default_iso8601duration;
133 0         0 $exposure->{duration} = $default_duration;
134 0 0       0 unless ( exists $exposure->{unit} ) {
135 0         0 $exposure->{unit} = $default_ontology;
136             }
137              
138             # Clean analog terms if exist
139 0         0 for (qw/type occurence/) {
140             delete $exposure->{$_}
141 0 0       0 if exists $exposure->{$_};
142             }
143              
144 0         0 push @{ $individual->{exposures} }, $exposure;
  0         0  
145             }
146             }
147              
148             # ================
149             # geographicOrigin
150             # ================
151             # NA
152              
153             # ==
154             # id
155             # ==
156              
157             $individual->{id} = $phenopacket->{subject}{id}
158 26 50       96 if exists $phenopacket->{subject}{id};
159              
160             # ====
161             # info
162             # ====
163              
164             # *** IMPORTANT ***
165             # Here we set data that do not fit anywhere else
166              
167             # Miscelanea for top-level 'phenopacket'
168 26         39 for my $term (
169             qw (dateOfBirth genes interpretations metaData variants files biosamples pedigree)
170             )
171             {
172             $individual->{info}{phenopacket}{$term} = $phenopacket->{$term}
173 208 100       401 if exists $phenopacket->{$term};
174             }
175              
176             # Miscelanea for top-levels 'cohort' and 'family'
177 26 50       48 $individual->{info}{cohort} = $cohort if defined $cohort;
178 26 50       52 $individual->{info}{family} = $family if defined $family;
179              
180             # =========================
181             # interventionsOrProcedures
182             # ========================
183              
184 26 100       50 if ( exists $phenopacket->{medicalActions} ) {
185 12         14 for my $action ( @{ $phenopacket->{medicalActions} } ) {
  12         23  
186 40 100       92 if ( exists $action->{procedure} ) {
187 12         21 my $procedure = $action->{procedure}; # Ref-copy-only
188             $procedure->{procedureCode} =
189             exists $action->{procedure}{code}
190             ? $action->{procedure}{code}
191 12 50       32 : $default_ontology;
192             $procedure->{ageOfProcedure} =
193             exists $action->{procedure}{performed}
194             ? $action->{procedure}{performed}
195 12 50       32 : $default_timestamp;
196              
197             # Clean analog terms if exist
198 12         20 for (qw/code performed/) {
199              
200             delete $procedure->{$_}
201 24 50       49 if exists $procedure->{$_};
202             }
203              
204 12         15 push @{ $individual->{interventionsOrProcedures} }, $procedure;
  12         26  
205             }
206             }
207             }
208              
209             # =============
210             # karyotypicSex
211             # =============
212             $individual->{karyotypicSex} = $phenopacket->{subject}{karyotypicSex}
213 26 50       79 if exists $phenopacket->{subject}{karyotypicSex};
214              
215             # =========
216             # measures
217             # =========
218 26 100       50 if ( exists $phenopacket->{measurements} ) {
219 10         13 for my $measurement ( @{ $phenopacket->{measurements} } ) {
  10         20  
220 38         47 my $measure = $measurement; # Ref-copy-only
221              
222 38         66 $measure->{assayCode} = $measure->{assay};
223              
224             # Process remotely compleValue
225             # s/type/quantityType/
226             map_complexValue( $measure->{complexValue} )
227 38 100       65 if exists $measure->{complexValue};
228              
229             # Assign dependeing on PXF
230             $measure->{measurementValue} =
231             exists $measure->{value} ? $measure->{value}
232             : exists $measure->{complexValue} ? $measure->{complexValue}
233 38 50       80 : $default_value;
    100          
234             $measure->{observationMoment} = $measure->{timeObserved}
235 38 100       84 if exists $measure->{timeObserved};
236              
237             # Clean analog terms if exist
238 38         44 for (qw/assay value complexValue/) {
239             delete $measure->{$_}
240 114 100       192 if exists $measure->{$_};
241             }
242              
243 38         42 push @{ $individual->{measures} }, $measure;
  38         71  
244             }
245             }
246              
247             # =========
248             # pedigrees
249             # =========
250             # See above {info}{phenopacket}{pedigree} => singular!!!
251              
252             # ==================
253             # phenotypicFeatures
254             # ==================
255 26 100       51 if ( exists $phenopacket->{phenotypicFeatures} ) {
256 24         30 for my $feature ( @{ $phenopacket->{phenotypicFeatures} } ) {
  24         49  
257 156         156 my $phenotypicFeature = $feature; # Ref-copy-only
258              
259             # *** IMPORTANT ****
260             # In v2.0.0 BFF 'evidence' is object but in PXF is array of objects
261              
262             $phenotypicFeature->{excluded} =
263             ( exists $phenotypicFeature->{negated}
264             || exists $phenotypicFeature->{excluded} )
265             ? JSON::XS::true
266             : JSON::XS::false,
267             $phenotypicFeature->{featureType} = $phenotypicFeature->{type}
268 156 50 33     593 if exists $phenotypicFeature->{type};
    50          
269              
270             # Clean analog terms if exist
271 156         502 for (qw/negated type/) {
272             delete $phenotypicFeature->{$_}
273 312 100       501 if exists $phenotypicFeature->{$_};
274             }
275              
276 156         148 push @{ $individual->{phenotypicFeatures} }, $phenotypicFeature;
  156         288  
277             }
278             }
279              
280             # ===
281             # sex
282             # ===
283              
284             $individual->{sex} = map_ontology(
285             {
286             query => $phenopacket->{subject}{sex},
287             column => 'label',
288             ontology => 'ncit',
289             self => $self
290             }
291             )
292             if ( exists $phenopacket->{subject}{sex}
293 26 50 33     278 && $phenopacket->{subject}{sex} ne '' );
294              
295             # ==========
296             # treatments
297             # ==========
298              
299 26 100       80 if ( exists $phenopacket->{medicalActions} ) {
300 12         14 for my $action ( @{ $phenopacket->{medicalActions} } ) {
  12         23  
301 40 100       74 if ( exists $action->{treatment} ) {
302 26         33 my $treatment = $action->{treatment}; # Ref-copy-only
303             $treatment->{treatmentCode} =
304             exists $action->{treatment}{agent}
305             ? $action->{treatment}{agent}
306 26 50       66 : $default_ontology;
307              
308             # Clean analog terms if exist
309             delete $treatment->{agent}
310 26 50       52 if exists $treatment->{agent};
311              
312             # doseIntervals needs some parsing
313 26 100       49 if ( exists $treatment->{doseIntervals} ) {
314              
315             # Required properties:
316             # - scheduleFrequency
317             # - quantity
318              
319 24         27 for ( @{ $treatment->{doseIntervals} } ) {
  24         43  
320              
321             # quantity
322 26 50       54 unless ( exists $_->{quantity} ) {
323 0         0 $_->{quantity} = $default_quantity;
324             }
325              
326             #scheduleFrequency
327 26 50       54 unless ( exists $_->{scheduleFrequency} ) {
328 0         0 $_->{scheduleFrequency} = $default_ontology;
329             }
330             }
331             }
332              
333 26         29 push @{ $individual->{treatments} }, $treatment;
  26         57  
334             }
335             }
336             }
337              
338             ##################################
339             # END MAPPING TO BEACON V2 TERMS #
340             ##################################
341              
342             # print Dumper $individual;
343 26         91 return $individual;
344             }
345              
346             sub map_complexValue {
347              
348 6     6 0 11 my $complexValue = shift;
349              
350             # "typedQuantities": [
351             # {
352             # "type": {
353             # "label": "Visual Acuity",
354             # "id": "NCIT:C87149"
355             # },
356             # "quantity": {
357             # "unit": {
358             # "id": "NCIT:C48570",
359             # "label": "Percent Unit"
360             # },
361             # "value": 100
362             # }
363             # }
364             # }
365              
366             # Modifying the orginal ref
367 6         8 for ( @{ $complexValue->{typedQuantities} } ) {
  6         16  
368 8         20 $_->{quantityType} = delete $_->{type};
369             }
370              
371 6         8 return 1;
372             }
373              
374             sub get_metaData {
375              
376 1     1 0 2 my $self = shift;
377              
378             # NB: Q: Why inside PXF.pm and not inside BFF.pm?
379             # : A: Because it's easier to remember (used in REDCap,pm, BFF.pm)
380              
381             # Setting a few variables
382 1         2 my $user = $self->{username};
383              
384             # NB: Darwin does not have nproc to show #logical-cores, using sysctl instead
385 1         3 my $os = $^O;
386             chomp(
387 1 50 50     11743 my $ncpuhost =
    50          
388             lc($os) eq 'darwin' ? qx{/usr/sbin/sysctl -n hw.logicalcpu}
389             : $os eq 'MSWin32' ? qx{wmic cpu get NumberOfLogicalProcessors}
390             : qx{/usr/bin/nproc} // 1
391             );
392              
393             # For the Windows command, the result will also contain the string
394             # "NumberOfLogicalProcessors" which is the header of the output.
395             # So we need to extract the actual number from it:
396 1 50       32 if ( $os eq 'MSWin32' ) {
397 0         0 ($ncpuhost) = $ncpuhost =~ /(\d+)/;
398             }
399 1         20 $ncpuhost = 0 + $ncpuhost; # coercing it to be a number
400              
401 1         7991 my $info = {
402             user => $user,
403             ncpuhost => $ncpuhost,
404             cwd => cwd,
405             hostname => hostname,
406             'Convert-Pheno' => $::VERSION
407             };
408 1         190 my $resources = [
409             {
410             id => 'ICD10',
411             name =>
412             'International Statistical Classification of Diseases and Related Health Problems 10th Revision',
413             url => 'https://icd.who.int/browse10/2019/en#',
414             version => '2019',
415             namespacePrefix => 'ICD10',
416             iriPrefix => 'https://icd.who.int/browse10/2019/en#/'
417             },
418             {
419             id => 'NCIT',
420             name => 'NCI Thesaurus',
421             url => 'http://purl.obolibrary.org/obo/ncit.owl',
422             version => '22.03d',
423             namespacePrefix => 'NCIT',
424             iriPrefix => 'http://purl.obolibrary.org/obo/NCIT_'
425             },
426             {
427             id => 'Athena-OHDSI',
428             name => 'Athena-OHDSI',
429             url => 'https://athena.ohdsi.org',
430             version => 'v5.3.1',
431             namespacePrefix => 'OHDSI',
432             iriPrefix => 'http://www.fakeurl.com/OHDSI_'
433             }
434             ];
435             return {
436             #_info => $info, # Not allowed
437 1         29 created => iso8601_time(),
438             createdBy => $user,
439             submittedBy => $user,
440             phenopacketSchemaVersion => '2.0',
441             resources => $resources,
442             externalReferences => [
443             {
444             id => 'PMID: 26262116',
445             reference =>
446             'https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4815923',
447             description =>
448             'Observational Health Data Sciences and Informatics (OHDSI): Opportunities for Observational Researchers'
449             }
450             ]
451             };
452             }
453              
454             1;