I try to convert the following C function to Perl:
uint32_t xorshift32 (uint32_t x32)
{
x32 ^= x32 << 13;
x32 ^= x32 >> 17;
x32 ^= x32 << 5;
return x32;
}
I came up with the following:
sub xorshift32
{
my $r = '';
vec ($r, 0, 32) = int($_[0]);
vec ($r, 0, 32) ^= vec ($r, 0, 32) << 13;
vec ($r, 0, 32) ^= vec ($r, 0, 32) >> 17;
vec ($r, 0, 32) ^= vec ($r, 0, 32) << 5;
return vec ($r, 0, 32);
}
Is this the canonical way to force 32 bit overflows in Perl or is there a better and faster way to do it?
I am also not sure if the code is correct. Will the result of the shift operations be a float on 32 bit systems?
Just add & 0xFFFF_FFFF where needed.
sub xorshift32 {
my ($x32) = #_;
$x32 ^= ($x32 << 13) & 0xFFFF_FFFF;
$x32 ^= $x32 >> 17;
$x32 ^= ($x32 << 5) & 0xFFFF_FFFF;
return $x32;
}
I don't always know my canon, but I like the 0xFFFF_FFFF bitmask for cases like this.
sub xorshift32 {
my $x32 = shift;
$x32 ^= $x32 << 13;
$x32 ^= (($x32 & 0xFFFF_FFFF) >> 17);
0xFFFF_FFFF & ($x32 ^ ($x32 << 5));
}
(haven't benchmarked this, don't know how it compares to vec)
And to answer your second question, no, the result of a << bit shift operation will never be a float whether it is a 32-bit or 64-bit system, even if either operand is a float.
Related
I want to print address of stack.
void StackOfIntegers::printPop() {
int* p;
p = &(elements[size-1]);
cout << p;
}
cout << "Stack2 :value, adress" << endl;
while (!stack2.empty()) {
cout << " " << stack2.peek() << " ";
stack2.printPop();
stack2.pop();
cout << "\n";
}
When I printed out the address in this code, I expected that the value of the address would gradually increase.
However, on the contrary, the address value is increasingly small.
What is the problem?
I would like to implement the following C program in Perl:
#include <stdio.h>
#include <stdint.h>
uint32_t xorshift32 ()
{
static uint32_t y = 2463534242;
y ^= y << 13;
y ^= y >> 17;
y ^= y << 5;
return y;
}
int main (int argc, char *argv[])
{
int n = 10;
while (n-- > 0)
printf ("%u\n", xorshift32());
}
The output is:
723471715
2497366906
2064144800
2008045182
3532304609
374114282
1350636274
691148861
746858951
2653896249
This is my unsuccessful attempt:
{
package Xorshift;
use strict;
use warnings;
use integer;
sub new
{
my $class = shift;
bless { y => 2463534242 } => $class
}
sub rand ()
{
my $y = $_[0]->{y};
$y ^= $y << 13;
$y ^= $y >> 17;
$y ^= $y << 5;
$_[0]->{y} = $y;
return $y;
}
}
my $xor = Xorshift->new;
my $n = 10;
while ($n-- > 0) {
print $xor->rand(), "\n";
}
The output is this:
660888219700579
3396719463693796860
-1120433007023638100
2588568168682748299
1469630995924843144
-8422345229424035168
1449080611344244726
-4722527344582589597
8061824971057606814
-3113862584906767882
The problems:
Perl uses 64 bit arithmetic.
The integers are signed.
How to do 32 bit unsigned arithmetic instead?
If you want to simulate the result of 32-bit ops, you can simply apply a mask:
{
package Xorshift;
use strict;
use warnings;
use integer;
sub new
{
my $class = shift;
bless { y => 2463534242 } => $class
}
sub to32{
return ($_[0] & 0xFFFFFFFF);
}
sub rand ()
{
my $y = $_[0]->{y};
$y ^= to32($y << 13);
$y ^= to32($y >> 17);
$y ^= to32($y << 5);
$_[0]->{y} = $y;
return $y;
}
}
my $xor = Xorshift->new;
my $n = 10;
while ($n-- > 0) {
print $xor->rand(), "\n";
}
#include <iostream>
using namespace std;
void asknumber(int,int,int,int,int,int,int);
void getClassnumbers();
int main() {
getClassnumbers();
asknumber();
system("pause");
return 0;
}
void asknumber(int &tests, int &projects, int &labs, int &attendance,
int &max_test, int &max_projects, int &max_labs, int &max_attendance) {
int min = 0;
getClassnumbers();
cout << "Enter a number between 0 and " << max_test << ":";
cin >> tests;
while (tests > max_test || tests < min) {
cout << "Invalid input. Enter a number between 0 and " << max_test <<
":";
cin >> tests;
}
cout << "Enter a number between 0 and " << max_projects << ":";
cin >> projects;
while (projects > max_projects || projects < min) {
cout << "Invalid input. Enter a number between 0 and " << max_projects
<< ":";
cin >> projects;
}
cout << "Enter a number between 0 and " << max_labs << ":";
cin >> labs;
while (labs > max_labs || labs < min) {
cout << "Invalid input. Enter a number between 0 and " << max_labs <<
":";
cin >> labs;
}
cout << "Enter a number between 0 and " << max_attendance << ":";
cin >> attendance;
while (attendance> max_attendance || attendance < min) {
cout << "Invalid input. Enter a number between 0 and " << max_attendance << ":";
cin >> attendance;
}
}
void getClassnumbers() {
int tests; int projects; int labs; int attendance;
const int max_test = 4; const int max_projects = 5; const int max_labs = 7; const int max_attendance = 50;
cout << "Enter number of tests: ";
cin >> tests;
cout << "Enter number of projects: ";
cin >> projects;
cout << "Enter number of labs: ";
cin >> labs;
cout << "Enter number of attendance days: ";
cin >> attendance;
}
I was wondering how to properly use pass by reference for me to use the cin values entered in the function getClassnumbers() to be used in the while loops in the function asknumber() in order to compare them with the maximum values declared in getClassnumbers()?
I am attempting to add non-interlaced GIF images other than 8-bit to a PDF document without having to fully decode the bitstream using PDF::Create for Perl.
The LZWDecode algorithm that is part of the PDF standard requires all images to have a minimum LZW code size of 8-bits, and PDF::Create is hard-coded to only embed 8-bit images.
So far, I have adapted the image loader from PDF::Create to read a 5-bit image and to fully decode the LZW stream. I am then able to use the encoder algorithm from PDF::Create to re-pack the image as 8-bit.
What I'd like to do is to eliminate the memory-intensive decode/encode step. This thread suggests that this is possible by "widening or shifting bits" to make LZW codes the proper length for LZWDecode.
I contacted the thread author and he provided some additional details, in particular that codes for color indices remain the same but are padded with zeros (e.g., [10000] becomes [000010000]), that <Clear> and <End> codes are changed to <256> and <257> respectively, and that all other codes are offset by 256 - original <Clear> code.
However, he was unable to elaborate further due to restrictions by his employer. In particular, I am uncertain how to handle a code when its modified value exceeds <4095> (the maximum index for the LZW code table). I am also unsure how to re-pack the revised codes into a bitstream.
The algorithms I am currently using are below.
# Read 5-bit data stream
sub ReadData5 {
my $data = shift;
my $c_size = 6; # minimium LZW code size
my $t_size = 33; # initial code table size
my ($i_buff,$i_bits) = (0,0); # input buffer
my ($o_buff,$o_bits) = (0,0); # output buffer
my $stream = ''; # bitstream
my $pos = 0;
SUB_BLOCK: while (1){
my $s = substr($data, $pos++, 1);
# get sub-block size
my $n_bytes = unpack('C', $s) or last SUB_BLOCK;
my $c_mask = (1 << $c_size) - 1;
BYTES: while (1){
# read c_size bits
while ($i_bits < $c_size){
# end of sub-block
!$n_bytes-- and next SUB_BLOCK;
$s = substr($data, $pos++, 1);
my $c = unpack('C', $s);
$i_buff |= $c << $i_bits;
$i_bits += 8;
}
# write c_size bits
my $code = $i_buff & $c_mask;
my $w_bits = $c_size;
$i_buff >>= $c_size;
$i_bits -= $c_size;
$t_size++;
if ($o_bits > 0){
$o_buff |= $code >> ($c_size - 8 + $o_bits);
$w_bits -= 8 - $o_bits;
$stream .= pack('C', $o_buff & 0xFF);
}
if ($w_bits >= 8){
$w_bits -= 8;
$stream .= pack('C', ($code >> $w_bits) & 0xFF);
}
if (($o_bits = $w_bits) > 0){
$o_buff = $code << (8 - $o_bits);
}
# clear code
if ($code == 32){
$c_size = 6;
$t_size = 33;
$c_mask = (1 << $c_size) - 1;
}
# end code
if ($code == 33){
$stream .= pack('C', $o_buff & 0xFF);
last SUB_BLOCK;
}
if ($t_size == (1 << $c_size)){
if (++$c_size > 12){
$c_size--;
} else {
$c_mask = (1 << $c_size) - 1;
}
}
}
}
# Pad with zeros to byte boundary
$stream .= '0' x (8 - length($stream) % 8);
return $stream;
}
#---------------------------------------------------------------------------
# Decode 5-bit data stream
sub UnLZW5 {
my $data = shift;
my $c_size = 6; # minimium LZW code size
my $t_size = 33; # initial code table size
my ($i_buff,$i_bits) = (0,0); # input buffer
my $stream = ''; # bitstream
my $pos = 0;
# initialize code table
my #table = map { chr($_) } 0..$t_size-2;
$table[32] = '';
my $prefix = '';
my $suffix = '';
# get first code word
while ($i_bits < $c_size){
my $d = unpack('C', substr($data, $pos++, 1));
$i_buff = ($i_buff << 8) + $d;
$i_bits += 8;
}
my $c2 = $i_buff >> ($i_bits - $c_size);
$i_bits -= $c_size;
my $c_mask = (1 << $i_bits) - 1;
$i_buff &= $c_mask;
# get remaining code words
DECOMPRESS: while ($pos < length($data)){
my $c1 = $c2;
while ($i_bits < $c_size){
my $d = unpack('C', substr($data, $pos++, 1));
$i_buff = ($i_buff << 8) + $d;
$i_bits += 8;
}
$c2 = $i_buff >> ($i_bits - $c_size);
$i_bits -= $c_size;
$c_mask = (1 << $i_bits) - 1;
$i_buff &= $c_mask;
# clear code
if ($c2 == 32){
$stream .= $table[$c1];
$#table = 32;
$c_size = 6;
$t_size = 33;
next DECOMPRESS;
}
# end code
if ($c2 == 33){
$stream .= $table[$c1];
last DECOMPRESS;
}
# get prefix and suffix
$prefix = $table[$c1] if $c1 < $t_size;
$suffix = $c2 < $t_size ? substr($table[$c2], 0, 1) : substr($prefix, 0, 1);
# write prefix
$stream .= $prefix;
# write multiple-character sequence
$table[$t_size++] = $prefix . $suffix;
# increase code size
if ($t_size == 2 ** $c_size){
if (++$c_size > 12){
$c_size--;
}
}
}
return $stream;
}
Doing one at a time is slow. Doing them all at once takes too much memory for you. Do them a chunk at a time.
my $BUFFER_SIZE = 5 * 50_000; # Must be a multiple of 5.
my $in_bytes = ...;
my $out_bytes = '';
while (my ($bytes) = $in_bytes =~ s/^(.{1,$BUFFER_SIZE})//s) {
# Unpack from 5 bit fields.
my #vals = map { pack('B*', "000$_") } unpack('B*', $bytes) =~ /(.{5})/g;
# Transform #vals into 8 bit values here.
# Pack to 8 bit fields.
$out_bytes .= pack('C*', #vals);
}
Since you're not transforming the values at all (just how they are stored), that simplifies to:
my $BUFFER_SIZE = 5 * 50_000; # Must be a multiple of 40.
my $in_bytes = ...;
my $out_bytes = '';
while (my ($bytes) = $in_bytes =~ s/^(.{1,$BUFFER_SIZE})//s) {
# Unpack from 5 bit fields.
my $bits = unpack('B*', $bytes);
$bits =~ s/(.{5})/000$1/g;
$out_bytes .= pack('B*', $bits);
}
You didn't say what to do with the extra bits. I simply ignored them.
Alternative approach with no bit string creation:
my $in_bytes = ...;
my $out_bytes = '';
while (my ($bytes) = $in_bytes =~ s/^(.{1,5})//s) {
my #bytes = map ord, split //, $bytes;
# 00000111 11222223 33334444 45555566 66677777
$out_bytes .= chr( (($bytes[0] >> 3) & 0x1F));
last if #bytes == 1;
$out_bytes .= chr((($bytes[0] << 2) & 0x1C) | (($bytes[1] >> 6) & 0x03));
$out_bytes .= chr( (($bytes[1] >> 1) & 0x1F));
last if #bytes == 2;
$out_bytes .= chr((($bytes[1] << 4) & 0x10) | (($bytes[2] >> 4) & 0x0F));
last if #bytes == 3;
$out_bytes .= chr((($bytes[2] << 1) & 0x1E) | (($bytes[3] >> 7) & 0x01));
$out_bytes .= chr( (($bytes[3] >> 2) & 0x1F));
last if #bytes == 4;
$out_bytes .= chr((($bytes[3] << 3) & 0x18) | (($bytes[4] >> 5) & 0x07));
$out_bytes .= chr( ( $bytes[4] & 0x1F));
}
The advantage of the above solution is that it's particularly efficient in C.
STRLEN in_len;
const char* in = SvPVbyte(sv, in_len);
STRLEN out_len = (in_len * 8 / 5) * 8;
char* out = (char*)malloc(out_len);
char* out_cur = out;
char* in_end = in + in_len;
while (in != in_end) {
*(out_cur++) = ((*in >> 3) & 0x1F));
if (++in == in_end) break;
*(out_cur++) = ((in[-1] << 2) & 0x1C) | ((*in >> 6) & 0x03));
*(out_cur++) = ((*in >> 1) & 0x1F));
if (++in == in_end) break;
*(out_cur++) = ((in[-1] << 4) & 0x10) | ((*in >> 4) & 0x0F));
if (++in == in_end) break;
*(out_cur++) = ((in[-1] << 1) & 0x1E) | ((*in >> 7) & 0x01));
*(out_cur++) = ((*in >> 2) & 0x1F));
if (++in == in_end) break;
*(out_cur++) = ((in[-1] << 3) & 0x18) | ((*in >> 5) & 0x07));
*(out_cur++) = ( *in & 0x1F));
}
return newSVpvn(out, out_len);
I have written the following Perl script to generate the logical constraints in smt2 format to solve a sudoku puzzle for a given input file. The input file is in this format:
5 3 * * 7 * * * *
6 * * 1 9 5 * * *
* 9 8 * * * * 6 *
8 * * * 6 * * * 3
4 * * 8 * 3 * * 1
7 * * * 2 * * * 6
* 6 * * * * 2 8 *
* * * 4 1 9 * * 5
* * * * 8 * * 7 9
The big ugly Perl script is:
#! /usr/local/bin/perl
# CSC 410 A2 Q2
# Sudoku
use strict;
use warnings;
# All of the indices in a sudoku array
my #row1 = qw(r1c1 r1c2 r1c3 r1c4 r1c5 r1c6 r1c7 r1c8 r1c9);
my #row2 = qw(r2c1 r2c2 r2c3 r2c4 r2c5 r2c6 r2c7 r2c8 r2c9);
my #row3 = qw(r3c1 r3c2 r3c3 r3c4 r3c5 r3c6 r3c7 r3c8 r3c9);
my #row4 = qw(r4c1 r4c2 r4c3 r4c4 r4c5 r4c6 r4c7 r4c8 r4c9);
my #row5 = qw(r5c1 r5c2 r5c3 r5c4 r5c5 r5c6 r5c7 r5c8 r5c9);
my #row6 = qw(r6c1 r6c2 r6c3 r6c4 r6c5 r6c6 r6c7 r6c8 r6c9);
my #row7 = qw(r7c1 r7c2 r7c3 r7c4 r7c5 r7c6 r7c7 r7c8 r7c9);
my #row8 = qw(r8c1 r8c2 r8c3 r8c4 r8c5 r8c6 r8c7 r8c8 r8c9);
my #row9 = qw(r9c1 r9c2 r9c3 r9c4 r9c5 r9c6 r9c7 r9c8 r9c9);
my #rows = (\#row1, \#row2, \#row3, \#row4, \#row5, \#row6, \#row7, \#row8, \#row9);
# All of the indices in a sudoku block
my #block1 = qw(r1c1 r1c2 r1c3 r2c1 r2c2 r2c3 r3c1 r3c2 r3c3);
my #block2 = qw(r1c4 r1c5 r1c6 r2c4 r2c5 r2c6 r3c4 r3c5 r3c6);
my #block3 = qw(r1c7 r1c8 r1c9 r2c7 r2c8 r2c9 r3c7 r3c8 r3c9);
my #block4 = qw(r4c1 r4c2 r4c3 r5c1 r5c2 r5c3 r6c1 r6c2 r6c3);
my #block5 = qw(r4c4 r4c5 r4c6 r5c4 r5c5 r5c6 r6c4 r6c5 r6c6);
my #block6 = qw(r4c7 r4c8 r4c9 r5c7 r5c8 r5c9 r6c7 r6c8 r6c9);
my #block7 = qw(r7c1 r7c2 r7c3 r8c1 r8c2 r8c3 r9c1 r9c2 r9c3);
my #block8 = qw(r7c4 r7c5 r7c6 r8c4 r8c5 r8c6 r9c4 r9c5 r9c6);
my #block9 = qw(r7c7 r7c8 r7c9 r8c7 r8c8 r8c9 r9c7 r9c8 r9c9);
my #blocks = (\#block1, \#block2, \#block3, \#block4, \#block5, \#block6, \#block7, \#block8, \#block9);
open (FORMULA, ">", "sudoku.smt2") or die $!;
my $var;
my $i;
my $r;
my $c;
print (FORMULA "; Declare integers constants.\n");
for ($r = 0; $r < 9; $r++)
{
for ($c = 0; $c < 9; $c++)
{
print (FORMULA "(declare-const $rows[$r][$c] Int)\n");
}
}
print (FORMULA "\n");
print (FORMULA "; Assert for each variable r_ic_j that 1 <= r_ic_j <= 9\n");
for ($r = 0; $r < 9; $r++)
{
for ($c = 0; $c < 9; $c++)
{
print (FORMULA "(assert (not (and (not ($rows[$r][$c] = 1)) (not ($rows[$r][$c] = 2)) (not ($rows[$r][$c] = 3)) (not ($rows[$r][$c] = 4)) (not ($rows[$r][$c] = 5)) (not ($rows[$r][$c] = 6)) (not ($rows[$r][$c] = 7)) (not ($rows[$r][$c] = 8)) (not ($rows[$r][$c] = 9)))))\n");
}
}
print (FORMULA "\n");
print (FORMULA "; Assert that each row and column contains a number only once.\n");
for ($r = 0; $r < 9; $r++)
{
for ($c = 0; $c < 9; $c++)
{
$var = $rows[$r][$c];
for ($i = 0; $i < 9; $i++)
{
if ($var ne $rows[$r][$i])
{
print (FORMULA "(assert (not (= $var $rows[$r][$i])))\n");
}
}
for ($i = 0; $i < 9; $i++)
{
if ($var ne $rows[$i][$c])
{
print (FORMULA "(assert (not (= $var $rows[$i][$c])))\n");
}
}
}
}
print (FORMULA "\n");
print (FORMULA "; Assert that each number appears only once in each block.\n");
for ($r = 0; $r < 9; $r++)
{
for ($c = 0; $c < 9; $c++)
{
$var = $blocks[$r][$c];
for ($i = 0; $i < 9; $i++)
{
if ($var ne $blocks[$r][$i])
{
print (FORMULA "(assert (not (= $var $blocks[$r][$i])))\n");
}
}
}
}
print (FORMULA "\n");
print (FORMULA "; Declare input constants\n");
open (INPUT, "<", $ARGV[0]) or die $!;
my #lines;
my $line_num = 0;
while (#lines = split(/ /, <INPUT>))
{
for ($i = 0; $i <= $#lines; $i++)
{
chomp($lines[$i]);
if ($lines[$i] ne "*")
{
print (FORMULA "(assert (= $rows[$line_num][$i] $lines[$i]))\n");
}
}
$line_num++;
}
print (FORMULA "\n");
print (FORMULA "(check-sat)\n");
print (FORMULA "(get-model)\n");
close (FORMULA);
exit;
The portion of the script that is causing the seg fault is:
print (FORMULA "; Assert for each variable r_ic_j that 1 <= r_ic_j <= 9\n");
for ($r = 0; $r < 9; $r++)
{
for ($c = 0; $c < 9; $c++)
{
print (FORMULA "(assert (not (and (not ($rows[$r][$c] = 1)) (not ($rows[$r][$c] = 2)) (not ($rows[$r][$c] = 3)) (not ($rows[$r][$c] = 4)) (not ($rows[$r][$c] = 5)) (not ($rows[$r][$c] = 6)) (not ($rows[$r][$c] = 7)) (not ($rows[$r][$c] = 8)) (not ($rows[$r][$c] = 9)))))\n");
}
}
But this fragment just prints something like this:
(assert (not (and (not (x = 1)) (not (x = 2)) (not (x = 3)) ... (not (x = 9)))))
which should be logically equivalent to:
(assert (or (= x 1) (= x 2) (= x 3) ... (= x 9)))
Any advice is appreciated.
Regards.
The expression (x = 1) is not valid in SMT 2.0. It should be (= x 1). As you described in the comment above, after this change is made, the script works as expected.