Geniale PERL-snutter?

[DrDoogie]

Ok, begynner med ei linje jeg synes er litt artig.

 

Har da en hash %unique_artists, hvor forekomstene av hver artist er lagret i hver nøkkel.

 

Istedenfor å skrive:

 

my @ranked_array;
while ( my ($key, $value) = each %unique_artists ) {
 push @{ $ranked_array[$value] }, $key;
}

 

Fant jeg da ut at jeg kunne jo bare skrive:

 

map { push @{ $ranked[$unique_artists{$_}] }, $_ } keys %unique_artists;

 

Lurt eller dumt? Uansett sparer jeg to linjer på skjermen, og bidrar dermed til å klare meg med 19" en stund ennå.

[Torbjørn]

haha, høres ut som om noen har programmert nok til å lære seg en del nytt siste dagene.

 

jeg har hatt et par øyeblikk selg, mange av dem relatert til "map" kommandoen!

 

eks 1:

hvordan finne nyeste fil i en katalog? (brukes for å sette "last updated" på en website. som består av mange filer.

 my @file_times = sort { $a <=> $b } map { (stat)[9] } glob "*";
my $last_modified = scalar localtime pop @file_times;

# eks: $last_modified = Sun Jan 11 05:56:14 2004

 

denne kan selvsagt settes sammen til en one-liner, men det føltes ikke fullt så elegant å måtte dytte @file_times inn i en anonymous array for dereferencing. Dessuten er linjene omtreng passelig lange med tanke på standard terminal bredde (som er min gyllende grense, ikke skjerm dimmensionen )

 

men evt slik altså:

my $last_modified = scalar localtime pop  @{[ sort { $a <=> $b } map { (stat)[9] } glob "*" ] };

Endret 11. januar 2004 av Torbjørn

[Torbjørn]

eks 2, hvordan runde et tall oppover?

 

man kan her bruke ceil funksjonen fra POSIX modulen, men jeg liker å gjøre ting så enkelt som mulig, med minst mulig inkludering av andre moduler enn core.

 

my $round_up = sprintf "%.0f", ($some_float + .5 );

Endret 11. januar 2004 av Torbjørn

[DrDoogie]

Kanskje ikke fullt så genialt denne gangen, men litt artig allikevel.

 

Det handler om å oppdatere en streng som man skriver ut, slik at man slipper å skrive hver endring på en ny linje.

 

$| = 1; 
print "Downloading in \e[92mprogress\e[0m: "; 
for $i (1..10) { 
  $progress = "\e[94m*\e[0m" x $i; 
  print "\b" x ($i-1), $progress; 
  sleep 1; 
} 
print "\n";

 

"$|" er da autoflush på STDOUT, og "\e[xxm" er bare for å få farge på teksten. "\b" er da backspace, som sletter tekst før, og "x" ganger antallet backspace med lengden på strengen man har skrevet, slik at man effektivt... ja.

 

Dette kan man jo enkelt slenge inn i en oneliner for å se hvordan det virker, "perl -e 'blah blah'".

[tvangsgreie]

Her er en som skriver ut dagens dato i norsk format:

printf("%02d/%02d/%04d", sub { $_[3], $_[4]+1, $_[5]+1900 }->(localtime));

[Torbjørn]

hashes kan lages uten string quotes på key:

 

my %hash = (
key1 => "value1",
key2 => "value2",
);

 

kan også hentes ut uten string quotes

my $value1 = $hash{key1}

[Torbjørn]

lese passord fra brukeren:

 

http://www.nt.ntnu.no/users/lindahl/readpass.sub.html

 

det viser stjerner når du skriver taster.

[W0odY]

hvis du skal loope deg frem til og ha forskjelige farger på boxer

altså divs eller tables synes jeg denne lille koden er utrolig fin..

 

my $color = ($color2++%2) ? "#fff" : "#E4EAF2"; 
print "<tr style=\"background:$color;\">
<td>nr1</td>
<td>nr2</td>
</tr>";

[superlaban]

Får du til samme subrutine med færre tegn? Linjeskift/space teller ikke. Den returnerer to tall: dag og måned for første påskedag i et gitt år som inputargument. Virker for alle år. Algoritmen laget engelskmannen Ouster i 1940, jeg omskrev og tilpasset den for Perl og har prøvd å få til færrest mulige tegn. For moro skyld.

sub paaske                                                                                                                                                   
{
 use integer;my$Y=shift;my$C=$Y/100;my$L=($C-$C/4-($C-($C-17)/25)/3+$Y%19*19+15)%30;
 (($L-=$L>28||($L>27?1-(21-$Y%19)/11:0))-=($Y+$Y/4+$L+2-$C+$C/4)%7)<4?($L+28,3):($L-3,4)
}

Kan testes med:

($dag,$mnd)=paaske($_) and print "Første påskedag i $_ er søndag den $dag. " . [qw/mars april/]->[$mnd-3].".\n"  for 2000..2030;

[sam2]

superlaban wrote:

Får du til samme subrutine med færre tegn?

 

use Date::Easter;
($mnd,$dag)=easter($_) and print "Første påskedag i $_ er søndag den $dag. " . [qw/mars april/]->[$mnd-3].".\n"  for 2000..2030;

 

(superlaban: Hvorfor trekker du sammen koden din på den måten? Det er en algoritme ikke en obfu, så hvorfor gjøre koden din unødvendig uleselig?)

[superlaban]

use Date::Easter;
($mnd,$dag)=easter($_) and print "Første påskedag i $_ er søndag den $dag. " . [qw/mars april/]->[$mnd-3].".\n"  for 2000..2030;

(superlaban: Hvorfor trekker du sammen koden din på den måten? Det er en algoritme ikke en obfu, så hvorfor gjøre koden din unødvendig uleselig?)

 

Ja, det er en algortme. Men det er også en obfuskering. Jeg bestemte at dette var det idet jeg spurte om noen klarte å gjøre den enda kortere, og da mente jeg pure-perl, ingen bruk av eksterne moduler.

 

Dessuten: Klarer du å gjøre den mer leselig?

 

Ousters algoritmen er skapt uleselig i utgangspunktet, så jeg "ødelegger" ingenting ved å komprimere koden ytterligere. (Jeg antar nå at du ikke er professor i diskret matematikk e.l.)

 

Dessuten kalkulerer Date::Easter feil! F.eks. sier den at påken i 2114 er 25. mars, når det riktige er 22. april. Den virker kun riktig i perioden 1894-2105. Ousters algoritme virker millioner av år, når rekken av påskedatoer starter å gjenta seg selv. (Ok, kanskje roterer jorda og månen saktere da, så den ikke er riktig likevel, men....)

 

;-)

[mysjkin]

Edit: Slettet post som ikke hørte hjemme her.

Endret 14. mars 2005 av mysjkin

[mpolden]

Denne funksjonen konverterer et MySQL timestamp (YYYY-MM-DD HH:MM:SS) til et UNIX timestamp.

 

use Time::Local;
sub mysql2epoch {
my @units = reverse split(/-|\s|:/, $_[0]);
$units[4] -= 1;
return timegm(@units);
}
my $epoch = mysql2epoch('2007-06-17 20:28:46');

$epoch vil da inneholde '1182112126'.

Og ja, jeg vet at MySQL har en UNIX_TIMESTAMP()-funksjon, men jeg synes denne er mer grei.

[MataFaka]

Gammel tråd men la gå!

 

Fin måte å sammeligne to arrays for å hente ut de verdiene som IKKE går igjen i den andre.

my @A = qw(1 2 3 5 7 8);
my @B = qw(1 2 3 4 5 8);

my %A=map{$_ =>1} @A;
my %B=map{$_ =>1} @B;
my @C = grep(!defined $A{$_}, @B);
my @D = grep(!defined $B{$_}, @A);

Dette gir da svar 4 og 7

[Torbjørn]

Gammel tråd men la gå!

 

Fin måte å sammeligne to arrays for å hente ut de verdiene som IKKE går igjen i den andre.

my @A = qw(1 2 3 5 7 8);
my @B = qw(1 2 3 4 5 8);

my %A=map{$_ =>1} @A;
my %B=map{$_ =>1} @B;
my @C = grep(!defined $A{$_}, @B);
my @D = grep(!defined $B{$_}, @A);

Dette gir da svar 4 og 7

 

Se ellers Set::Object

 

use Set::Object;

$a = new Set::Object 1..8;
$b = new Set::Object qw/1 2 3 4 5 8/;

print $a - $b;

 

For disse enkle tallene kan det diskuteres, men med en gang du skal gjøre noe mer, er Set::Object fin, den gjør alle mulige set operasjoner.

[Lycantrophe]

Denne tråden må ikke dø.

 

Enkel enumerate:

 

sub enumerate {
   my ( $list, $index ) = ( shift, 1 ); 
   return { map { $index++ => $_ } @$list };
}

Kalles med enumerate( [ arrayref ] ). Returnerer dessverre usortert da perl ikke har tupler i pythons forstand, men fortsatt kjekk nok. Kan lett tilpasses til å starte på en annen index enn 1 og.

[fleskesvor]

sub enumerate {
 my ( $list, $index ) = ( shift, 1 );
 return { map { $index++ => $_ } @$list };
}

 

Snedig. Ellers returnerer http://perldoc.perl....tions/each.html siden version 5.12 både indeks og verdi slik at man kan gjøre:

 

while (my ($index, $value) = each @array) {
 print "$index\t$value\n";
}

 

Her er en énlinjer for å legge tusenseparator til et tall:

 

perl -pe '1while s/^(\d+)(\d{3})/$1 $2/'

 

Ja, "1while" i ett ord fungerer og mellomrommet i substitusjonen kan erstattes med komma for amerikansk kommaseparering. Ankeret først i det regulære uttrykket kan fjernes hvis man ønsker separering bak komma også.

Endret 9. januar 2013 av fleskesvor

[Hieronymus]

La Perl få dø, vær så snill!

[Kimm0n0]

La Perl få dø, vær så snill!

Perl fornyer seg hele tiden.