XProfan

WindowTitle "TEXTANALYSE: Häufigkeit von Textelementen ermitteln"
'(CL) CopyLeft 2014-10 by P.Specht, Wien; Ohne jede Gewähr!
Init:
WindowStyle 24
Declare text$,t$[],v&[],n&,w$[],h&[],m&,i&,j&,wd$,gef&,maxh&,maxw$
Declare kk$,kl&,key$[]
Beginn:
Font 2:randomize:CLS rnd(8^8)
TEXT_EINLESEN
' TEXTVORBEREITUNG, verändert den eingelesenen Text! Alternative: Auf Duplikat arbeiten...
text$=translate$(text$,"\n"," "):text$=translate$(text$,"\t"," ")
text$=translate$(text$,"."," . "):text$=translate$(text$,","," , ")
text$=translate$(text$,"!"," ! "):text$=translate$(text$,"?"," ? ")
text$=translate$(text$,"-"," - "):text$=translate$(text$,"("," ( ")
text$=translate$(text$,")"," )"):text$=translate$(text$,"'"," ' ")
text$=translate$(text$,"´"," ´ "):text$=translate$(text$,"'"," ' ")
text$=translate$(text$,":"," : "):text$=translate$(text$,"  "," ")
text$=translate$(text$,"  "," "):text$=translate$(text$,""," \ \ ")
text$=translate$(text$,"//"," / / ")
t$[]=explode(text$," "):t$[]=upper$(t$[&index])
n&=sizeof(t$[]):print " ";n&;" Textteile aufbereitet."
' UNIFIZIERUNG: Bei Wörtern nur 1. Vorkommen speichern, dafür Häufigkeit zählen:
m&=-1:maxh&=0:whileloop 0,n&-1:i&=&Loop:wd$=t$[i&]
locate 1,1:print tab(69);mid$("--\\||//",1+(m& mod 8),1);'AKTIVITÄTS-MARKER

if m&=-1:w$[0]=wd$:h&[0]=1:m&=0

    else :gef&=0:whileloop 0,m&:j&=&Loop:if w$[j&]=wd$:h&[j&]=h&[j&]+1
    ' Die folgende Zeile wird nur gebraucht, wenn Häufigkeit h&[] im Schlüsselfeld k$[] 'invertiert'...

    if maxh&<h&[j&]:maxh&=h&[j&]:maxw$=w$[j&]:endif' ... werden muss { h&[]=maxh-h&[&index] }

        gef&=1:break :endif :endwhile :case gef&:continue : inc m&:w$[m&]=wd$:h&[m&]=1:endif :endwhile
        print "\n ";int(m&+1);" verschiedene Worte oder Zeichen gefunden.\n"
        print " Häufigstes Textelement:  ";chr$(34);maxw$;chr$(34),"<";maxh&;">"
        ' SCHLÜSSELFELD SCHAFFEN
        ' Ziel: Nach Häufigkeit h&[] absteigend, aber innerhalb Häufigkeitsgruppe Worte w$[] aufsteigend!
        setsize key$[],m&+1:kl&=int(lg(m&)):kk$=mkstr$("0",kl&):kl&=kl&+1
        ' TRICK: Da nur aufsteigende Indexierung verfügbar, wird Schlüsselfeld gespiegelt an Maxh&:
        h&[]= maxh&-h&[&index]
        key$[] = right$( kk$+str$(h&[&index]),kl&)+w$[&index]
        h&[]= maxh&-h&[&index]' in Original rückwandeln, alternativ könnte man separates Array aufbauen
        ' INDEXIEREN DES SCHLÜSSELFELDES: nach Feld h&[] absteigend und Feld w$[] aufsteigend
        setsize v&[],m&+1
        v&[]=QuickIndex$Up(key$[])
        ' Aufräumen
        Clear key$[]' hier nicht mehr benötigt
        '{ AUSGABE
        print "\n Text-Elemente nach Häufigkeit: "
        print "----------------------------------------------------------"

        whileloop 0,m&

            print " ";int(1+&Loop);". ";tab(7);" <";h&[v&[&Loop]];"> ";w$[v&[&Loop]];" "

            if %csrlin>30:waitinput:cls rnd(8^8):endif'<<<je nach Monitorauflösung

            endwhile

            print "----------------------------------------------------------"
            '}
            BEEP:Waitinput
            Print " Wiedersehen!"
            waitinput 6000
            END

            proc QuickIndex$Up :parameters a$[]

                declare n&,p&,l&,r&,s&,sl&[],sr&[],w$,t&,x$,i&,j&,v&[]
                n&=sizeof(a$[]):s&=1:setsize v&[],n&:v&[]=&index:s&=1:sl&[1]=0:sr&[1]=n&-1

                while s&>0:l&=sl&[s&]:r&=sr&[s&]:dec s&:while l&<r&:i&=l&:j&=r&:p&=(l&+r&)\2

                    if a$[v&[l&]]>a$[v&[p&]]:w$=v&[l&]:v&[l&]=v&[p&]:v&[p&]=w$:endif

                        if a$[v&[l&]]>a$[v&[r&]]:w$=v&[l&]:v&[l&]=v&[r&]:v&[r&]=w$:endif

                            if a$[v&[p&]]>a$[v&[r&]]:w$=v&[p&]:v&[p&]=v&[r&]:v&[r&]=w$:endif :x$=a$[v&[p&]]

                                while i&<=j&:while a$[v&[i&]]<x$:inc i&:endwhile :while x$<a$[v&[j&]]:dec j&:endwhile

                                    if i&<=j&:t&=v&[i&]:v&[i&]=v&[j&]:v&[j&]=t&:inc i&:dec j&:endif :endwhile

                                        if (j&-l&)<(r&-i&):if i&<r&:inc s&:sl&[s&]=i&:sr&[s&]=r&:endif :r&=j&:else

                                            if l&<j&:inc s&:sl&[s&]=l&:sr&[s&]=j&:endif :l&=i&:endif :endwhile :endwhile

                                                return v&[]

                                            endproc

                                            proc TEXT_EINLESEN'Eingabeteil: Text$ z.B. mit LOREM IPSUM initialisieren

                                                Text$="The quick brown fox jumps over the lazy dog. \n\n" +\
                                                "Lorem Ipsum ist ein einfacher Demo-Text für die Print- und Schriftindustrie. "+\
                                                "Lorem Ipsum ist in der Industrie bereits der Standard Demo-Text seit 1500, als "+\
                                                "ein unbekannter Schriftsteller eine Hand voll Wörter nahm und diese durcheinander "+\
                                                "warf um ein Musterbuch zu erstellen. Es hat nicht nur 5 Jahrhunderte überlebt, "+\
                                                "sondern auch in Spruch in die elektronische Schriftbearbeitung geschafft (bemerke, "+\
                                                "nahezu unverändert). Bekannt wurde es 1960, mit dem erscheinen von 'Letraset', "+\
                                                "welches Passagen von Lorem Ipsum enthielt, so wie Desktop Software wie 'Aldus PageMaker' "+\
                                                "- ebenfalls mit Lorem Ipsum. " +\
                                                "Es ist ein lang erwiesener Fakt, dass ein Leser vom Text abgelenkt wird, wenn er sich "+\
                                                "ein Layout ansieht. Der Punkt, Lorem Ipsum zu nutzen, ist, dass es mehr oder weniger "+\
                                                "die normale Anordnung von Buchstaben darstellt und somit nach lesbarer Sprache aussieht. "+\
                                                "Viele Desktop Publisher und Webeditoren nutzen mittlerweile Lorem Ipsum als den "+\
                                                "Standardtext, auch die Suche im Internet nach 'lorem ipsum' macht viele Webseiten sichtbar, "+\
                                                "wo diese noch immer vorkommen. Mittlerweile gibt es mehrere Versionen des Lorem Ipsum, "+\
                                                "einige zufällig, andere bewusst (beeinflusst von Witz und des eigenen Geschmacks). \n\n" +\
                                                \
                                                "Glauben oder nicht glauben, Lorem Ipsum ist nicht nur ein zufälliger Text. Er hat "+\
                                                "Wurzeln aus der Lateinischen Literatur von 45 v. Chr, was ihn über 2000 Jahre alt macht. "+\
                                                "Richar McClintock, ein Lateinprofessor des Hampden-Sydney College in Virgnia untersuche "+\
                                                "einige undeutliche Worte, 'consectetur', einer Lorem Ipsum Passage und fand eine "+\
                                                "unwiederlegbare Quelle. Lorem Ipsum komm aus der Sektion 1.10.32 und 1.10.33 des "+\
                                                "'de Finibus Bonorum et Malorum' (Die Extreme von Gut und Böse) von Cicero, geschrieben "+\
                                                "45 v. Chr. Dieses Buch ist Abhandlung der Ethiktheorien, sehr bekannt wärend der Renaissance. "+\
                                                "Die erste Zeile des Lorem Ipsum, ''Lorem ipsum dolor sit amet...'', kommt aus einer Zeile "+\
                                                "der Sektion 1.10.32. \n"+\
                                                \
                                                "Der Standardteil von Lorem Ipsum, genutzt seit 1500, ist reproduziert für die, die es "+\
                                                "interessiert. Sektion 1.10.32 und 1.10.33 von ''de Finibus Bonorum et Malroum'' von Cicero "+\
                                                "sind auch reproduziert in ihrer Originalform, abgeleitet von der Englischen Version aus "+\
                                                "von 1914 (H. Rackham).\n\n"+\
                                                \
                                                "Es gibt viele Variationen der Passages des Lorem Ipsum, aber der Hauptteil erlitt Änderungen "+\
                                                "in irgendeiner Form, durch Humor oder zufällige Wörter welche nicht einmal ansatzweise "+\
                                                "glaubwürdig aussehen. Wenn du eine Passage des Lorem Ipsum nutzt, solltest du aufpassen, dass "+\
                                                "in der Mitte des Textes keine ungewollten Wörter stehen. Viele der Generatoren im Internet "+\
                                                "neigen dazu, vorgefertigte Stücke zu wiederholen - was es nötig machte, einen richtigen "+\
                                                "Generator zu entwickeln. Wir nutzen ein Wörterbuch aus über 200 Lateinischen Wörter, "+\
                                                "kombiniert mit einer Handvoll Kunstsätzen, welche das Lorem Ipsum glaubwürdig macht. "+\
                                                "Das generierte Lorem Ipsum ist außerdem frei von Wiederholungen, Humor oder unqualifizierten "+\
                                                "Bemerkungen etc. Der Text selbs kann auf https://de.lipsum.com/feed/html erzeugt werden"

                                            Endproc

                                            PROGEND