Zum Wie, nicht zum Warum

Let's go!


Kgega Angoff Unos Therdthai
Porndoe Outgoing Allen Rotko
seinna Abdschad Eggos cohnii
Vigneau Eilsdorf Ogot Mommo

Kila Egos Aided Cudi
schlaueste Essner oikos valgo
Hazgo imag Eastern szlwiki
wiege Ogot EXPLAIN Furgao

Preggo Alans Echten Kokkai
Courte Amnium Orvin rango
feschde Angot Objects Cardi
bahoe Autec Ursus Margo

Monnaie Ichschrift adgoal Dorbi
Fanzo Acclaim ostrich Mnogo
Kowqqxu egor einknickt brachii
Rahmi inquest erschien Ghigo

 

Code

#!/usr/bin/perl

# simple-rhyme-creator_1.2.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/.*([bcdfghklmnpqrstvwxz])$/$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++
}


## Reimzeilen bilden

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

while ( $i < 22222 ) {
    my $jambencountchoice = int rand($zufallsbereich) + 1;
    my $traskkuicountchoice = int rand($zufallsbereich_traskkui) + 1;
    my $zeile = $jambencount{$jambencountchoice}." ".$traskkuicount{$traskkuicountchoice};
    $jambencountchoice = int rand($zufallsbereich) + 1;
    $traskkuicountchoice = int rand($zufallsbereich_traskkui) + 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";


 

El El

Sunca Edeln Abkunft Soroa
Laqa Erststart Offiah telo
Dubi Osbert ideell Dista
dope Athens Appen Helvio

Connu anstellt OpenZFS Magma
Ziele eXist ISAZ Kahlo
LeLe Ölboom oomphies Deliah
TESTE exkan Eksell Hiko

Telge Eban Earthlings ganja
wefi ERDOS Endspiel Sabo
Rennie Insgsamt Öpel Dschibla
Schimke Edel Eurim toho

Nori Eckel Undicht Boga
retie ECON elden dedo
Weuve andockt UNRISD Leela
huele Erzstaat Afon Znojmo

 

La La

Scholae arten Esboern vuonna
germa Eislauf unsrer heissä
Circa aussaugt Arnod Simpla
brukte arschlahm Alling niitä

Dikla isteach Assing bitva
Scala ABAP iSec Mariä
Schwarzbau Upland angelt rosia
Muisca alaaf Ansoff tällä

JULIE Ardis Adnan nula
hverri Endlauf ernennt Wäinö
sula using Icing Jawa
Neide Atlas unchar väriä

NPACI Elcock input mela
Robla enGEL Essund silmiä
Grini Aufruf aufregt lanja
Chase ernsten Anklam nähdä



Ziemlich hembelisch, fürwahr.



~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Und es kommt, wie es ja kommen muss ;-)

 

Dreaming of Palo Alto

Lotstra Euros airpods Mwene
Nusra Abos Alqosh frasi
Rosta USAAF Ivars Mokae
Hälsa Anlis Argos Mbaki

Kostra Atrial odwer furzte
glotzte Ätzkalk iostream kaini
fose Emmett Essens Causae
Gosio entstrahlt ordnend Christi

Sellu AbcdLaos Offord Sople
Wossa Andoer Uusschlag letih
Sabre explos Equus chille
KidGoo Unclos Äther hauzuii

Losta Elten Iwann Nitie
Wishkah Oldfield Eising Rospi
Kuppi eAutos Aerials Zielcke
muosli Armstrongs amends Buki

Kamu Abguss Anwahl psalo
Branle Athar Aornum Balou
CIPA Uthaug Antholz Scalo
Phthalo Eichberg Äuglein branou

Sillä einfah Auslass walo
kovo ANSMANN Elkhart Vialou
Gratia otum alon Jijo
vzdalo Ekler Iken Datau

Calo anders OSTERN Wando
Gordo Auton Alvdal Palou
Scisco atzen erraz Calo
quirre Adson Attard Malou

Grantee Athos annuls Calo
Bope Augsteins aufdas Balou
haloa Agil Ehrhardts Kolo
Hounnou Evers ember Palou

Wcbjocwi aufJens Anhalt Mhiji
Herzo IMIN alters Szczuka
Plexi Einbein EINHORN halti
Chenwei altas iHeart Parla

Rewa although Uffeln Daici
blickte iHealth Ancien Günü
Knetzgau INFORMS Inhalt Sarri
LESTRA ESAT altert MURDA

Tikke erhalt Arbaaz Maiocchi
Note Arschkalt Englard stora
dale eintraegt altern septi
nari Ezin altiv Quincha

Flosse Osgood esfür halti
Ghatge Oswalt Umax ladha
Suse altern expel KLEPPI
LLVMpipe Ansätz altes Beröa

Fklzemeo approx Auriol töitä
lase Ohlmann oxblood Wianki
Cicco Arbeid Alox Heierlöh
Faaizah erfreuen Anbox danzhi

Pharma EeeBox abhaut Jäätä
gimme Isgur ElbSox Zumi
moete Alfen Alox Tädä
zdravja erschtmol Ibrox Lövei

Nache ecox Aidids määrä
Slope oxblood Erreur suoni
heeme Alberts Approx mistä
Nkumba Earbox Ersten Taqi

Reizfreie Ebet oxblood mieltä
Boxi EMBLEM Acral Zagi
Wouri Enox Usher määrä
Stuehle Anas Angad Moxi

Flusshaie Exxon austeilt Bago
Zpfdxove Ascher erlitt DISI
Zmvoxo Indian Adin Traesio
KENO unbdingt Exons WiTi

Rasoi Arzttum Airwheels Saxo
qxokpa Asians Iodes quegli
schlauere Orfeos Ewert toxo
vqaelxo Adul ARBURG Tosai

Sascho Istros AchimP luxo
Strecke Amoc Elem xorrii
zvala Inet Aqton seixo
Dimxoo archiv emisch Balzli

TAME Oinos Eilles Nzroxo
Reiki Axor Osler Saji
lovci Acton Auden Zaxo
DiGGi Exot aufknackt Faki

Bhille Opal Echoes Grüfte
Carti opal Exils Serhii
paleo Adverb Arcor VERSE
Wempe Ahmend Artes palih

Lubna opal istDas doodle
jrsplietau einafch Utpal BOSSI
Tesa Orwant Urhber spalte
flare Apax Austen palih

Jähne Einhon Inground Spalte
Biolo einwirft Aufpall Khojki
palih athlet Alterns sase
Sabria Opal ieiner kali

Duacha Isaacs iwann spalta
Bike opal Ehmkes KOGO
treilea Utpal Altaic Ralea
nielee abkann opal lembro

Chute ergoss ewell Spalti
wille Utpal anfrisst mfumo
pala Ontwerp IHUD Venti
NoVo Opal EBooks foto

Paluu Erdwolf Ahwaz Gwini
paldo Epid Elgin Csardi
Tebble opal einfuhr wifi
sparka axial Eifach palih

Spalla Afzal ALAN Macau
palta Anion Arcos siento
palju EITAN emit Schönau
lobe innland Erneuert paldo

Neanche Omarr Amend palta
Barfi aufgefhrt Axxis palo
Delia APOD ACOG Spala
longae Ehbrecht Ortmann paldo

Paro paso Alto pelu
Prego Peso parduz oro
Qzista sczeru moron ulu
Plano plado Paldo Aldo




Darauf einen Lotosblütenkakao, prost!

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


Tofu al dentist


Cozzi Auerwild Urschmerz hähä
galle Uunfun Einsen Shaozhou
Chaozhou arounds Osdorp Kieltä
Malmö Eozäns infer Tohu

Sütlü askoz Attems neljä
Woozle Idols Ehrhard Juru
wozu Alian APuZG nassüü
Nutzbau ITEC Ortsrecht joozu

Dozu Äxten Andrack tehdä
spatio Angoff Irmtraud Wozu
Sozi Ifans Olsberg jäätä
Tozzia Alsmanns absieht centru

Pourra Osteom eiter Knofi
Lurrie Uster Einstreuung kofu
ngoba abreiern exil stoffi
Krambe IPsoft Estar Zeltgrau

Chaozhou arounds Osdorp Kieltä
vzali Osburg Unschuld tozu
Roozbeh OpenMP Edger räikeää
Bozo Einbaum Answer Rehau

Mwangi Ulfried ofen ditthi
drove ofDoom embeds martu
Neglia Ijon Inwer Boffi
Tofu Ashdown openBC marzu

Zierde Extend ellen Sofi
maissa offset Alant kudzu
leihte Almhof autism Tingzhi
Baloo Ilten Olof vitu

Zune offbeat AKKUS tundi
togra Index Imhof labiau
Snofru inhalt Özgül Sulpsti
Strande anrührt Edoff puteau
............................................................................................................................

Ich gebe zu, heute bin ich ein bisschen albern.

Kommentare

Kommentar veröffentlichen

Beliebte Posts aus diesem Blog

·

Bild
. Der tiefste Punkt ist erreicht - und: Das bedeutet: Hoffnung »»»»»»»»»»»»»»»»»»»»»»»»»»» https://www.tagesschau.de/multimedia/sendung/tt-4763.html Aktualisiert vor 2 Stunden Dresden : Der Einheitstag als Farce Hunderte Unbelehrbare haben die Stimmung des Dresdner Einheitsfestes vergiftet. Das konnte geschehen, weil es Behörden an Sensibilität gegenüber rechtem Ungeist fehlt. Ein Kommentar von Tilman Steffen Vor 2 Stunden
Mehr anzeigen

Es brennt.

Seien wir doch ehrlich, es brennt irgendwie fast überall³³, und auch nicht erst seit gestern.* Vor G7-Gipfel: Donald Trump will in Frankreich mit fast allen reden - SPIEGEL ONLINE Brasilien: Emmanuel Macron erklärt Waldbrände zum "Notfall" - Bolsonaro wütend - SPIEGEL ONLINE Emmanuel Macron vor dem G7-Gipfel: Nach Biarritz mit Bravour - SPIEGEL ONLINE Wasserstoff: Merkel kündigt Wasserstoffstrategie für Luftfahrt an | ZEIT ONLINE Der Studium-Interessentest | ZEIT Campus Neurobiologie: Warum wir unsere Kindheitserlebnisse vergessen | ZEIT ONLINE Niedrigzinsen: Der deutsche Sparer gehört zu den Gewinnern | ZEIT ONLINE Strafzinsen: Schlecht beraten mit Markus Söder | ZEIT ONLINE Atomkraft: Diese interaktive Karte zeigt das Strahlenrisiko - SPIEGEL ONLINE Belgien: Betonprobleme bei weiteren Atommeilern - SPIEGEL ONLINE AKW GAU Simulation - Ausbreitungskarten Europa - Bild 2 - SPIEGEL ONLINE - Wirtschaft Deutschland kauft 189,5 Millionen Jodtabletten - fü
Mehr anzeigen

Bye, bye Nord Stream 2!

Bild
Nachdem, was Russland in Belarus macht (die noch nicht geklärten Dinge um Nawalny kommen wohl noch dazu), sollte Nord Stream sang- und klanglos beerdigt werden. Die Aktionen haben Folgen für sehr viele Menschen in Belarus, und das darf nicht ohne Folgen für Russland bleiben. Meine Meinung.   Opposition ist besorgt: Russland will notfalls Einsatzkräfte nach Belarus schicken | ZEIT ONLINE Belarus: Russlands Medien berichten widersprüchlich - Politik - SZ.de Zwischen den Fronten: Berichten aus Belarus | NDR.de - Fernsehen - Sendungen A-Z - ZAPP Belarus: Lukaschenko lässt russische Journalisten einfliegen | kurier.at Lukaschenka und sein Propaganda-Bruder Putin EU-Außenministertreffen: Erst Belarus, dann die Türkei Krise in Belarus: Lukaschenko bittet Russland um Polizeireserve Krise in Belarus: Tichanowskaja gegen Einmischung Russlands | tagesschau.de Nord Stream – Wikipedia Massenproteste in Belarus: Zahlreiche Festnahmen in Minsk - DER SPIEGEL    Lukaschenka hatte erkl
Mehr anzeigen