What's the equivalent of R's ifelse in Perl PDL - r

I am new to PDL. R's ifelse() method can do conditonal element selection. For example,
x <- c(1,2,3,4)
ifelse(x%%2, x, x*2)
# [1] 1 4 3 8
Anyone knows how to do this in PDL? I know you can do it like below, but is there any better ways?
pdl(map { $_ % 2 ? $_ : $_*2 } #{$x->unpdl} )

#! /usr/bin/perl
use warnings;
use strict;
use PDL;
my $x = 'PDL'->new([1, 2, 3, 4]);
my $where = ! ($x % 2); # [0 1 0 1]
my $y = $x * ($where + 1);
print $y; # [1 4 3 8]
or, shortly
my $y = $x * ( 2 - $x % 2 );

Answering the question myself. It can be something like this,
use PDL;
sub ifelse {
my ( $test, $yes, $no ) = #_;
$test = pdl($test);
my ( $ok, $nok ) = which_both($test);
my $rslt = zeros( $test->dim(0) );
unless ( $ok->isempty ) {
$yes = pdl($yes);
$rslt->slice($ok) .= $yes->index( $ok % $yes->dim(0) );
}
unless ( $nok->isempty ) {
$no = pdl($no);
$rslt->slice($nok) .= $no->index( $nok % $no->dim(0) );
}
return $rslt;
}
my $x = pdl( 1, 2, 3, 4 );
say ifelse( $x % 2, $x, $x * 2 ); # [1 4 3 8]
say ifelse( $x % 2, 5, sequence( 3 ) ); # [5 1 5 0]
say ifelse( 42, $x, $x * 2 ); # [1]

In PDL, the general solution to that sort of thing likely involves slicing and similar. Looking at the latest release notes of PDL (2.077), which has a new where_both, I remembered this question (disclosure: I'm current maintainer). While your specific problem only involves a change to the values of even numbers, I'll also show the case of adding 2 to odds:
my ($odd, $even) = where_both($x, $x % 2);
$odd += 2, $even *= 2; # the "," form is just a flourish, it could be 2 lines
It's efficient, in proper PDL style, because the scan of $x only happens once (you won't be surprised to learn it also uses which_both under the hood), and the mutations only look at the slices of the bits that are relevant. This is very similar to your code, but it got captured into a small, widely-reusable function. (I wrote it to turn the TriD EuclidAxes stuff from using Perl for-loops to actually using ndarrays, if you're interested)

Better than $x ? $y : $z? Not to my mind, but it's a matter of style and taste
sub ifelse {
my ($x,$y,$z) = #_;
$x ? $y : $z ;
if($x){$y}else{$z} ;
[$y,$z]->[!$x] ;
[$z,$y]->[!!$x] ;
($x && $y) || $z ; # valid only if $y is always true
(!$x && $z) || $y ; # valid only if $z is always true
}

Related

Break out of loop and continue with next iteration after a certain time?

Hi supposed I have something like this.
s = c( 1, 10, 20, 2, 3, 300 )
for ( i in 1:1000 ){
Sys.sleep( sample ( s, 1 ))
# break if it longer than 20 seconds?
print ( "done")
}
What I want to the loop to do is to break and continue if a command takes more than 20 secs?
thanks.
Maybe this serves your purpose:
for ( i in 1:1000 ){
wait <- sample ( s, 1 )
if(wait > 20) break
else {
# print(wait)
Sys.sleep( wait)
print ( "done")
}
}
print(wait) is an optional way to know the sampled wait.

find frequency of substring in a set of strings

I have as input a gene list where each genes has a header like >SomeText.
For each gene I would like to find the frequency of the string GTG. (number of occurences divided by length of gene). The string should only be counted if it starts at position 1,4,7,10 etc (every thids position).
>ENST00000619537.4 cds:known chromosome:GRCh38:21:6560714:6564489:1 gene:ENSG00000276076.4 gene_biotype:protein_coding transcript_biotype:protein_coding gene_symbol:CH507-152C13.3 description:alpha-crystallin A chain [Source:RefSeq peptide;Acc:NP_001300979]
ATGGATGTGACCATCCAGCACCCCTGGTTCAAGCGCACCCTGGGGCCCTTCTACCCCAGC
CGGCTGTTCGACCAGTTTTTCGGCGAGGGCCTTTTTGAGTATGACCTGCTGCCCTTCCTG
TCGTCCACCATCAGCCCCTACTACCGCCAGTCCCTCTTCCGCACCGTGCTGGACTCCGGC
ATCTCTGAGGTTCGATCCGACCGGGACAAGTTCGTCATCTTCCTCGATGTGAAGCACTTC
TCCCCGGAGGACCTCACCGTGAAGGTGCAGGACGACTTTGTGGAGATCCACGGAAAGCAC
AACGAGCGCCAGGACGACCACGGCTACATTTCCCGTGAGTTCCACCGCCGCTACCGCCTG
CCGTCCAACGTGGACCAGTCGGCCCTCTCTTGCTCCCTGTCTGCCGATGGCATGCTGACC
TTCTGTGGCCCCAAGATCCAGACTGGCCTGGATGCCACCCACGCCGAGCGAGCCATCCCC
GTGTCGCGGGAGGAGAAGCCCACCTCGGCTCCCTCGTCCTAA
>ENST00000624019.3 cds:known chromosome:GRCh38:21:6561284:6563978:1 gene:ENSG00000276076.4 gene_biotype:protein_coding transcript_biotype:protein_coding gene_symbol:CH507-152C13.3 description:alpha-crystallin A chain [Source:RefSeq peptide;Acc:NP_001300979]
ATGGACGCCCCCCCCCCCCACCCAACCACAGGCCTCCTCTCTGAGCCACGGGTTCGATCC
GACCGGGACAAGTTCGTCATCTTCCTCGATGTGAAGCACTTCTCCCCGGAGGACCTCACC
GTGAAGGTGCAGGACGACTTTGTGGAGATCCACGGAAAGCACAACGAGCGCCAGGACGAC
CACGGCTACATTTCCCGTGAGTTCCACCGCCGCTACCGCCTGCCGTCCAACGTGGACCAG
TCGGCCCTCTCTTGCTCCCTGTCTGCCGATGGCATGCTGACCTTCTGTGGCCCCAAGATC
CAGACTGGCCTGGATGCCACCCACGCCGAGCGAGCCATCCCCGTGTCGCGGGAGGAGAAG
CCCACCTCGGCTCCCTCGTCCTAA
>ENST00000624932.1 cds:known chromosome:GRCh38:21:6561954:6564203:1 gene:ENSG00000276076.4 gene_biotype:protein_coding transcript_biotype:protein_coding gene_symbol:CH507-152C13.3 description:alpha-crystallin A chain [Source:RefSeq peptide;Acc:NP_001300979]
ATGCCTGTCTGTCCAGGAGACAGTCACAGGCCCCCGAAAGCTCTGCCCCACTTGGTGTGT
GGGAGAAGAGGCCGGCAGGTTCGATCCGACCGGGACAAGTTCGTCATCTTCCTCGATGTG
AAGCACTTCTCCCCGGAGGACCTCACCGTGAAGGTGCAGGACGACTTTGTGGAGATCCAC
GGAAAGCACAACGAGCGCCAGGACGACCACGGCTACATTTCCCGTGAGTTCCACCGCCGC
TACCGCCTGCCGTCCAACGTGGACCAGTCGGCCCTCTCTTGCTCCCTGTCTGCCGATGGC
ATGCTGACCTTCTGTGGCCCCAAGATCCAGACTGGCCTGGATGCCACCCACGCCGAGCGA
GCCATCCCCGTGTCGCGGGAGGAGAAGCCCACCTCGGCTCCCTCGTCCTAA
Output:
Gene Frequency
Gene1: 3
Gene2 6.3
....
I was thinging of something like this, but I dont now how to define the positions requirements:
freq <- sapply(gregexpr("GTG",x),function(x)if(x[[1]]!=-1) length(x) else 0)
Here is an idea in R using stringi.
We use stri_locate_all_fixed() to find the start and end position of each GTG occurence. Then we create a column condition to test if start position is in 1,4,7,10,13,16,19,22 ....
library(stringi)
library(dplyr)
data.frame(stri_locate_all_fixed(gene1, "GTG")) %>%
mutate(condition = start %in% seq(1, nchar(gene), 3))
Which gives:
# start end condition
#1 4 6 TRUE
If you want to generalize this to a list of genes, you could do:
lst <- list(gene1, gene2, gene3)
res <- lapply(lst, function(x) {
data.frame(stri_locate_all_fixed(x, "GTG")) %>%
mutate(condition = start %in% seq(1, nchar(x), 3))
})
Which would give:
#[[1]]
# start end condition
#1 4 6 TRUE
#
#[[2]]
# start end condition
#1 NA NA FALSE
#
#[[3]]
# start end condition
#1 3 5 FALSE
#2 9 11 FALSE
#3 21 23 FALSE
#4 70 72 TRUE
#5 75 77 FALSE
Following #Sobrique's comment, if divided by length means number of occurences respecting condition divided by total number of char in each gene, you could do:
lapply(1:length(res), function(x) sum(res[[x]][["condition"]]) / nchar(lst[[x]]))
Which would give:
#[[1]]
#[1] 0.004830918
#
#[[2]]
#[1] 0
#
#[[3]]
#[1] 0.003021148
Here's a Perl solution that does as you ask
But I don't understand how your example output is derived: the first and last sequences have only one occurrence of GTG in the positions you require, and the second sequence has none at all. That means the outputs are 1 / 207, 0 / 74, and 1 / 331 respectively. None of those are anything like 3 and 6.3 that you say you're expecting
This program expects the path to the input file as a parameter on the command line
use strict;
use warnings 'all';
print "Gene Frequency\n";
my $name;
local $/ = '>';
while ( <> ) {
chomp;
next unless /\S/;
my ($name, $seq) = split /\n/, $_, 2;
$seq =~ tr/A-Z//cd;
my $n = 0;
while ( $seq =~ /(?=GTG)/g ) {
++$n if $-[0] % 3 == 0;
}
printf "%-7s%.6f\n", $name, $n / length($seq);
}
output
Gene Frequency
Gene1 0.004831
Gene2 0.000000
Gene3 0.003021
Here is an alternate solution that does not use a pattern match. Not that it will matter much.
use strict;
use warnings;
my $gene;
while ( my $line = <> ) {
if ( $line =~ /^>(.+)/ ) {
$gene = $1;
next;
}
chomp $line;
printf "%s: %s\n",
$gene,
( grep { $_ eq 'GTG' } split /(...)/, $line ) / length $line;
}
Output:
Gene1: 0.00483091787439614
Gene2: 0
Gene3: 0.00302114803625378
It is essentially similar to Sobrique's answer, but assumes that the gene lines contain the right characters. It splits up the gene string into a list of three-character pieces and takes the ones that are literally GTG.
The splitting works by abusing the fact that split uses a pattern as the delimiter, and that it will also capture the delimiter if a capture group is used. Here's an example.
my #foo = split /(...)/, '1234567890';
p #foo; # from Data::Printer
__END__
[
[0] "",
[1] 123,
[2] "",
[3] 456,
[4] "",
[5] 789,
[6] 0
]
The empty elements get filter out by grep. It might not be the most efficient way, but it gets the job done.
You can run it by calling perl foo.pl horribly-large-gene-sequence.file.
Well, you have an R solution. I've hacked something together in perl because you tagged it:
#!/usr/bin/env perl
use strict;
use warnings;
my $target = 'GTG';
local $/ = "\n>";
while ( <> ) {
my ($gene) = m/(Gene\d+)/;
my #hits = grep { /^$target$/ } m/ ( [GTCA]{3} ) /xg;
print "$gene: ".( scalar #hits), "\n";
}
This doesn't give the same results as your input though:
Gene1: 1
Gene2: 0
Gene3: 1
I'm decomposing your string into 3 element lists, and looking for ones that specifically match. (And I haven't divided by length, as I'm not entirely clear if that's the actual string length in letters, or some other metric).
Including length matching - we need to capture both name and string:
#!/usr/bin/env perl
use strict;
use warnings;
local $/ = "\n>";
while (<>) {
my ($gene, $gene_str) = m/(Gene\d+)\n([GTCA]+)/m;
my #hits = grep { /^GTG$/ } $gene_str =~ m/ ( [GTCA]{3} ) /xg;
print "$gene: " . #hits . "/". length ( $gene_str ), " = ", #hits / length($gene_str), "\n";
}
We use <> which is the 'magic' filehandle, and tells perl to read from either STDIN or a file specified on command line. Much like sed or grep does.
With your input:
Gene1: 1/207 = 0.00483091787439614
Gene2: 0/74 = 0
Gene3: 1/331 = 0.00302114803625378
Here is a function I created based on your requirement. I am pretty sure there are alternate ways better than this but this solves the problem.
require(stringi)
input_gene_list<- list(gene1= "GTGGGGGTTTGTGGGGGTG", gene2= "GTGGGGGTTTGTGGGGGTG", gene3= "GTGGGGGTTTGTGGGGGTG")
gene_counter<- function(gene){
x<- gene
y<- gsub(pattern = "GTG",replacement = "GTG ", x = x, perl=TRUE)
if(str_count(y,pattern = "GTG")) {
gene_count<- unlist(gregexpr(pattern = " ", y))
counter<- 0
for(i in 1:length(gene_count)){
if((gene_count[i] %% 3) == 1) counter=counter+1
}
return(counter/nchar(x))
}
}
output_list<- lapply(input_gene_list, function(x) gene_counter(x))
result<- t(as.data.frame(output_list))
result
[,1]
gene1 0.1052632
gene2 0.1052632
gene3 0.1052632
Also share your thoughts on it! Thanks!

break each range (row) into two sub-ranges

I have an input like this:
120-160
200-220
400-500
.
.
.
I would link to break each range (row) into two sub-ranges:
120-140 141-160
200-210 211-220
400-450 451-500
.
.
.
and then print each column (range) into different files.
file 1:
120-140
200-210
400-450
.
.
.
file 2:
141-160
211-220
451-500
.
.
.
I could not do anything and no clue how to do it.
Thank you very much
You can use bash:
while IFS=- read min max; do
mid=$(( (min+max)/2 ))
printf "%d-%d\n" $min $mid >> file.1
printf "%d-%d\n" $((mid+1)) $max >> file.2
done < input.file
The awk would be
awk -F- -v OFS=- '{
mid = int(($1+$2)/2)
print $1, mid > "file.1"
print mid+1, $2 > "file.2"
}' input.file
Perl solution. Save as break-range.pl, run as perl break-range.pl input.
#!/usr/bin/perl
use warnings;
use strict;
open my $F1, '>', 'file1' or die $!;
open my $F2, '>', 'file2' or die $!;
while (<>) {
chomp;
if (my ($low, $high) = /([0-9]+)-([0-9]+)/) {
my $middle = int(($low + $high) / 2);
print $F1 "$low-$middle\n";
print $F2 $middle + 1, "-$high\n";
}
}
close $F1;
close $F2;
For non-fixed number of output files, you can use something like the following, run it as break-rangle.pl number-of-files input. Note that it probably does not work if the number of files is greater than the size of an interval.
#!/usr/bin/perl
use warnings;
use strict;
my $number = shift;
my #FH;
for my $i (0 .. $number - 1) {
open $FH[$i], '>', "file$i" or die $!;
}
while (<>) {
chomp;
if (my ($low, $high) = /([0-9]+)-([0-9]+)/) {
my $step = ($high - $low) / $number;
for my $i (0 .. $number - 1) {
print {$FH[$i]} int($low + $i * $step) + ($i > 0), '-',
int($low + ($i + 1) * $step), "\n";
}
}
}
close $_ for #FH;
Here is an R solution: Assuming you have imported the data into a vector input,
input <- c("120-160", "200-220", "400-500")
ranges <- strsplit(input, "-")
ranges <- lapply(ranges, as.numeric)
ranges <- lapply(ranges, function(x) c(x[1], mean(x), x[2]))
output1 <- sapply(ranges, function(x) sprintf("%d-%d", x[1], x[2]))
output2 <- sapply(ranges, function(x) sprintf("%d-%d", x[2]+1, x[3]))
You can then use writeLines to write the two files.

PowerShell Math Problem?

function other3($x, $y)
{
$tmp = $x + $y
return $tmp
}
$x = 5
$y = 10
$a = other3($x, $y)
Write-Host $a
Keeps returning 5 10 when it should be returning 15, what's the deal?
To call other3 with two parameters, drop the parenthesis "()" e.g.
$a = other3 $x $y
The way you're currently calling it, actually passes one parameter, an array with two elements, i.e. 5 and 10. The second parameter is empty (probably defaults to null), meaning the addition does nothing and you simply return the $x parameter.
You're passing a list (5,10) to the parameter $x and $null to $y.
When the function adds $null to the list, you just get the list back.
Adding some write-host statements to the function should make this clear:
function other3($x, $y)
{
$tmp = $x + $y
write-host "`x=($x)"
write-host "`y=($y)"
return $tmp
}
$x = 5
$y = 10
$a = other3($x, $y)
Write-Host $a

How does one iterate over a sequence in xquery by twos?

I want to iterate over a sequence in xquery and grab 2 elements at a time. What is the easiest way to do this?
XQuery 3.0 Solution
For this and more complex paging use cases the Window Clause has been created in XQuery 3.0. But, it is not yet supported by many XQuery processors.
Windowing example
Here is a working example that you could execute for example on try.zorba :
for tumbling window $pair in (2, 4, 6, 8, 10, 12, 14)
start at $s when fn:true()
end at $e when $e - $s eq 1
return <window>{ $pair }</window>
Result
<window>2 4</window><window>6 8</window><window>10 12</window><window>14</window>
One option is to iterate over all items and just take the items once the items reach the divisor, in this case 2. The one downside is that you won't reach the last group of items if the items aren't even multiples of the divisor. For instance, the last element of a sequence with an odd number of elements will not be returned with this approach.
for $item at $index in $items
return
if ($item mod 2 = 0) then
($items[$index - 1], $items[$index])
else
()
Another option is to use mod and the index of the item. Using this approach you can make certain to include all elements in the $items sequence by adding one less than the number of items in your group to the count.
let $group-size := 2
return
for $index in (1 to fn:count($items)+($group-size - 1))[. mod $group-size = 0]
return
($items[$index - 1] , $items[$index])
let $s := ("a","b","c","d","e","f")
for $i in 1 to xs:integer(count($s) div 2)
return
<pair>
{($s[$i*2 - 1],$s[$i*2])}
</pair>
returns
<pair>a b</pair>
<pair>c d</pair>
<pair>e f</pair>
for $item at $index in $items
return
(
if ($index mod 2 eq 0) then
(
$items[xs:integer(xs:integer($index) - 1)], $items[xs:integer($index)]
)
else
()
)

Resources