Oxolyse

Ich stelle wieder mal fest, daß sich mit dem Computer viel lustiger Unsinn anstellen lässt. Und so komme ich auf meinen alten, verrückten Blog

OXOMO|OMOXO

  zurück, mit neuen Ideen:

Ein Ox-Creator ( für Uroxisch )

#!/usr/bin/perl

# oxcreator_uroxisch.pl

use strict;
use warnings;



# Variablen

my $ox = 'ox';
my @kons = ('b','l','m','r','t','v','x','z');
my @vocs = ('a','i','o','u');

# Programm

## Jamben kreieren

my %jamben;

foreach ( @kons ) {
    my $jambus;
    my $jmb1 = $_;
    foreach ( @vocs ) {
        my $jmb2 = $_;
        $jambus = $ox.$jmb2;
        if ( not exists $jamben{$jambus} ) { $jamben{$jambus} = 'exists' }
        $jambus = $jmb1.$ox.$jmb2;
        if ( not exists $jamben{$jambus} ) { $jamben{$jambus} = 'exists' }       
    }
}

### Ausgabe aller Jamben

print "\nAlle Jamben:\n\n";
print map { $_, "\n" } sort { $a cmp $b } keys %jamben;
print "\nJamben fertig!\n\n";

open ( my $fhs, '>jamben.txt' );
print $fhs map { $_, "\n" } sort { $a cmp $b } keys %jamben;
close $fhs;


## Traskkui kreieren

my %traskkui;

foreach ( @kons ) {
    my $traskkui;
    my $trk1 = $_;
    foreach ( @vocs ) {
        my $trk2 = $_;
        foreach ( @kons ) {
            my $trk3 = $_;
            $traskkui = $ox.$trk2.$trk3;
            if ( not exists $traskkui{$traskkui} ) { $traskkui{$traskkui} = 'exists' }
            $traskkui = $trk1.$ox.$trk2.$trk3;
            if ( not exists $traskkui{$traskkui} ) { $traskkui{$traskkui} = 'exists' }
        }
    }
}

### Ausgabe aller Traskkui

print "\nAlle Traskkui:\n\n";
print map { $_, "\n" } sort { $a cmp $b } keys %traskkui;
print "\nTraskkui fertig!\n\n";

open ( $fhs, '>traskkui.txt' );
print $fhs map { $_, "\n" } sort { $a cmp $b } keys %traskkui;
close $fhs;


## Trochaeen kreieren

my %trochaeen;

foreach ( @kons ) {
    my $trochaee;
    my $trch1 = $_;
    foreach ( @vocs ) {
        my $trch2 = $_;
        foreach ( @kons ) {
            my $trochaee;
            my $trch3 = $_;
            foreach ( @vocs ) {
                my $trch4 = $_;
                # 'ox' hinten
                $trochaee = $trch2.$trch3.$ox.$trch4;
                if ( not exists $trochaeen{$trochaee} ) { $trochaeen{$trochaee} = 'exists' }
                $trochaee = $trch1.$trch2.$trch3.$ox.$trch4;
                if ( not exists $trochaeen{$trochaee} ) { $trochaeen{$trochaee} = 'exists' }
                # 'ox' vorne
                $trochaee = $ox.$trch2.$trch3.$trch4;
                if ( not exists $trochaeen{$trochaee} ) { $trochaeen{$trochaee} = 'exists' }
                $trochaee = $trch1.$ox.$trch2.$trch3.$trch4;
                if ( not exists $trochaeen{$trochaee} ) { $trochaeen{$trochaee} = 'exists' }           
            }
        }
    }
}

### Ausgabe aller Trochaeen

print "\nAlle Trochaeen:\n\n";
print map { $_, "\n" } sort { $a cmp $b } keys %trochaeen;
print "\nTrochaeen fertig!\n\n";

open ( $fhs, '>trochaeen.txt' );
print $fhs map { $_, "\n" } sort { $a cmp $b } keys %trochaeen;
close $fhs;

Und der Gedicht-Kreatör von gestern/heute nacht ( etwas verbessert ):

 

#!/usr/bin/perl

# simple-rhyme-creator_oxisch_1.3.pl

use strict;
use warnings;
use DBI;
use ZugangsDaten_postgresql qw($DB_USER $DB_PASSWD);
use Encode qw(is_utf8 decode encode);


# Programm

## Buchstabenfolge, die in jeder Zeile vorkommen soll

print "\n";
print "Bitte eine kurze Buchstabenfolge eingeben, die in jeder Zeile vorkommen soll!\n";
my $folge = <STDIN>;
chomp $folge;

## Jamben in Hash einlesen

my %jamben;

open ( my $fh, '<jamben.txt' );
my @jamben = <$fh>;
close $fh;

foreach ( @jamben ) {
    my $jambus = $_;
    chomp $jambus;
    my $ende = $jambus;
    $ende = lc $ende;
    $ende =~ s/.*([aeiouyäöü]+[h]*)$/$1/;
    if ( not exists $jamben{$jambus} ) { $jamben{$jambus} = $ende }
}

## Eingelesene Jamben nach Endung ausgeben

foreach ( sort { $jamben{$a} cmp $jamben{$b} } keys %jamben ) {
    print $_, " ::: ", $jamben{$_}, "\n";
}

## Jamben durchnummerieren

my %jambencount;
my $jambencounter = 1;

foreach ( keys %jamben ) {
    $jambencount{$jambencounter} = $_;
    $jambencounter++
}


## Traskkui in Hash einlesen

my %traskkui;

open ( $fh, '<traskkui.txt' );
my @traskkui = <$fh>;
close $fh;

foreach ( @traskkui ) {
    my $traskkui = $_;
    chomp $traskkui;
    my $ende = $traskkui;
    $ende = lc $ende;
    $ende =~ s/.*([bcdfghklmnpqrsßtvwxz])$/$1/;
    if ( not exists $traskkui{$traskkui} ) { $traskkui{$traskkui} = $ende }
}

## Eingelesene Traskkui nach Endung ausgeben

foreach ( sort { $traskkui{$a} cmp $traskkui{$b} } keys %traskkui ) {
    print $_, " ::: ", $traskkui{$_}, "\n";
}

## Traskkui durchnummerieren

my %traskkuicount;
my $traskkuicounter = 1;

foreach ( keys %traskkui ) {
    $traskkuicount{$traskkuicounter} = $_;
    $traskkuicounter++
}

## Trochaeen in Hash einlesen

my %trochaeen;

open ( $fh, '<trochaeen.txt' );
my @trochaeen = <$fh>;
close $fh;

foreach ( @trochaeen ) {
    my $trochaeen = $_;
    chomp $trochaeen;
    my $ende = $trochaeen;
    $ende = lc $ende;
    $ende =~ s/.*([aeiouyäöü]+[h]*)$/$1/;
    if ( not exists $trochaeen{$trochaeen} ) { $trochaeen{$trochaeen} = $ende }
}

## Eingelesene Trochaeen nach Endung ausgeben

foreach ( sort { $trochaeen{$a} cmp $trochaeen{$b} } keys %trochaeen ) {
    print $_, " ::: ", $trochaeen{$_}, "\n";
}

## Trochaeen durchnummerieren

my %trochaeencount;
my $trochaeencounter = 1;

foreach ( keys %trochaeen ) {
    $trochaeencount{$trochaeencounter} = $_;
    $trochaeencounter++
}


## Reimzeilen bilden

my $zufallsbereich = scalar keys %jamben;
my $zufallsbereich_traskkui = scalar keys %traskkui;
my $zufallsbereich_trochaeen = scalar keys %trochaeen;
my @zeilen;
my $i = 1;

while ( $i < 22222 ) {
    my $jambencountchoice = int rand($zufallsbereich) + 1;
    my $traskkuicountchoice = int rand($zufallsbereich_traskkui) + 1;
    my $trochaeencountchoice = int rand($zufallsbereich_trochaeen) + 1;
    my $zeile = $jambencount{$jambencountchoice}." ".$trochaeencount{$trochaeencountchoice};
    $jambencountchoice = int rand($zufallsbereich) + 1;   
    $zeile = $zeile." ".$traskkuicount{$traskkuicountchoice}." ".$jambencount{$jambencountchoice};
    if ( $zeile =~ m/.*$folge.*/ ) {
        push @zeilen, $zeile;
        $i++
    } else { print "\$i = $i\n"; next }
}

print "\n";
print "Meine Zeilen:\n\n";
print map { $_, "\n" } @zeilen;
print "\n\n";

## Reimzeilen nach Endung sortieren

my %zeilen;

foreach ( @zeilen ) {
    my $zeile = $_;
    chomp $zeile;
    my $ende = $zeile;
    $ende =~ s/.*([aeiouyäöü]+[h]*)$/$1/i;
    $ende = lc $ende;
    if ( not exists $zeilen{$zeile} ) { $zeilen{$zeile} = $ende }
}


## Eingelesene Zeilen nach Endung ausgeben

print "\nEingelesene Zeilen nach Endung!!! ANFANG.\n\n";

foreach ( sort { $zeilen{$a} cmp $zeilen{$b} } keys %zeilen ) {
    print $_, " ::: ", $zeilen{$_}, "\n";
}

print "\nEingelesene Zeilen nach Endung!!! ENDE.\n\n";


## Zeilen nach Endung in Arrays beamen

my %endarrays;
my @array_temp;
my $last_end;


foreach ( sort { $zeilen{$a} cmp $zeilen{$b} } keys %zeilen ) {
    my $end = $zeilen{$_};
    if ( $last_end ne $end ) {
        $endarrays{$last_end} = [@array_temp]; @array_temp = ();
        push @array_temp, $_;
    } else {
        print "Ende: $end, Last-End: $last_end\n";
        print "Zeile: $_\n";
        push @array_temp, $_
    }
    $last_end = $end;
}

## Sortierte Zeilen-Arrays nach Endung ausgeben

print "\nSortierte Zeilenarrays:\n\n";

foreach ( sort { $a cmp $b } keys %endarrays ) {
    print $_, "\n";
    my $array_ref = $endarrays{$_};
    print map { $_, "\n" } @$array_ref;
}

## Endarrays durchnummerieren

my %endarrays_numbered;
my $number = 1;

foreach ( keys %endarrays ) {
    $endarrays_numbered{$number} = $_;
    $number++
}

## Zwei Endungen per Zufall auswählen

my $endung1 = int rand(scalar keys %endarrays_numbered) + 1;
my $endung2 = int rand(scalar keys %endarrays_numbered) + 1;
until ( $endung1 ne $endung2 ) {
    $endung2 = int rand(scalar keys %endarrays_numbered) + 1
}

### Endung von Ziffer nach Buchstaben

$endung1 = $endarrays_numbered{$endung1};
$endung2 = $endarrays_numbered{$endung2};


print "\nAusgewählte Endung 1: $endung1\n";
print "Ausgewählte Endung 2: $endung2\n";

## Vierzeiler nach Muster Endung1, Endung2, Endung1, Endung2 bilden

my @vierzeiler;
my @zeilen_endung1;
my @zeilen_endung2;


## Endung 1 & 2

foreach ( keys %endarrays ) {
    my $end = $_;
    $end =~ s/[^aeiouy]//g;
    if ( $endung1 =~ m/$end/ ) {
        my $array_ref = $endarrays{$_};
        map { push @zeilen_endung1, $_ } @$array_ref;
    } elsif ( $endung2 =~ m/$end/ ) {
        my $array_ref = $endarrays{$_};
        map { push @zeilen_endung2, $_ } @$array_ref;
    }
}

print "\nArray mit Endung $endung1:\n\n";
print map { $_, "\n" } @zeilen_endung1;
print "\n";

print "\nArray mit Endung $endung2:\n\n";
print map { $_, "\n" } @zeilen_endung2;
print "\n";

## Vierer-Vierzeiler

for ( my $vier = 1; $vier < 5; $vier++ ) {

    for ( my $vierzeiler = 1; $vierzeiler < 5; $vierzeiler++ ) {
        if ( $vierzeiler == 1 || $vierzeiler == 3 ) {
            my $zufall1 = int rand(scalar @zeilen_endung1);
            print "Zufall 1: ", $zufall1, "\n";
            my $zeile = $zeilen_endung1[$zufall1];
            push @vierzeiler, $zeile
        } else {
            my $zufall2 = int rand(scalar @zeilen_endung2);
            print "Zufall 2: ", $zufall2, "\n";
            my $zeile = $zeilen_endung2[$zufall2];
            push @vierzeiler, $zeile
        }
    }

    # Nach jedem Vierzeiler eine Leerzeile
   
    push @vierzeiler, "";
   
}


print "\nMein Gedicht:\n\n";
print map { $_, "\n" } @vierzeiler;
print "\n";

open ( my $fhs, '>gedicht.txt' );
print $fhs map { $_, "\n" } @vierzeiler;
close $fhs;

Gedicht-Ausgaben:

 

zoxa mivoxi loxiz xoxi
loxa vavoxa voxoz moxa
boxu voxuro oxal boxi
loxi voxobo roxab loxa

voxa lamoxa roxor xoxi
xoxi zuvoxu voxuz loxa
loxa batoxu roxit voxi
roxi liboxa xoxal moxa

boxu oxuzo roxov loxi
voxi boxola voxoz xoxa
boxu boxuta loxol voxi
zoxa boxuri moxiv roxa

toxu maxoxa roxix toxi
xoxa biboxi voxum roxa
oxu buboxi voxom oxi
moxo mivoxu loxol toxa


zoxo rovoxu xoxur roxi
zoxi voxoxi boxox voxa
xoxi boxili loxir oxi
xoxu limoxo voxuv moxa

zoxo vuzoxa loxiv roxi
toxi roxabu roxam boxa
moxi roloxa toxuv roxi
voxi zoxavu xoxox roxa

xoxu loxiva zoxom loxi
toxu zoxuxi toxal xoxa
moxi roxulu boxix xoxi
roxa xoxolo roxuz roxa

moxu xazoxu boxuv roxi
roxa mitoxa oxiv oxa
loxu toxalu voxox xoxi
roxa oxito voxuv loxa

Und in nicht-uroxisch

# Variablen

my $ox = 'ox';
my @kons = ('b','c','d','f','g','h','j','k','l','m','n','p','q','r','s','t','v','w','x','y','z');
my @vocs = ('a','e','i','o','u','y');

 

Gedichtausgaben

 

koxo boqoxu coxen foxa
foxo koxoqu voxud xoxi
soxe wykoxo doxex roxa
woxo moxyxy soxos voxi

coxe xoxepo coxyh moxa
toxo woxera qoxoq foxi
poxu goxify koxez boxa
goxu yoxuqe soxuz woxi

joxi jizoxa noxay xoxa
xoxy teloxa doxyg hoxi
doxa hoxije zoxyn yoxa
zoxu doxicu loxeh joxi

noxi roxuti toxuq xoxa
zoxu lunoxe voxok poxi
oxo soxipy koxey toxa
goxo roxoxu coxov coxi
doxo joxohi joxef qoxe
foxo koxynu voxug noxa
voxi joxiyi goxub toxe
koxo zedoxo joxer qoxa

foxa cosoxu foxuq toxe
voxy lejoxa roxiz noxa
yoxo hoxuki foxeh goxe
doxi oxibo koxix hoxa

toxu loxiwi zoxyn roxe
noxy xoxasy soxiw moxa
yoxa qotoxa poxal voxe
woxi temoxo roxic poxa

woxi cewoxo noxay roxe
qoxe noxypi zoxib xoxa
moxe yoxefu oxyf poxe
oxy yumoxu joxew xoxa

Voilox!