Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^7: Schizophrenic var - cache examples

by marioroy (Prior)
on Jul 27, 2023 at 17:29 UTC ( [id://11153600]=note: print w/replies, xml ) Need Help??


in reply to Re^6: Schizophrenic var - cache results
in thread Schizophrenic var

The prior node provided diffs to keep the post short. Some folks may prefer the full examples, provided here.

test-cache-lru.pl

#!/usr/bin/env -S perl # Author: Celogeek # test-cache-lru.pl # https://github.com/celogeek/perl-test-caching/tree/master use strict; use warnings; use Digest::MD5 qw/md5_base64/; use Time::HiRes qw/time/; use feature 'say', 'state'; use Proc::ProcessTable; use Cache::LRU; sub get_current_process_memory { state $pt = Proc::ProcessTable->new; my %info = map { $_->pid => $_ } @{$pt->table}; return $info{$$}->rss; } $|=1; my $c = Cache::LRU->new(size => 500000); say "Mapping"; my @todo = map { md5_base64($_) } (1..600_000); say "Starting"; my $mem = get_current_process_memory(); my ($read, $write, $found); { my $s = time; my $i = 0; for(@todo) { $i++; $c->set($_, {md5 => $_}); print "Write: $i\r" if $i % 1000 == 0; } $write = time - $s; } say "Write: ", scalar(@todo) / $write; { my $s = time; my $i = 0; my $f = 0; for(@todo) { $i++; $found++ if ref $c->get($_) eq 'HASH'; print "Read : $i\r" if $i % 1000 == 0; } $read = time - $s; } say "Read : ", scalar(@todo) / $read; say "Found: ", $found; say "Mem : ", get_current_process_memory() - $mem;

test-cache-lru-with-expires.pl

#!/usr/bin/env -S perl # Author: Celogeek # test-cache-lru-with-expires.pl # https://github.com/celogeek/perl-test-caching/tree/master use strict; use warnings; use Digest::MD5 qw/md5_base64/; use Time::HiRes qw/time/; use feature 'say', 'state'; use Proc::ProcessTable; use Cache::LRU::WithExpires; sub get_current_process_memory { state $pt = Proc::ProcessTable->new; my %info = map { $_->pid => $_ } @{$pt->table}; return $info{$$}->rss; } $|=1; my $c = Cache::LRU::WithExpires->new(size => 500000); say "Mapping"; my @todo = map { md5_base64($_) } (1..600_000); say "Starting"; my $mem = get_current_process_memory(); my ($read, $write, $found); { my $s = time; my $i = 0; for(@todo) { $i++; $c->set($_, {md5 => $_}, 60); print "Write: $i\r" if $i % 1000 == 0; } $write = time - $s; } say "Write: ", scalar(@todo) / $write; { my $s = time; my $i = 0; my $f = 0; for(@todo) { $i++; $found++ if ref $c->get($_) eq 'HASH'; print "Read : $i\r" if $i % 1000 == 0; } $read = time - $s; } say "Read : ", scalar(@todo) / $read; say "Found: ", $found; say "Mem : ", get_current_process_memory() - $mem;

test-cache-mce.pl

#!/usr/bin/env -S perl # MCE::Shared::Cache test # based on test-cache-lru.pl # https://github.com/celogeek/perl-test-caching/tree/master use strict; use warnings; use Digest::MD5 qw/md5_base64/; use Time::HiRes qw/time/; use feature 'say', 'state'; use Proc::ProcessTable; use MCE::Shared::Cache; sub get_current_process_memory { state $pt = Proc::ProcessTable->new; my %info = map { $_->pid => $_ } @{$pt->table}; return $info{$$}->rss; } $|=1; my $c = MCE::Shared::Cache->new(max_keys => 500000); say "Mapping"; my @todo = map { md5_base64($_) } (1..600_000); say "Starting"; my $mem = get_current_process_memory(); my ($read, $write, $found); { my $s = time; my $i = 0; for(@todo) { $i++; $c->set($_, {md5 => $_}); print "Write: $i\r" if $i % 1000 == 0; } $write = time - $s; } say "Write: ", scalar(@todo) / $write; { my $s = time; my $i = 0; my $f = 0; for(@todo) { $i++; $found++ if ref $c->get($_) eq 'HASH'; print "Read : $i\r" if $i % 1000 == 0; } $read = time - $s; } say "Read : ", scalar(@todo) / $read; say "Found: ", $found; say "Mem : ", get_current_process_memory() - $mem;

test-cache-mce-with-expires.pl

#!/usr/bin/env -S perl # MCE::Shared::Cache test with expires # based on test-cache-lru-with-expires.pl # https://github.com/celogeek/perl-test-caching/tree/master use strict; use warnings; use Digest::MD5 qw/md5_base64/; use Time::HiRes qw/time/; use feature 'say', 'state'; use Proc::ProcessTable; use MCE::Shared::Cache; sub get_current_process_memory { state $pt = Proc::ProcessTable->new; my %info = map { $_->pid => $_ } @{$pt->table}; return $info{$$}->rss; } $|=1; my $c = MCE::Shared::Cache->new(max_keys => 500000); say "Mapping"; my @todo = map { md5_base64($_) } (1..600_000); say "Starting"; my $mem = get_current_process_memory(); my ($read, $write, $found); { my $s = time; my $i = 0; for(@todo) { $i++; $c->set($_, {md5 => $_}, 60); print "Write: $i\r" if $i % 1000 == 0; } $write = time - $s; } say "Write: ", scalar(@todo) / $write; { my $s = time; my $i = 0; my $f = 0; for(@todo) { $i++; $found++ if ref $c->get($_) eq 'HASH'; print "Read : $i\r" if $i % 1000 == 0; } $read = time - $s; } say "Read : ", scalar(@todo) / $read; say "Found: ", $found; say "Mem : ", get_current_process_memory() - $mem;

test-cache-parallel-mce.pl

#!/usr/bin/env -S perl # parallel demonstration # based on example in documentation # https://metacpan.org/pod/MCE::Shared::Cache#PERFORMANCE-TESTING use strict; use warnings; use feature qw( say ); use Digest::MD5 qw( md5_base64 ); use Time::HiRes qw( time ); use MCE 1.814; use MCE::Shared; $| = 1; srand(0); # construct shared variables # serialization is handled automatically my $c = MCE::Shared->cache(); my $found = MCE::Shared->scalar( 0 ); # construct and spawn MCE workers # workers increment a local variable $f my $mce = MCE->new( chunk_size => 4000, max_workers => 4, user_func => sub { my ($mce, $chunk_ref, $chunk_id) = @_; if ( $mce->user_args()->[0] eq 'setter' ) { for ( @{ $chunk_ref } ) { $c->set($_, {md5 => $_}, 600) } } else { my $f = 0; for ( @{ $chunk_ref } ) { $f++ if ref $c->get($_) eq 'HASH +' } $found->incrby($f); } } )->spawn(); say "Mapping"; my @todo = map { md5_base64($_) } ( 1 .. 600_000 ); say "Starting"; my ( $read, $write ); { my $s = time; $mce->process({ progress => sub { print "Write: $_[0]\r" }, user_args => [ 'setter' ], }, \@todo); $write = time - $s; } say "Write: ", sprintf("%0.3f", scalar(@todo) / $write); { my $s = time; $found->set(0); $mce->process({ progress => sub { print "Read $_[0]\r" }, user_args => [ 'getter' ], }, \@todo); $read = time - $s; } $mce->shutdown(); say "Read : ", sprintf("%0.3f", scalar(@todo) / $read); say "Found: ", $found->get();

test-cache-parallel-redis.pl

#!/usr/bin/env -S perl # parallel demonstration # based on example in documentation # https://metacpan.org/pod/MCE::Shared::Cache#PERFORMANCE-TESTING use strict; use warnings; use feature qw( say ); use Digest::MD5 qw( md5_base64 ); use Time::HiRes qw( time ); use MCE 1.814; use MCE::Shared; use Redis; use Sereal qw/encode_sereal decode_sereal/; $| = 1; srand(0); # construct shared variables # serialization is handled automatically my $c = Redis->new; my $found = MCE::Shared->scalar( 0 ); # construct and spawn MCE workers # workers increment a local variable $f my $mce = MCE->new( chunk_size => 4000, max_workers => 4, user_func => sub { my ($mce, $chunk_ref, $chunk_id) = @_; if ( $mce->user_args()->[0] eq 'setter' ) { for ( @{ $chunk_ref } ) { $c->setex($_, 600, encode_sereal +({md5 => $_})) } } else { my $f = 0; for ( @{ $chunk_ref } ) { my $srl = $c->get($_); $srl = decode_sereal($srl) if defined $srl; $f++ if ref $srl eq 'HASH'; } $found->incrby($f); } } )->spawn(); say "Mapping"; my @todo = map { md5_base64($_) } ( 1 .. 600_000 ); say "Starting"; my ( $read, $write ); { my $s = time; $mce->process({ progress => sub { print "Write: $_[0]\r" }, user_args => [ 'setter' ], }, \@todo); $write = time - $s; } say "Write: ", sprintf("%0.3f", scalar(@todo) / $write); { my $s = time; $found->set(0); $mce->process({ progress => sub { print "Read $_[0]\r" }, user_args => [ 'getter' ], }, \@todo); $read = time - $s; } $mce->shutdown(); say "Read : ", sprintf("%0.3f", scalar(@todo) / $read); say "Found: ", $found->get();

test-redis-tcp.pl

#!/usr/bin/env -S perl # Author: Celogeek # test-redis-tcp.pl # https://github.com/celogeek/perl-test-caching/tree/master use strict; use warnings; use Digest::MD5 qw/md5_base64/; use Time::HiRes qw/time/; use feature 'say', 'state'; use Proc::ProcessTable; use Redis; use Sereal qw/encode_sereal decode_sereal/; sub get_current_process_memory { state $pt = Proc::ProcessTable->new; my %info = map { $_->pid => $_ } @{$pt->table}; return $info{$$}->rss; } $|=1; my $c = Redis->new; say "Mapping"; my @todo = map { md5_base64($_) } (1..600_000); say "Starting"; my $mem = get_current_process_memory(); my ($read, $write, $found); { my $s = time; my $i = 0; for(@todo) { $i++; $c->setex($_, 600, encode_sereal({md5 => $_})); print "Write: $i\r" if $i % 1000 == 0; } $write = time - $s; } say "Write: ", scalar(@todo) / $write; { my $s = time; my $i = 0; my $f = 0; for(@todo) { $i++; my $srl = $c->get($_); $srl = decode_sereal($srl) if defined $srl; $found++ if ref $srl eq 'HASH'; print "Read : $i\r" if $i % 1000 == 0; } $read = time - $s; } say "Read : ", scalar(@todo) / $read; say "Found: ", $found; say "Mem : ", get_current_process_memory() - $mem;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11153600]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (2)
As of 2025-02-09 15:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Which URL do you most often use to access this site?












    Results (96 votes). Check out past polls.