GDPR ( Global Data Protection Rights )
5 direct replies — Read more / Contribute

by trippledubs
on May 17, 2018 at 01:33


Polymaths,
What do you think of General_Data_Protection_Regulation? I'm interested to know if your companies are behind it or minimally complying, more interested to know if you think individuals ought to have the rights expressed in that law and if there is really a moral obligation on site owners to comply. Or, if it should be scrapped or changed.
The right of erasure specifically contradicts PM policy which is defended with the same argument that Wikipedia uses, the "Memory hole" argument. If one user decides to revoke the site owners permission to use their nodes, that creates a hole in the link of the chain, and every user is negatively affected. That is a pretty utilitarian view point. It smells slightly self serving to me to hear that argument from sites whose success directly rides on user generated content.
It really only benefits future users, because if you were there, you don't need a tattoo of the conversation to remember it later. I don't see that a site owner, especially if it's not the hoster ie back in time machines, gets a perpetual license after you leave. Recipe sites  let's say you participate for years honing the craft and eventually decide to write a cookbook, you don't ever have the right to revoke your recipes down off the boards and make the world pay for your stuff? But your dishes have probably benefited from all that recipe sharing, so it seems you would owe something too.
I can't help but think of the social contract put forth in Crito. You have a good idea of what you are getting into when you participate online, seems reasonable that the site architects who built your playground would be able to dictate the terms, but I don't see how they have the right to continue to do so once you leave.
I googled: Social contract, copyright law, landlord tenant, looked up about 10 web sites that were closing down or blocking EU Customer, but I can't make up my mind. There seems to be a lot of data players operating in the shadows without consent that should be addressed, but I can't see how it affects my life at all. I see an ad about something I almost bought on Amazon, big deal.
Well surely we do not live in a perfect world, but does the GDPR move the decimal point either direction? Or just adding more compliance factories to the world? And who are the people who wrote the bill that made me get all this TOS spam. I tried to find the authors' names and I could not. Maybe this is a stepping stone to better "digital rights"?

RFC: Is the Bible encoded in DNA?
12 direct replies — Read more / Contribute

by wstryder
on May 14, 2018 at 07:31


I have for a time entertained the idea, that if God is the creator, he would have left his signature in the DNA of human species. If I was the creator, I would have encoded the entire Hebrew Bible in DNA, so to let no one doubt that DNA was created by God and that the Bible is the word of God.
I finally took up the challenge and wrote a perl script to check if the first five verses of Bible are encoded in DNA. Naturally there is an infinite number of ways to encode information in DNA, but I assumed that God would have used something quite obvious in order for us to be able to find information encoded in DNA. I’m assuming that if the Bible is encoded in DNA, the encoding used would be the same as for protein synthesis, namely that triplets of DNA base pairs would encode for one character. There are 64 possible codons so there is plenty of redundancy when they are used for encoding 22 hebrew alphabets (plus sofit forms for five characters).
Like so:
AAA > Y
AAC > XXX
AAG > B
AAT > XXX
ACA > A
ACC > M
ACG > XXX
ACT > XXX
AGA > R
AGC > R
AGG > W
AGT > W
ATA > H
ATC > XXX
ATG > A
ATT > H
CAA > XXX
CAC > XXX
CAG > I
CAT > XXX
CCA > XXX
CCC > XXX
CCG > XXX
CCT > V
CGA > XXX
CGC > XXX
CGG > O
CGT > XXX
CTA > XXX
CTC > E
CTG > V
CTT > H
GAA > H
GAC > I
GAG > XXX
GAT > T
GCA > XXX
GCC > B
GCG > XXX
GCT > H
GGA > V
GGC > H
GGG > Y
GGT > A
GTA > Y
GTC > V
GTG > A
GTT > I
TAA > E
TAC > XXX
TAG > XXX
TAT > O
TCA > A
TCC > Y
TCG > XXX
TCT > XXX
TGA > R
TGC > H
TGG > A
TGT > XXX
TTA > XXX
TTC > L
TTG > B
TTT > A
My dirty little perl script reads a FASTA file one character at a time and when a triplet is read, it check to see if that codon is already defined. If it is not, the first character of the target sequence is added to a hash containing all the codons. The algorithm then moves to the next triplet in DNA and check to see if that triplet is defined and so on. When a triplet is already defined and the character stored does not equal the target sequence, the script records the maximum length of the sequence found and goes back to the beginning of DNA and moves forward one base pair to continue the search.
I’m not a computer science expert and I’m sure that my script is dirty and messy, but it does work. It takes 33h to search one target sequence against the 3 billion base pairs of human DNA. The FASTA files are in chunks of roughly 150 million base pairs, so several files need to be checked by hand, but this is not much of a problem. My computer crashes when I try to load more than 10million base pairs at a time, so the script reads each FASTA file in chunks of 5 million base pairs at a time.
I could not get hebrew characters to work properly, so I simply translitterated the first five chapters of Genesis to ASCII characters. This is a dirty way of going about it, but it works.
Aleph A
Bet B
Gimmel G
Dalet D
Hey H
Vav V
Zayin Z
Chet C
Tet T
Yod Y
Kaf K G
Lamed L
Mem M O
Nun N J
Samekh S
Ayin X
Pey P
Tsadi U W
Kuf Q
Resh R
Shin E
Tav I
Gen 1:15
BRAEYI BRA ALHYO AI HEMYO VAT HARW VHARW HYIH IHV VBHV VCEG XL PNY IHV
+O VRVC ALHYO MRCPI AL PNY HMYO VYAMR ALHYO YHY AVR VYHY AVR VYRA ALHY
+O AI HAVR KY TVB VYBDL ALHYO BYJ HAVR VBYJ HCEG VYQRA ALHYO LAVR YVO
+VLCEG QRA LYLH VYHY XRB BYHY BQR YVO ACD
For control sequences I used Lorem ipsum, War and Peace and a random string. For the control sequences I checked the first one million base pairs only.
The results so far:
Lorem ipsum 42 characters found (250 million searched)
War and peace 35 characters found (one million searched)
Random string 35 characters found (one million searched)
Having checked the hebrew Bible against so far 500 million base pairs, the maximum sequence found was 45 characters. This is more than the control sequences, but only because much more base pairs were compared. To be sure that the sequence was encoded in DNA by God, I would expect to find a sequence of hundreds of characters, preferably all the first five verses of Genesis. I’m not a mathematician, so I have not calculated what the maximum sequence length would be if left to chance alone. But the control sequences do give some estimate.
I’m of course assuming that God used the hebrew Bible, because some say hebrew is the holy language, but I’ve also checked the King James English for the first verses of Matthew and John. If God is omnipotent, surely he could have encoded the Bible in DNA in any language. In the future I’ll check if New Testament passeges are encoded in Greek, but thus far I’m working with the assumption that the most awesome thing for God to do would have been to encode the biginning of Genesis. Will post results when I find anything.
Let me know what you think of my efforts, I know this is nuts.
My code can be downloaded at kristitty.net/blog/findingbibleversesindna/

PDL QuickRef
1 direct reply — Read more / Contribute

by mxb
on May 14, 2018 at 05:41


Edit: Just noticed that PDL 2.019 has been released, this was written against 2.018. There shouldn't be many (if any) changes, but I'll update this comment accordingly once I've checked it over.
Edit2: longlong range fixed.
As there was significant interest in the porting of numpy to PDL documentation, I've been continuing to document my explorations with PDL.
The following document is my own personal PDL 'QuickRef', which I've created as both a reference to myself and as a summary of PDL
I've tidied it up and now I'm posting it here for others, should they find it useful. Hopefully, it's both useful to new users of PDL (exploring along with perldl shell) and as a reference for experienced users.
Hopefully I've put this in the correct place, but mods feel free to move it if this is the wrong section.
I will continue to update the 100 PDL Exercises offline and will post an updated version incorporating all feedback soon.
PDL QuickRef
Arguably, this is just a rehashing of the existing documentation available via the modules in the PDL::* namespace. However, I found it useful when learning PDL to have everything in a single place.
PDL Creation
Creation of Vectors
The pdl function creates piddles from implicit and explicit scalars and variables. It accepts an optional first argument, $type, which specifies the internal data type of the piddle.
PDL Datatypes
All piddles store matrices of data in the same data type. PDL supports the following datatypes:
Datatype 
Internal 'C' type 
Valid values 

byte 
unsigned char 
Integer values from 0 to +255 
short 
short 
Integer values from 32,768 to +32,767 
ushort 
unsigned short 
Integer values from 0 to +65,535 
long 
int 
Integer values from 2,147,483,648 to +2,147,483,647 
longlong 
long 
Integer values from –9,223,372,036,854,775,808 to +9,223,372,036,854,775,807 
float 
float 
Real values from 1.2E38 to +3.4E+38 with 6 decimal places of precision 
double 
double 
Real values from 2.3E308 to +1.7E+308 with 15 decimal places of precision 
pdl Examples
Row vector from explicit values: 
$v = pdl($type, [1,2]); 
Column vector from explicit values: 
$v = pdl($type, [[1],[2]]); or $v = pdl($type, [1,2])>(*1); 
Row vector from scalar string: 
$v = pdl($type, "1 2 3 4"); 
Row vector from array of numbers: 
$v = pdl($type, @a); 
Matrix from explicit values: 
$M = pdl($type, [[1,2],[3,4]]); 
Matrix from a scalar: 
$M = pdl($type, "[1 2] [3 4]"); 
Piddle Helper Creation Functions
In the following functions, where arguments are marked as ..., accept arguments in the following form:
 $type  an optional data type (see above)
 $x,$y,$z,...  A list of n dimensions for the resulting piddle, OR
 $M  Another piddle, from which the dimensions will be reused
Sequential integers, starting at zero: 
$M = sequence(...); 
Sequential Fibonacci values, starting at one: 
$M = fibonacci(...); 
Of all zeros: 
$M = zeros(...); 
Of all ones: 
$M = ones(...); 
Of random values between zero and one: 
$M = random(...); 
Of Gaussian random values between zero and one: 
$M = grandom(...); 
Where each value is it's zerobased index along the first dimension: 
$M = xvals(...); 
Where each value is it's zerobased index along the second dimension: 
$M = yvals(...); 
Where each value is it's zerobased index along the third dimension: 
$M = zvals(...); 
Where each value is it's zerobased index along dimension $d: 
$M = axisvals(..., $d); 
Where each value is it's distance from a specified centre: 
$M = rvals(..., {Centre=>[x,y,z,...]); 
The following functions create piddles with dimensions taken from another piddle, $M and distribute values between two endpoints ($min and $max) inclusively:
Linearly distributed values along the first dimension: 
$N = $M>xlinvals($min, $max); 
Linearly distributed values along the second dimension: 
$N = $M>ylinvals($min, $max); 
Linearly distributed values along the third dimension: 
$N = $M>zlinvals($min, $max); 
Logarithmically distributed values along the first dimension: 
$N = $M>xlogvals($min, $max); 
Logarithmically distributed values along the second dimension: 
$N = $M>ylogvals($min, $max); 
Logarithmically distributed values along the third dimension: 
$N = $M>zlogvals($min, $max); 
Coordinate Piddles
Finally the ndcoords utility function creates a piddle of coordinates for the supplied arguments. It may be called in two ways:
 $coords = ndcoords($M);  Take dimensions from another piddle
 $coords = ndcoords(@dims);  Take dimensions from a Perl list
Piddle Conversion
A piddle can be converted into a different type using the datatype names as a method upon the piddle. This returns the converted piddle as a new piddle. The inplace method does not work with these conversion methods.
Operation 
Operator 

Convert to byte datatype: 
$M>byte; or byte $M; 
Convert to short datatype: 
$M>short; or short $M; 
Convert to ushort datatype: 
$M>ushort; or ushort $M; 
Convert to long datatype: 
$M>long; or long $M; 
Convert to longlong datatype: 
$M>longlong; or longlong $M; 
Convert to float datatype: 
$M>float; or float $M; 
Convert to double datatype: 
$M>double; or double $M; 
Obtaining Piddle Information
PDL provides a number of functions to obtain information about piddles:
Description 
Code 

Return the number of elements: 
$M>nelem; 
Return the number of dimensions: 
$M>ndims; 
Return the length of dimension $d: 
$M>dim($d); 
Return the length of all dimensions as a Perl list: 
$M>dims; 
Return the length of all dimensions as a piddle: 
$M>shape; 
Return the datatype of a piddle: 
$M>type; 
Return general information about a piddle (datatype, dimensions): 
$M>info; 
Return the memory used by a piddle: 
$M>info("%M"); 
Indexing, Slicing and Views
Points To Note
PDL internally stores matrices in column major format. This affects the indexing of piddle elements.
For example, take the following matrix $M:
[
[0 1 2]
[3 4 5]
[6 7 8]
]
In standard mathematical notation, the element at M_{i,j} will be i elements down and j elements across, with the elements 0 and 3 at M_{1,1} and M_{2,1} respectively.
With PDL indexing, indexes start at zero, and the first two dimensions are 'swapped'. Therefore, the elements 0 and 3 are at PDL indices (0,0) and (0,1) respectively.
Views are References
PDL attempts to do as little work as possible in that it will try to avoid memory copying of piddle values when it can. The most common operations where this is the case is when taking piddle slices or views across a piddle matrix. The piddles returned by these functions are views upon the original data, rather than copies, so modifications to them will affect the original matrix.
Slicing
A common operation is to view only a subset of a piddle. This is called slicing.
As slicing is such a common operation, there is a module to implement a shorter syntax for the slice method. This module is PDL::NiceSlice. This document only uses this syntax.
A rectangular slice of a piddle is returned via using the default method on a piddle. This takes up to n arguments, where n is the number of dimensions in the piddle.
Each argument must be one of the following forms:
"" 
An empty value returns the entire dimension. 
n 
Return the value at index n into the dimension, keeping the dimension of size one. 
(n) 
Return the value at index n into the dimension, eliminating the entire dimension. 
n:m 
Return the range of values from index n to index m inclusive in the dimension. Negative indexes are indexed from the end of the dimension, where 1 is the last element. 
n:m:s 
Return the range of values from index n to index m with step s inclusive in the dimension. Negative indexes are indexed from the end of the dimension, where 1 is the last element. 
*n 
Insert a dummy dimension of size n. 
The following examples operate on the matrix $M:
[
[0 1 2]
[3 4 5]
[6 7 8]
]
Description 
Command 
Result 

Return the first column as a 1x3 matrix: 
$M>(0,); 
[ [0][3][6] ] 
Return the first row as a 3x1 matrix: 
$M>(,0); 
[ [0 1 2] ] 
Return the first row as a 3 element vector: 
$M>(,(0)); 
[0 1 2] 
Return the first and second column as a 2x3 matrix: 
$M>(0:1); 
[ [0 1] [3 4] [6 7] ] 
Return the first and third row as a 3x2 matrix: 
$M>(,0:1:2); 
[ [0 1 2] [6 7 8] ] 
Dicing
Occasionally it is required to extract noncontiguous regions along a dimension. This is called dicing. The dice method accepts an array of indices for each dimension, which do not have to be contiguous.
The following examples operate on the matrix $M:
[
[0 1 2]
[3 4 5]
[6 7 8]
]
Description 
Command 
Result 

Return the first and third column as a 2x3 matrix: 
$M>dice([0,2]); 
[ [0 2] [3 5] [6 8] ] 
Return the first and third column and the first and third row as a 2x2 matrix: 
$M>dice([0,2],[0,2]); 
[ [0 2] [6 8] ] 
Which and Where Clauses
The other common operation to perform over a piddle is to apply a boolean operation over the entire piddle elementwise. This is achieved in PDL with the where method.
The where method accepts a single argument of a boolean operation. The element is referred to within this argument with the same variable name as the piddle. The values in the returned piddle are references to the values in the initial piddle.
In a similar mannor to which clauses outlined above, there is the where method. The difference between these two methods is that which returns the values, while where returns the indices.
This is best explained with examples over a matrix $M:
Description 
Return values 
Return indices 

Obtain all positive values: 
$M>where($M > 0); 
which($M > 0); 
Obtain all values equal to three: 
$M>where($M == 3); 
which($M == 3); 
Obtain all values which are not zero: 
$M>where($M != 0); 
which($M != 0); 
Note that there is also the which_both function. This function returns an array of two piddles. The first is a list of indices for which the boolean operation was true, the second for which the result was false.
Again, as where clauses as so common PDL::NiceSlice has syntatic support for it through the default method. This is acheived through an argument modifier, which is appended to the single argument.
The modifiers are seperated from the original argument via a ; character, and the following modifiers are supported:
Modifier 
Description 

? 
The argument is no longer a slice, but rather a where clause 
_ 
flatten the piddle to one dimension prior to the operation 
 
squeeze the piddle by flattening any dimensions of length one. 
 
sever the returned piddle into a copy, rather than a reference 
Using this syntax, the following where commands are identical:
$M>where($M > 3);
$M>($M > 3;?);
View Modification
PDL contains many functions to modify the view of a piddle. These are outlined below:
Description 
Code 

Transpose a matrix/vector: 
$M>transpose; 
Return the multidimensional diagonal over the supplied dimensions: 
$M>diagonal(@dims); 
Remove any dimensions of length one: 
$M>squeeze; 
Flatten to one dimension: 
$M>flat; 
Merge the first $n dimensions into one: 
$M>clump($n); 
Merge a list of dimensions into one: 
$M>clump(@dims); 
Exchange the position of zeroindexed dimensions $i and $j: 
$M>xchg($i, $j); 
Move the position of zeroindexed dimension $d to index $i: 
$M>mv($d, $i); 
Reorder the index of all dimensions: 
$M>reorder(@dims); 
Concatenate piddles of the same dimensions into a single piddle of rank n+1: 
cat($M, $N, ...); 
Split a single piddle into an array of piddles across the last dimension: 
($M, $N, ...) = dog($P); 
Rotate elements with wrap across the first dimension: 
$M>rotate($n); 
Given a vector $v return a matrix, where each column is of length $len, with step $step over the entire vector: 
$M>lags($dim, $step, $len); 
Normalise a vector to unit length: 
$M>norm; 
Destructively reshape a matrix to n dimensions, where n is the number of arguments and each argument is the length of each dimension. Any additional values are discarded and any missing values are set to zero: 
$M>resize(@dims); 
Append piddle $N to piddle $M across the first dimension: 
$M>append($N); 
Append piddle $N to piddle $M across the dimension with index $dim: 
$M>glue($dim, $N); 
Matrix Multiplication
PDL supports four main matrix multiplication methods between two piddles of compatible dimensions. These are:
Operation 
Code 

Dot product: 
$M x $N; 
Inner product: 
$M>inner($N); 
Outer product: 
$M>outer($N); 
Cross product: 
$M>crossp($N); 
As the x operator is overloaded to be the dot product, it can also be used to multiply vectors, matrices and scalars.
Operation 
Code 

Row x matrix = row 
$r x $M; 
Matrix x column = column 
$M x $c; 
Matrix x scalar = matrix 
$M x 3; 
Row x column = scalar 
$r x $c; 
Column x row = matrix 
$c x $r; 
Arithmetic Operations
PDL supports a number of arithmetic operations, both elementwise, over an entire matrix and along the first dimension. Double precision variants are prefixed with d.
Operation 
Elementwise 
Over entire PDL 
Over 1st Dimention 

Addition: 
$M + $N; 
$M>sum;; $M>dsum; 
$M>sumover;; $M>dsumover; 
Subtraction: 
$M  $N; 


Product: 
$M * $N; 
$M>prod;; $M>dprod; 
$M>prodover;; $M>dprodover; 
Division: 
$M / $N; 


Modulo: 
$M % $N; 


Raise to the power: 
$M ** $N; 


Cumulative Addition: 


$M>cumusumover;; $M>dcumusumover; 
Cumulative Product: 


$M>cumuprodover;; $M>dcumuprodover; 
Comparison Operations:
PDL supports a number of different elementwise comparison functions between matrices of the same shape.
Operation 
Elementwise 

Equal to: 
$M == $N; 
Not equal to: 
$M != $N; 
Greater than: 
$M > $N; 
Greater than or equal to: 
$M >= $N; 
Less than: 
$M < $N; 
Less than or equal to: 
$M <= $N; 
Compare (spaceship): 
$M <=> $N; 
Binary Operations
PDL also allows binary operations to occur over piddles. PDL will convert any real number datatype piddles (float, double) to an integer before performing the operation.
Operation 
Elementwise 
Over entire PDL 
Over 1st Dimention 

Binary and: 
$M & $N; 
$M>band; 
$M>bandover; 
Binary or: 
$M  $N; 
$M>bor; 
$M>borover; 
Binary xor: 
$M ^ $N; 


Binary not: 
~ $M; or $M>bitnot; 


Bit shift left: 
$M << $N; 


Bit shift right: 
$M >> $N; 


Logical and: 

$M>and; 
$M>andover; 
Logical or: 

$M>or; 
$M>orover; 
Logical not: 
! $M; or $M>not; 


Trigonometric Functions
These PDL functions operate in units of radians elementwise over a piddle.
Operation 
Elementwise 

Sine: 
$M>sin; 
Cosine: 
$M>cos; 
Tangent: 
$M>tan; 
Arcsine: 
$M>asin; 
Arccosine: 
$M>acos; 
Arctangent: 
$M>atan; 
Hyperbolic sine: 
$M>sinh; 
Hyperbolic cosine: 
$M>cosh; 
Hyperbolic tangent: 
$M>tanh; 
Hyperbolic arcsine: 
$M>asinh; 
Hyperbolic arccosine: 
$M>acosh; 
Hyperbolic arctangent: 
$M>atanh; 
Statistical Functions
PDL contains many methods to obtain statistics from piddles. Double precision variants are prefixed with d.
Operation 
Over entire PDL 
Over 1st Dimention 

Minimum value: 
$M>min; 
$M>minover; 
Maximum value: 
$M>max; 
$M>maxover; 
Minimum and maximum value: 
$M>minmax; 
$M>minmaxover; 
Minimum value (as indicies): 

$M>minover_ind;; $M>minover_n_ind; 
Maximum value (as indicies): 

$M>maxover_ind;; $M>maxover_n_ind; 
Mean: 
$M>avg;; $M>davg; 
$M>avgover;; $M>davgover; 
Median: 
$M>median;; $M>oddmedian; 
$M>medover;; $M>oddmedover; 
Mode: 
$M>mode; 
$M>modeover; 
Percentile: 
$M>pct;; $M>oddpct; 
$M>pctover;; $M>oddpctover; 
Elementwise error function: 
$M>erf; 
Elementwise complement of the error function: 
$M>erfc; 
Elemntwise inverse of the error function: 
$M>erfi; 
Calculate histogram of $data, with specified $minimum bin value, bin $step size and $count bins: 
histogram($data, $step, $min, $count); 
Calculate weighted histogram of $data with weights $weights, specified $minimum bin value, bin $step size and $count bins: 
whistogram($data, $weights, $step, $min, $count); 
Various statistics: 
$M>stats; 
$M>statsover; 
The 'various statistics' described above are returned as a Perl array of the following items:
 mean
 population RMS deviation from the mean
 median
 minimum
 maximum
 average absolute deviation
 RMS deviation from the mean
Zero Detection, Sorting, Unique Element Extraction
Operation 
Over entire PDL 
Over 1st Dimention 

Any zero values: 
$M>zcheck; 
$M>zcover; 
Any nonzero values: 
$M>any; 

All nonzero values: 
$M>all; 

Sort (returning values): 
$M>qsort; 
$M>qsortvec; 
Sort (returning indices): 
$M>qsorti; 
$M>qsortveci; 
Unique elements: 
$M>uniq; 
$M>uniqvec; 
Unique elements (returning indices): 
$M>uniqind; 

Rounding and Clipping of Values
PDL contains multiple methods to round and clip values. These all opererate elementwise over a piddle.
Operation 
Elementwise 

Round down to the nearest integer: 
$M>floor; 
Round up to the nearest integer: 
$M>ceil; 
'Round half to even' to the nearest integer: 
$M>rint; 
Clamp values to a maximum of $max: 
$M>hclip($max); 
Clamp values to a minimum of $min: 
$M>lclip($min); 
Clamp values between a minimum and maximum: 
$M>clip($min, $max); 
Set Operations
PDL contains methods to treat piddles as sets of values. Mathematically, a set cannot contain the same value twice, but if this happens to be the case with the piddles, PDL takes care of this for you.
Operation 
Code 

Obtain a mask piddle for values from $N contained within $M: 
$M>in($N); 
Obtain the values of the intersection of the sets $M and $N: 
setops($M, 'AND', $N); or intersect($M, $N); 
Obtain the values of the union of the sets $M and $N: 
setops($M, 'OR', $N); 
Obtain the values which are in sets $M or $N, but not both (union  intersection): 
setops($M, 'XOR', $N); 
Kernel Convolusion
PDL supports kernel convolution across multiple dimensions:
Description 
Code 

1dimensional convolution of matrix $M with kernel $K across first dimension (edges wrap around): 
$M>conv1d($K); 
1dimensional convolution of matrix $M with kernel $K across first dimension (edges reflect): 
$M>conv1d($K, {Boundary => 'reflect'); 
2dimensional convolution of matrix $M with kernel $K (edges wrap around): 
$M>conv2d($K); 
2dimensional convolution of matrix $M with kernel $K (edges reflect): 
$M>conv2d($K, {Boundary => 'reflect'); 
2dimensional convolution of matrix $M with kernel $K (edges truncate): 
$M>conv2d($K, {Boundary => 'truncate'); 
2dimensional convolution of matrix $M with kernel $K (edges repeat): 
$M>conv2d($K, {Boundary => 'replicate'); 
Miscellaneous Mathematical Methods
Here is all the other stuff which doesn't fit anywhere else:
Description 
Code 

Elementwise square root: 
$M>sqrt; 
Elementwise absolute value: 
$M>abs; 
Elementwise natural exponential: 
$M>exp; 
Elementwise natural logarithm: 
$M>log; 
Elementwise base 10 logarithm: 
$M>log10; 
Elementwise raise to the power $i: 
ipow($M, $i); 

Is it still worth learning Perl as a first language?
5 direct replies — Read more / Contribute

by tm2383
on May 03, 2018 at 20:45


I'm curious to know if Perl Monks believe that Perl is still worth learning as a primary programming language. I've used it in the past for some bioinformatics programming and really like the language. I'm interested in a change of career and wonder if it is worth the time investment really learning Perl in depth with the aim of becoming a Perl developer some time in the future. I know that there are a lot of 'trendier' programming languages out there like Python, PHP and Ruby. My logic behind learning Perl is that there are fewer people learning it compared to other languages. I assume that the market is awash with programmers using these other languages and that there might be a niche for perl programmer. Does anyone here work as a professional Perl programmer, either as an employee or a freelancer? Is there a future in Perl programming, or is a lot of the work migrating Perl to another platform? Are any start ups still using Perl frameworks like Catalyst?

RFC: 100 PDL Exercises (ported from numpy)
8 direct replies — Read more / Contribute

by mxb
on May 03, 2018 at 05:05


I've been trying to slowly learn PDL over the last few months. While I'm aware of some available documentation (the PDL::* perldoc, The PDL Book, etc.) I've found the beginner documentation to be lacking. Therefore, I thought it would be a good idea to start 'porting' some numpy documentation to PDL for new users such as myself.
I've started with 100 numpy exercises, and this is the work in progress port to Perl/PDL.
As I'm still learning PDL, some solutions may be less than optimal, while others do not currently have solutions as they are outside my of level of competency. Therefore, I'm posting this WIP to PM to ask for comments and contributions.
As with most of Perl, there is more than one way to do it for most of these. I've decided to keep the $var>function() syntax as much as possible to easily be able to chain operations.
Thanks in advance!
100 PDL Exercises
 1. Load the PDL library:

use PDL;
 2. Print the PDL version:

use PDL::Version;
print $PDL::Version::VERSION;
 3. Create a null vector of size 10:

my $z = zeros(10);
print $z;
 4. How to find the memory size of any matrix?

use PDL::Core ':Internal'
my $z = zeros(10);
my $size = howbig($z>get_datatype) * $z>nelem;
print $size;
 5. How to get the documentation of the numpy add function from the command line?

# To get top level PDL help
perldoc PDL
 6. Create a null vector of size 10 and set the fifth value to 1:

my $z = zeros(10);
$z>slice(4) .= 1;
print $z;
or with PDL::NiceSlice loaded:
my $z = zeros(10);
$z(4) .= 1;
print $z;
Note: It will be assumed that PDL::NiceSlice will be loaded from now on.
 7. Create a vector with values ranging from 10 to 49:

my $z = 10 + sequence(40);
print $z;
 8. Reverse a vector (first element becomes last)

my $z = sequence(10);
$z = $z(1:0);
print $z;
 9. Create a 3x3 matrix with values from 0 to 8:

my $z = sequence(3,3);
print $z;
 10. Find indices of nonzero elements in the vector [1,2,0,0,4,0]:

my $vec = pdl [1,2,0,0,4,0];
my $nz = $vec>which;
print $nz;
 11. Create a 3x3 identity matrix:

my $z = identity(3);
print $z;
 12. Create a 3x3x3 matrix of random values:

my $z = random(3,3,3);
print $z;
 13. Create a 10x10 matrix of random values and find the minimum and maximum values:

my $z = random(10,10);
print $z>min, $z>max;
 14. Create a random vector of size 30 and find the mean value:

my $z = random(30);
print $z>avg;
 15. Create a 2D matrix with 1 on the border and 0 inside:

my $z = ones(10,10);
$z(1:8,1:8) .= 0;
print $z;
 16. How to add a border (filled with 0's) around an existing matrix?

my $a = random(8,8);
my $x = zeros(2 + $a>dim(0), 2 + $a>dim(1));
$x(1:8,1:8) .= $a;
print $x;
 17. What is the result of the following expression?

n/a
 18. Create a 5x5 matrix with values 1,2,3,4 just below the diagonal:

my $z = identity(5) * (1 + sequence(5));
$z>where($z > 4) .= 0;
$z = $z>transpose>rotate(1)>transpose;
print $z;
 19. Create a 8x8 matrix and fill it with a checkerboard pattern:

my $z = zeros(8,8);
$z("0::2","0::2") .= 1
$z("1::2","1::2") .= 1
print $z;
 20. Consider a (6,7,8) shape matrix, what is the index (x,y,z) of the 100th element?

my $z = random(6,7,8);
my $hundreth = $z>clump($z>ndims)>(100);
# TODO: find index of $hundreth in $z
 21. Create a checkerboard 8x8 matrix using the tile function:

n/a
 22. Normalize a 5x5 random matrix:

my $z = random(5,5);
$z = (($z  $z>min) / ($z>max  $z>min));
print $z;
 23. Create a custom dtype that describes a color as four unsigned bytes (RGBA):

n/a
 24. Multiply a 5x3 matrix by a 3x2 matrix (real matrix product):

my $x = ones(3,5);
my $y = ones(2,3);
print $x x $y;
 25. Given a 1D matrix, negate all elements which are between 3 and 8, in place.

my $z = sequence(10);
$z>where($z <= 8 & $z>= 3) *= 1;
print $z;
 26. What is the output of the following script?

n/a
 27. Consider an integer vector Z, which of these expressions are legal?

my $z = sequence(long, 10);
$z ** $z;
2 << $z >> 2;
$z < $z;
1j * $z;
$z / 1 / 1;
$z < $z > $z;
 28. What are the result of the following expressions?

print pdl(0) / pdl(0);
print pdl(0) // pdl(0);
print float int pdl(NaN);
 29. How to round away from zero a float matrix?

$z = 20 * random(10)  10;
$z>where($z < 0) .=  $z>where($z < 0)>abs>ceil;
$z>where($z > 0) .= $z>where($z > 0)>ceil;
print $z;
 30. How to find common values between two matrix?

my $z1 = long 256 * random(10);
my $z2 = long 256 * random(10);
print intersect $z1, $z2;
 31. How to ignore all numpy warnings (not recommended)?

n/a for PDL
 32. Is the following expressions true?

n/a
 33. How to get the dates of yesterday, today and tomorrow?

# No built in PDL time/date functions
my $yesterday = time()  (60 * 60 * 24);
my $today = time();
my $tomorrow = time() + (60 * 60 * 24);
 34. How to get all the dates corresponding to the month of July 2016?

n/a
 35. How to compute ((A+B)*(A/2)) in place?

my $a = ones(3);
my $b = 2 * ones(3);
my $c = 3 * ones(3);
print ($a + $b) * ( $a/2)
 36. Extract the integer part of a random matrix using 5 different methods:

my $z = 10 * random(10);
print $z>ceil;
print $z>floor;
print byte $z;
print long $z;
print longlong $z;
 37. Create a 5x5 matrix with row values ranging from 0 to 4:

my $z = xvals zeros(5,5);
print $z;
 38. Consider a generator function that generates 10 integers and use it to build an matrix:

n/a
 39. Create a vector of size 10 with values ranging from 0 to 1, both excluded:

my $z = (sequence(12) / 11)>slice("1:10");
print $z;
 40. Create a random vector of size 10 and sort it:

my $z = random(10)>qsort;
print $z;
 41. How to sum a small matrix faster than np.sum?

n/a
 42. Consider two random matrices A and B, check if they are equal:

my $a = random(10);
my $b = random(10);
print $a == $b;
 43. Make an array immutable (readonly):

n/a
 44. Consider a random 10x2 matrix representing cartesian coordinates, convert them to polar coordinates:

use PDL::Complex;
my $z = random(2,10);
my $p = Cr2p($z);
print $p;
 45. Create random vector of size 10 and replace the maximum value by 0:

my $z = random(10);
$z>where($z == $z>max) .= 0;
print $z;
 46. Create a structured array with x and y coordinates covering the [0,1]x[0,1] area.

n/a
 47. Given two arrays, X and Y, construct the Cauchy matrix C (Cij =1/(xi  yj)):

TODO
 48. Print the minimum and maximum representable value for each data type:

# This cannot be done directly, but you can extract the underlying
# C type used for each PDL type:
print byte>realctype;
print short>realctype;
print ushort>realctype;
print long>realctype;
print longlong>realctype;
print indx>realctype;
print float>realctype;
print double>realctype;
 49. How to print all the values of an array?

# Set maximum print limit to one million elements
$PDL::toolongtoprint = 1_000_000;
$z = zeros(1000,1000);
print $z;
 50. Find the nearest value from a given value in an array:

TODO
 51. Create a structured array representing a position (x,y) and a color (r,g,b):

n/a
 52. Consider a random vector with shape (100,2) representing coordinates, find point by point distances:

my $z = random(10,2);
my ($x,$y) = ($z(:,0), $z(:,1));
my $d = (($x  $x>transpose)>ipow(2)) +
(($y  $y>transpose)>ipow(2));
print $d;
 53. How to convert a float (32 bits) array into an integer (32 bits) in place?

my $z = float 1000 * random(10);
$z = long $z;
 54. Consider the following file:

1,2,3,4,5
6,,,7,8
,,9,10,11
How to read it?
my $z = rcols "data.csv", { COLSEP => ',' }, [];
$z = $z>transpose; # optional (PDL is column major)
print $z;
 55. What is the equivalent of enumerate for numpy arrays?

n/a
 56. Generate a generic 2D Gaussianlike array:

my $z = grandom(10,10); # correct?
print $z;
 57. How to randomly place p elements in a 2D array?

my $p = 3;
my $z = zeros(10,10);
my $i = indx $z>nelem * random($p)
$z>clump($z>ndims)>($i) .= 1;
print $z;
 58. Subtract the mean of each row of a matrix:

my $z = random(5, 10);
$z = $z  $z>avgover>transpose;
print $z;
 59. How to I sort an array by the nth column?

TODO
 60. How to tell if a given 2D array has null columns?

TODO
 61. Find the nearest value from a given value in an array:

TODO
 62. Considering two arrays with shape (1,3) and (3,1), how to compute their sum using an iterator?

n/a
 63. Create an array class that has a name attribute:

n/a
 64. Consider a given vector, how to add 1 to each element indexed by a second vector (be careful with repeated indices)?

TODO
 65. How to accumulate elements of a vector (X) to an array (F) based on an index list (I)?

TODO
 66. Considering a (w,h,3) image of (dtype=ubyte), compute the number of unique colors:

my ($w, $h) = (16, 16);
my $i = byte 256 * random($w, $h, 3);
my $uniqcol = $i>uniq>nelem;
print $uniqcol;
 67. Considering a four dimensions array, how to get sum over the last two axis at once?

TODO
 68. Considering a onedimensional vector D, how to compute means of subsets of D using a vector S of same size describing subset indices?

TODO
 69. How to get the diagonal of a dot product?

my $z1 = random(10, 10);
my $z2 = random(10, 10);
print $z1>inner($z2);
 70. Consider the vector [1, 2, 3, 4, 5], how to build a new vector with 3 consecutive zeros interleaved between each value ?

my $z = pdl [1,2,3,4,5];
my $nz = 3;
my $x = zeros($z>dim(0) * $nz);
$x("0::$nz") .= $z;
print $x;
 71. Consider an array of dimension (5,5,3), how to multiply it by an array with dimensions (5,5)?

my $z1 = ones(5,5,3);
my $z2 = 2 * ones(5,5);
print $z1 * $z2;
 72. How to swap two rows of an array?

my $z = sequence(5,5);
$z(0:1,) .= $z(1:0,)>sever;
print $z;
 73. Consider a set of 10 triplets describing 10 triangles (with shared vertices), find the set of unique line segments composing all the triangles:

TODO
 74. Given an array C that is a bincount, how to produce an array A such that np.bincount(A) == C?

TODO
 75. How to compute averages using a sliding window over an array?

TODO
 76. Consider a onedimensional array Z, build a twodimensional array whose first row is (Z[0],Z[1],Z[2]) and each subsequent row is shifted by 1 (last row should be (Z[3],Z[2],Z[1])

TODO
 77. How to negate a boolean, or to change the sign of a float inplace?

my $z = long 2 * random(10);
$z = not $z;
print $z;
$z = 5 + sequence(10);
$z = 1 * $z;
print $z;
 78. Consider 2 sets of points P0,P1 describing lines (2d) and a point p, how to compute distance from p to each line i (P0[i],P1[i])?

TODO
 79. Consider 2 sets of points P0,P1 describing lines (2d) and a set of points P, how to compute distance from each point j (P[j]) to each line i (P0[i],P1[i])?

TODO
 80. Consider an arbitrary array, write a function that extract a subpart with a fixed shape and centered on a given element (pad with a fill value when necessary):

TODO
 81. Consider an array Z = [1,2,3,4,5,6,7,8,9,10,11,12,13,14], how to generate an array R = [[1,2,3,4], [2,3,4,5], [3,4,5,6], ..., [11,12,13,14]]:

$z = 10 * random(15);
$len = 4;
my @r = ();
push @r, $z($_:$_ + $len1) for (0 .. $z>nelem  $len)
$r = pdl @r;
print $r;
 82. Compute a matrix rank:

my $z = 10 * random(10,10);
my ($u, $s, $v) = $z>svd;
my $rank = $s>where($s > 1e10);
print $rank;
 83. How to find the most frequent value in an array?

TODO
 84. Extract all the contiguous 3x3 blocks from a random 10x10 matrix:

my $z = long 5 * random(10,10);
my $dim = 3;
my (@out, $out);
for my $i ( 0 .. $z>dim(0)  $dim  1) {
for my $j ( 0 .. $z>dim(1)  $dim  1) {
push @out, $z($i:$i+$dim,$j:$j+$dim);
}
}
$out = pdl @out;
print $out;
 85. Create a 2D array subclass such that Z[i,j] == Z[j,i]:

TODO
 86. Consider a set of p matrices wich shape (n,n) and a set of p vectors with shape (n,1). How to compute the sum of of the p matrix products at once? (result has shape (n,1))

TODO
 87. Consider a 16x16 array, how to get the blocksum (block size is 4x4)?

TODO
 88. How to implement the Game of Life using PDL arrays?

TODO
 89. How to get the n largest values of an array:

my $z = 10 * random(20);
my $n = 3;
print $z>qsort>($n:);
 90. Given an arbitrary number of vectors, build the cartesian product (every combinations of every item)

TODO
 91. How to create a record array from a regular array?

n/a?
 92. Consider a large vector Z, compute Z to the power of 3 using 3 different methods:

my $z = random(5e7);
$z ** 3;
$z>ipow(3);
$z>power(3,0);
 93. Consider two arrays A and B of shape (8,3) and (2,2). How to find rows of A that contain elements of each row of B regardless of the order of the elements in B?

TODO
 94. Considering a 10x3 matrix, extract rows with unequal values (e.g. [2,2,3]):

TODO
 95. Convert a vector of ints into a matrix binary representation:

my $z = pdl [0,1,2,3,15,16,32,64,128];
my $bits = ($z>transpose & (2 ** xvals(9)));
$bits>where($bits > 0) .= 1;
print $bits;
 96. Given a two dimensional array, how to extract unique rows?

my $z = long 2 * random(3,6);
print $z>uniqvec;
 97. Considering 2 vectors A & B, write the einsum equivalent of inner, outer, sum, and mul function:

TODO
 98. Considering a path described by two vectors (X,Y), how to sample it using equidistant samples:

TODO
 99. Given an integer n and a 2D array X, select from X the rows which can be interpreted as draws from a multinomial distribution with n degrees, i.e., the rows which only contain integers and which sum to n:

TODO
 100. Compute bootstrapped 95% confidence intervals for the mean of a 1D array X (i.e., resample the elements of an array with replacement N times, compute the mean of each sample, and then compute percentiles over the means):

TODO
edit: link to PDL for those who do not know what it is

Curious about Perl's strengths in 2018
13 direct replies — Read more / Contribute

by Crosis
on Apr 12, 2018 at 02:57


First of all, forgive me if this isn't quite the right place. I am a new user and am not entirely sure about the rubric for this area of the site, though I'm pretty sure this is the right place.
About a decade ago, when I was in my late teens and early twenties, I was very proficient in and eager to use Perl. Though it was a little idiosyncratic, it was certainly much less tedious to get things done in than C, which I had used earlier. Gradually I drifted away towards Python and now I use it for most things. I've since forgotten virtually everything I knew about Perl. I know that Python will still be obviously superior for, for example, most aspects of scientific computing (possibly excepting bioinformatics?) and machine learning, but where does Perl really shine these days? That goes equally for the more conventional Perl 5 as well as the newer Perl 6. Also, what are hot items on CPAN these days?

RFC: perl sub diff between two files
4 direct replies — Read more / Contribute

by bliako
on Mar 26, 2018 at 08:24


Fellow Monks,
Recently, I was in need to compare two versions of the same perl module containing many subs. I was interested to see the difference between the contents of subs with the same name. This happened because I forked the same code in two different machines and made changes in the modules in both machines.
For this purpose I wrote the following basic script which I place here for public use but also for comments from the monastic community.
The simple script makes use of two excellent modules, namely PPI and Text::WordDiff. PPI parses perl code and is capable of extracting subs and their contents. Text::WordDiff outlines (and colorcodes) the differences between two blocks of text (the contents of identicallynamed subs in two files).
Unix's diff is a fine tool in general, but code has a few idiosyngracies which make diffing sometimes impractical. For example when samecontent subs have different order in their respective files.
That said, I wanted a quick tool to check my two versions of the perl module, find enhancements in either file I made and produce a final version.
Here is the script:
#!/usr/bin/env perl
use strict;
use warnings;
use PPI;
use Text::WordDiff;
if( scalar(@ARGV) != 2 ){ print usage($0) . "\n"; exit(0); }
my ($infile1, $infile2) = @ARGV;
my $doc = PPI::Document>new($infile1);
if( ! defined($doc) ){ print STDERR "$0 : call to ".'PPI::Document>ne
+w()'." has failed for input file '$infile2'.\n"; exit(1); }
my (%subs1, %subs2, $asub);
for $asub ( @{ $doc>find('PPI::Statement::Sub')  [] } ) {
# loop over all subs in file
unless ( $asub>forward ) {
# store sub's contents in hash keyed on sub's name
$subs1{ $asub>name } = $asub>content;
}
}
$doc = PPI::Document>new($infile2);
if( ! defined($doc) ){ print STDERR "$0 : call to ".'PPI::Document>ne
+w()'." has failed for input file '$infile2'.\n"; exit(1); }
for $asub ( @{ $doc>find('PPI::Statement::Sub')  [] } ) {
# loop over all subs in file
unless ( $asub>forward ) {
# store sub's contents in hash keyed on sub's name
$subs2{ $asub>name } = $asub>content;
}
}
my ($k, $v1, $v2, $res, $anitem);
my @dont_exist = ();
my %allkeys = map { $_ => 1 } (keys %subs1, keys %subs2);
foreach $k (sort keys %allkeys){
if( ! defined($v1=$subs1{$k}) ){
push(@dont_exist, "$k : Does not exist in '$infile1'\n");
next
} elsif( ! defined($v2=$subs2{$k}) ){
push(@dont_exist, "$k : Does not exist in '$infile2'\n");
next
}
# sub (same name) exists in both files, diff sub's contents in fil
+es:
$res = Text::WordDiff::word_diff(
\$v1,
\$v2,
);
# print diff results
print
" begin '$k' \n"
. $res
. "\n end '$k' \n"
;
}
# and also print the subs which exist in one file but not the other fi
+le
print join("", @dont_exist);
exit(0);
sub usage {
return "Usage : ".$_[0]." file1 file2\nColor output guide:\n\tRED
+: file1\n\tGREEN: file2\n"
}
bliako

Termux for all your Perlneeds on Android
4 direct replies — Read more / Contribute

by morgon
on Mar 25, 2018 at 19:29


Hi,
I don't know how well known this is (it's probably quite old new for you) but recently I had the problem of wanting to run a Perlscript on a nonrooted Androidtablet and came across the fabulous Termuxproject.
Installing this app gives you a terminalenvironment and with a simple
pkg install perl
you get a working 5.26.1 perl. Now add
pkg install make
pgk install clang
and voila you have a fully functional cpanclient that allows you to install even xsmodules.
Really nice...

Converting everything (MySql, perl, CGI, website) to UTF8
1 direct reply — Read more / Contribute

by jfrm
on Mar 16, 2018 at 04:01


In order to deal with Japanese orders, I recently had to convert my whole system to UTF8. A day or 2's job I thought. 2.5 weeks later, I'm finally there. There is a lot of stuff on Perlmonks and the internet in general about this but it is hard to understand and even harder to implement. Most of the advice I read was along the lines of RTFM or did not give the whole story. It's pretty clear this is a common problem, too. I wanted to give something back to the community as perlmonks has helped me a lot, so I thought I would share some insights that I hope will be practical and useful.
There is a lot out there telling you to used decode/encode and giving lectures on internal representation of UTF8 in Perl and wotnot. In the end I've only had to use decode in one place where data is coming in from elsewhere. If you get all the other stuff right, I believe you shouldn't need any or many instances of decode/encode.
Our system involves a local website using MySQL, a live website, static webpages, generated webpages, various text files and CGI website forms. All of this needs work to make it work. Here are the things that I needed to do:
Checklist of changes to make
* Firstly, every script file is converted to UTF8 format. Easy.
* Every script to have this at the top: use utf8;
This tells perl that the script itself is in UTF format. So a £ in the script will be interpreted as a UTF8 £. It's no good just putting this in the calling script as it only seems to extend for the scope of the script underneath; not any other scripts that are imported with require...
* Ideally each database table must be turned to UTF8 format. This turns out to be difficult and timeconsuming because any tables with foreign keys won't convert unless you first delete the foreign keys. For those that won't easily convert, you can convert only the fields that might hold UTF8 encoded characters to UTF8 format. Also BLOB fields are a problem unless the whole table is UTF8. I had to convert problem BLOB fields to TEXT fields and then convert them to UTF8 format (a 2 step process, doing both in 1 step fails).
* Rose::DB (or whatever database method you are using) needs to be told that incoming data from the Database is in UTF8. For Rose:DB, add this to the connector in DB.pm and then regenerate connect_options => {mysql_enable_utf8 => 1}
* binmode(STDOUT, ":utf8"); # Put this at the top of a script  tells it to output UTF to stdout. Not sure if this is just needed only once in the opening script or in any requires, too?
* Webpages must have this in the head section:
<meta httpequiv="contenttype" content="text/html; charset=UTF8">
* use CGI qw(utf8); to treat incoming CGI parameters as UTF8. Getting this working was subtle  test carefully.
* When outputting a CGI webpage, the first thing to do is to output the http header and this needs to be told about UTF8 too:
Personally I found that print header(type=>'text/html', cookie=>'', charset=>'utf8'); gave problems with cookies so ended up outputting it direct:
print "Contenttype: text/html; charset=utf8\n$cookie\n\n";
* use open ':encoding(utf8)'; # tells it to deal with all files in a UTF8 way. In fact, I was more careful with this and did not use it in general. Instead, I have specifically opened each file that needed it with open($fh, '<:encoding(UTF8)', $filename);. Because some files that I have to deal with have not been given to me in UTF8 format. Careful  this can fail if the $filename variable is not also in UTF8!
Identifying Errors
In doing this, you will make mistakes and see weird characters appearing in unexpected places. I developed my own personal understanding of how to deal with them. These are my own notes for practical situations so please bear with me, if the explanations are not exactly correct  it was about fixing stuff not being a perl rocket scientist.
 You see £ displayed as 'Â£'
 If £ sign is coming from dbase and is stored correctly in dbase and webpage is correctly displaying UTF8 characters from elsewhere (e.g. write japanese text into the perl script and print it), then the UTF8 is not being retrieved from the database as UTF8 (presumably being assumed to be Latin1).
 The £ is within a UTF8 encoded PERL script but use utf8; is not set at the top of the script.
 The £ is displayed correctly in a form initially but when the form is saved/updated, the £ then displays as 'Â£'. Use the utf8 CGI pragma to treat incoming parameters as UTF8: use CGI ('utf8');
 £ is displayed on a webpage as ï¿½
 This happens when the http header Content Type is not UTF8 and the meta tag is similarly <meta httpequiv="ContentType" content="text/html" />
 £ or other characters are being displayed as a diamond with ? inside it
 StackOverflow:...usually the sign of an invalid (nonUTF8) character showing up in an output (like a page) that has been declared to be UTF8. Can be fixed by putting the following at the top of script: binmode(STDOUT, ":utf8");
 Error message: Wide character in print
 Means a print statement (to STDOUT or a file) that is outputting Latin1 includes a UTF8 character... To fix, add '>:encoding (UTF8) to the open statement or #binmode(STDOUT, ":utf8");

RFC: Placeholder creation for SQL statements
5 direct replies — Read more / Contribute

by LanX
on Mar 08, 2018 at 18:33


#prepare
my $sth = $dbh>prepare('SELECT * FROM people WHERE lastname = ? AND f
+irstname = ?');
#execute with list of bindvars
$sth>execute( $lastname, $firstname );
But it's a bit cumbersome to adjust the bind values if the order changes.
It's even more work if you have to use an array of values like inside an IN ( ?, ?, ?) operation.
I started to hack something to autogenerate placeholders, for a string passed inside a codeblock:
 $scalars from the closure are replaced with a placeholder ?
 @arrays are replaced with a list of comma separated placeholders ?,?,?
 underscored _var_names are ignored ( placeholders can't be everywhere)
The second returned parameter is a list of varrefs in the correct order, such that the bind variables can be safely changed.
Parsing the output of B::Deparse is even more fragile than I thought, the next version will walk the OPTree directly. (For instance parsing multiline SQL doesn't work yet.)
I'm not yet sure how to combine this in the best way with DBI.
This is a one days job in the sense of "release often".
Comments?
update
Hmmm ... I can probably avoid the hassle of parsing the OPtree by tying the variables ...
use strict;
use warnings;
use B::Deparse;
use PadWalker qw/closed_over peek_sub set_closed_over/;
use Data::Dump qw/pp/;
# ========= Tests
use Test::More;
# lexicals for placeholders
my $a = 'A';
my @list = qw/L I S T/;
my $x = 'X';
# no placeholders for underscore vars
my @_table = "any_table";
my $sql = sub { "SELECT * FROM @_table WHERE a = $a AND b IN (@list) A
+ND c = $x" };
my @stm = holderplace($sql);
is_deeply( \@stm,
[
"SELECT * FROM any_table WHERE a = ? AND b IN (?, ?, ?, ?
+) AND c = ?",
[\"A", ["L", "I", "S", "T"], \"X"]
],
"statement with placeholders plus bind variables"
);
# change bind variables
$a = 'AA';
@list = qw/LL II SS TT/;
$x = 'XX';
is_deeply( \@stm,
[
"SELECT * FROM any_table WHERE a = ? AND b IN (?, ?, ?, ?
+) AND c = ?",
[\"AA", ["LL", "II", "SS", "TT"], \"XX"]
],
"statement with placeholders plus changed variables"
);
done_testing();
# ========== Code
sub holderplace {
my ($lambda)=@_;
my $h_vars = closed_over($lambda);
my %new_vars;
my @value_refs;
for my $key ( keys %$h_vars) {
my $sigil = substr $key,0,1;
# exclude variables starting with _
next if $key =~ m/^\Q${sigil}\E_/;
if ( '$' eq $sigil ) {
$new_vars{$key} = \'?';
} elsif ( '@' eq $sigil ) {
$new_vars{$key} = [ join ", ", ("?") x @{$h_vars>{$key} } ];
} else {
next; # Error?
}
}
# Create Statement with placeholders
set_closed_over( $lambda, \%new_vars );
my $newstr = $lambda>();
# Variable refs in order of placeholders
my @var_refs =
map { $h_vars>{$_} }
grep { $new_vars{$_} }
@{ get_vars($lambda) };
return ("$newstr", \@var_refs );
}
sub get_vars {
# scans output of B::Deparse to get interpolated vars in order
my ($lambda)=@_;
# deparse sub body
my $source = B::Deparse>new('q')>coderef2text($lambda);
# returns something like:
# {
# use warnings;
# use strict;
# 'SELECT * FROM ' . join($", @_table) . ' WHERE x = ' . $a . ' AN
+D b IN (' . join($", @list) . ') ' . $x;
# }
# truncate {block} and use statements
$source =~ s/^{\s*(use.*?;\s*)*//s;
$source =~ s/;\s*}$//s;
#warn $source;
my %quotes = qw"[ ] ( ) < > { } / /";
$quotes{'#'}='#';
# single quotes like q(...)
my $re_q = join "", map { "q\\$_.*?\\$quotes{$_}" } keys %quotes;
#warn pp
my @parts = split /\s* (?: '(?:\\'[^'])*?'  $re_q )\s*/msx, $so
+urce;
for my $part (@parts) {
next unless $part =~ /^\..*\.?$/;
if ( $part =~ /^\. join\(.*? (\@\w+)\)( \.)?$/) {
$part = $1; # array
}
elsif ( $part =~ /^\. (\$\w+)( \.)?$/) {
$part = $1; # scalar
}
}
return \@parts;
}
Cheers Rolf
_{(addicted to the Perl Programming Language and ☆☆☆☆ :)
Wikisyntax for the Monastery
}

challenge: Perl's art restauration
2 direct replies — Read more / Contribute

by Discipulus
on Mar 06, 2018 at 06:17


Dear monks,
I post this under meditation because this is not really a question by me, even if some question mark is in the text.
Art needs restauration and restauration needs keen eyes and gentle hands. We have here at the monastery precious and invaluable masterpieces ruining as the time passes.
The most incredible things I ever seen in Perl is 3D Stereogram, Self replicating source. by the genial monk Toodles but unfortunately it just run on perl 5.8 (or as someone said in 5.10).
Is some monk able to spot why this happens?
Is someone able to make this masterpiece run as expected on modern perl versions? Infact it doesnt fail on 5.26 but doesnt produce the stereogram effect: only sparse lines.
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

PERL postgresql yaml poker and thank you
2 direct replies — Read more / Contribute

by ShermW0829
on Feb 27, 2018 at 18:53


Thank you to all who helped me get this started. Even though my name is on it that just means that I borrowed most of it from others. You will see your suggested way of doing things throughout this post.
I will describe how I created the postgresql database. Any and all comments are welcome.
I did not use these tables but I am strongly considering them.
CREATE TABLE seven_stud_spread_stakes(bring_in int, fourth_street int
+check(fourth_street >= bring_in), fifth_street int check(fifth_street
+ >= bring_in), sixth_street int check(sixth_street >= bring_in), seve
+nth_street int check(seventh_street >= bring_in));
CREATE TABLE colorado_limit_stakes(small_blind int, big_blind int chec
+k(big_blind >= small_blind), preflop int check(preflop <= 100), flop
+int check(flop <= 100), turn int check(turn <= 100), river int check(
+river >= big_blind));
CREATE TABLE spread_limit_stakes(small_blind int, big_blind int check(
+big_blind >= small_blind), preflop int check(preflop >= small_blind),
+ flop int check(flop >= small_blind), turn int check(turn >= small_bl
+ind), river int check(river >= small_blind));
CREATE TABLE seven_stud_stakes(bring_in int, fourth_street int check(f
+ourth_street >= bring_in), fifth_street int check(fifth_street >= fou
+rth_street), sixth_street int check(sixth_street >= fifth_street), se
+venth_street int check(seventh_street >= sixth_street));
CREATE TABLE stakes(small_blind int, big_blind int check(big_blind >=
+small_blind), preflop int check(preflop >= big_blind), flop int check
+(flop >= preflop), turn int check(turn >= flop), river int check(rive
+r >= turn));
INSERT INTO stakes VALUES(1, 3, 3, 3, 6, 9);
I am using the following tables. Note that I am using v_limits since limit is a reserved word in postgresql.
CREATE TABLE v_limits(v_limit TEXT PRIMARY KEY);
CREATE TABLE states(abbreviation TEXT PRIMARY KEY, state TEXT);
CREATE TABLE cities(city TEXT PRIMARY KEY);
CREATE TABLE games(game TEXT PRIMARY KEY);
CREATE TABLE hi_lows(hi_lo TEXT PRIMARY KEY);
CREATE TABLE kills(kill TEXT PRIMAY KEY);
CREATE TABLE stakes(stake TEXT PRIMARY KEY);
CREATE TABLE venues(venue TEXT PRIMAY KEY);
CREATE TABLE visits(id INT PRIMARY KEY, arrival_date DATE, departure_d
+ate DATE, arrival_time TIME, departure_time TIME, venue TEXT REFERENC
+ES venues(venue), city TEXT REFERENCES cities(city), state TEXT REFER
+ENCES states(abbreviation), game TEXT REFERENCES games(game), stake T
+EXT REFERENCES stakes(stake), kill TEXT REFERENCES kills(kill), hi_lo
+ TEXT REFERENCES hi_lows(hi_lo), v_limit REFERENCES v_limits(v_limit)
+, buy_in MONEY, cash_out MONEY);
This is the visit_configuration.yaml file I am using.
arrival_date: 20180214
departure_date: 20180215
arrival_time: 1000
departure_time: 1800
venue: "Binion's"
city: "Las Vegas"
state: "NV"
game: "hold'em"
stake: "48"
kill: "nokill"
hi_lo: "hi"
limit: "fixed"
buy_in: 200
cash_out: 400
Next I will post the perl file I am using.

RFC: system calls on Unicode filesystem
3 direct replies — Read more / Contribute

by daxim
on Feb 27, 2018 at 07:37


I'm about to email the pumpking for an intervention as a personal favour. Because I'm convinced that a halfarsed solution is better than no solution, it's due past time that the over 20 year old embarrassment gets fixed:
› ver
Microsoft Windows [Version 10.0.16299.125]
› chcp 65001
Aktive Codepage: 65001.
› type αω.bat
@echo hiαω
› node p "require('child_process').execSync('αω.bat').toString()"
hiαω
› perl6 e "run 'αω.bat'"
hiαω
› php r "system('αω.bat');"
hiαω
› python c "import subprocess; subprocess.call('αω.bat')"
hiαω
› ruby e "system 'αω.bat'"
hiαω
› perl Mutf8 e "system 'αω.bat'"
Der Befehl "a?.bat" ist entweder falsch geschrieben oder
konnte nicht gefunden werden.
› perl Mutf8 MWin32::Unicode::Process=systemW e "systemW('αω.bat')"
Der Befehl "a?.bat" ist entweder falsch geschrieben oder
konnte nicht gefunden werden.
Plan of attack: use 5.028 enables use feature 'justmakeitworkalreadydammit', which checks $^O eq 'MSWin32' and then replaces all the broken chdir, mkdir, open, opendir, rename, rmdir, system, unlink, utime, X stat etc. with the working equivalent code from Win32::Unicode and also somehow on e, not just with code executed from files.
Now tell me why this is a stupid idea, but keep in mind that
 if all the other languages can hack it, then so can we, no matter how shitty and insufficient you think the initial patch is
 the better is the enemy of the good and a "better" solution did not turn up for decades
 if I simply file a perlbug it just gets marked by p5p as a duplicate of a discussion whose proposed "better" solution did not turn up for decades

Revitalising your own old posts
7 direct replies — Read more / Contribute

by stevieb
on Feb 21, 2018 at 19:32


Periodically, I'll go through my posts via the normal mechanism and sort by lowesthighestthisthatother, and sometimes, like today, I have found one that I'd like to reply to.
Now, this post has a (relatively) high XP count, and the responses have 1525% higher than that.
I want to reply to a poster on such thread legitimately (orig post count was ~45, replies were 60+), but I don't want it realized that I'm doing it in order to get exposure on the overall hierarchical post.
How do Monks handle these situations? Shatter humility or what?
stevieb
ps. I have been accused of raising posts for XP+ before, but those who raised that are irrelevant to me.

Sum to 100 at Rosetta Code
3 direct replies — Read more / Contribute

by choroba
on Feb 17, 2018 at 12:52


After a long time, I checked the list of tasks not implemented in Perl on RosettaCode. One of them was "Sum to 100", kind of similar to mjd's Simple but difficult arithmetic puzzle:
In the string 123456789, you can prepend + or  before any digit to form an expression. You should
 list all the possible expressions that evaluate to 100
 show the number that is a result of the maximal number of expressions
 show the lowest positive number that can't be expressed
 show the ten highest numbers that can be expressed
Here's my solution:
I tried to avoid eval to evaluate the expressions, at the same time, I didn't want to implement the traditional full math expression parser as there were only two operations of the same precedence in use.
$sum += $_ for $expression =~ /([+]?[09]+)/g;
Feel free to comment on perlishness, effectiveness, golfness, or beauty of the solution, or propose your own.
Note: Those interested in Perl 6 can read the solution just below mine.
($q=q:Sq=~/;[c](.)(.)/;chr(5+lengthSq)`"SoS2"`map{chr +ord
}map{substrSq`S_+`}3E`7**23:)=~y+S`+$1,++print+eval$q,q,a,

