XProfan

Titre de la fenêtre "TEXTANALYSE: Häufigkeit de Textelementen ermitteln"
'(CL) CopyLeft 2014-10 by P.Specht, Wien; sans chacun Gewähr!
Init:
Fenêtre Style 24
Déclarer text$,t$[],v&[],n&,w$[],h&[],m&,i&,j&,wd$,gef&,maxh&,maxw$
Déclarer kk$,kl&,clé$[]
Beginn:
Font 2:randomize:CLS rnd(8^8)
TEXT_EINLESEN
' TEXTVORBEREITUNG, modifié den eingelesenen Text! Alternative: sur Duplikat travailler...
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 $[]):imprimer " ";n&;" Textteile aufbereitet."
' UNIFIZIERUNG: chez Wörtern seulement 1. Vorkommen Sauver, pour Häufigkeit zählen:
m&=-1:maxh&=0:whileloop 0,n&-1:i&=&Boucle:wd$=t $[i&]
locate 1,1:imprimer tab(69);mid$("--\\||//",1+(m& mod 8),1);'AKTIVITÄTS-MARKER

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

    d'autre :gef&=0:whileloop 0,m&:j&=&Boucle:si w$[j&]=wd$:h&[j&]=h&[j&]+1
    ' qui folgende la ligne wird seulement gebraucht, si Häufigkeit h&[] im Schlüsselfeld k$[] 'invertiert'...

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

        gef&=1:pause :endif :endwhile :cas gef&:continue : inc m&:w$[m&]=wd$:h&[m&]=1:endif :endwhile
        imprimer "\n ";int(m&+1);" verschiedene Worte ou bien marque trouvé.\n"
        imprimer " Häufigstes Textelement:  ";chr$(34);maxw$;chr$(34),"<";maxh&;">"
        ' SCHLÜSSELFELD SCHAFFEN
        ' but: Pour Häufigkeit h&[] absteigend, mais dedans Häufigkeitsgruppe Worte w$[] aufsteigend!
        setsize clé$[],m&+1:kl&=int(lg(m&)):kk$=mkstr$("0",kl&):kl&=kl&+1
        ' TRICK: là seulement aufsteigende Indexierung disponible, wird Schlüsselfeld gespiegelt à Maxh&:
        h&[]= maxh&-h&[&index]
        clé$[] = right$( kk$+str$(h&[&index]),kl&)+w$[&index]
        h&[]= maxh&-h&[&index]' dans Original rückwandeln, alternativ pourrait on separates Array aufbauen
        ' INDEXIEREN DES SCHLÜSSELFELDES: pour champ h&[] absteigend et champ w$[] aufsteigend
        setsize v&[],m&+1
        v&[]=QuickIndex$Up(clé$[])
        ' Aufräumen
        Claire clé$[]' ici pas plus nécessaire
        '{ AUSGABE
        imprimer "\n Text-Elemente pour Häufigkeit: "
        imprimer "----------------------------------------------------------"

        whileloop 0,m&

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

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

            endwhile

            imprimer "----------------------------------------------------------"
            '}
            BEEP:Waitinput
            Imprimer " Wiedersehen!"
            waitinput 6000
            FIN

            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

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

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

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

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

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

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

                                        si (j&-l&)<(r&-i&):si i&<r&:inc s&:sl&[s&]=i&:sr&[s&]=r&:endif :r&=j&:d'autre

                                            si 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. avec LOREM IPSUM initialisieren

                                                Text$="The quick brown fox jumps over le lazy dog. \n\n" +\
                                                "Lorem Ipsum est un einfacher Demo-Text pour qui Imprimer- et Schriftindustrie. "+\
                                                "Lorem Ipsum ist dans qui industrie bereits qui Standard Demo-Text depuis 1500, comme "+\
                                                "ein unbekannter Schriftsteller une main voll Wörter nahm et cet durcheinander "+\
                                                "warf um un Musterbuch trop erstellen. Es hat pas seulement 5 Jahrhunderte überlebt, "+\
                                                "sondern aussi dans Spruch dans qui elektronische Schriftbearbeitung geschafft (bemerke, "+\
                                                "nahezu inchangé). Bekannt wurde es 1960, avec dem erscheinen de 'Letraset', "+\
                                                "welches Passagen de Lorem Ipsum enthielt, so comment Desktop Software comment 'Aldus PageMaker' "+\
                                                "- également avec Lorem Ipsum. " +\
                                                "Es est un long erwiesener Fakt, dass un Leser vom Text abgelenkt wird, si il sich "+\
                                                "ein Layout ansieht. qui Punkt, Lorem Ipsum trop nutzen, ist, dass es plus ou bien moins "+\
                                                "die normale Anordnung de Buchstaben darstellt et somit pour lesbarer Discours aussieht. "+\
                                                "Viele Desktop Publisher et Webeditoren nutzen mittlerweile Lorem Ipsum comme den "+\
                                                "Standardtext, aussi qui cherche im Internet pour 'lorem ipsum' pouvoir viele Webseiten sichtbar, "+\
                                                "wo cet encore toujours vorkommen. Mittlerweile gibt es plusieurs Versionen des Lorem Ipsum, "+\
                                                "einige zufällig, autre bewusst (beeinflusst de Witz et des eigenen Geschmacks). \n\n" +\
                                                \
                                                "Glauben ou bien pas croyons, Lorem Ipsum ist pas seulement un zufälliger Text. il hat "+\
                                                "Wurzeln aus qui Lateinischen Literatur de 45 v. Chr, quoi ihn sur 2000 Jahre vieux pouvoir. "+\
                                                "Richar McClintock, un Lateinprofessor des Hampden-Sydney College dans Virgnia untersuche "+\
                                                "einige undeutliche Worte, 'consectetur', einer Lorem Ipsum passage et fand une "+\
                                                "unwiederlegbare source. Lorem Ipsum komm aus qui Sektion 1.10.32 et 1.10.33 des "+\
                                                "'de Finibus Bonorum et Malorum' (qui Extreme de bien et Böse) de Cicero, geschrieben "+\
                                                "45 v. Chr. cet livre ist traité qui Ethiktheorien, très bekannt wärend qui Renaissance. "+\
                                                "Die erste la ligne des Lorem Ipsum, ''Lorem ipsum dolor sit amet...'', venez aus einer la ligne "+\
                                                "der Sektion 1.10.32. \n"+\
                                                \
                                                "Der Standardteil de Lorem Ipsum, genutzt depuis 1500, ist reproduziert pour qui, qui es "+\
                                                "interessiert. Sektion 1.10.32 et 1.10.33 de ''de Finibus Bonorum et Malroum'' de Cicero "+\
                                                "sind aussi reproduziert dans ihrer Originalform, abgeleitet de qui Englischen Version aus "+\
                                                "von 1914 (H. Rackham).\n\n"+\
                                                \
                                                "Es gibt viele Variationen qui Passages des Lorem Ipsum, mais qui Hauptteil erlitt Changements "+\
                                                "in irgendeiner forme, par Humor ou bien zufällige Wörter quelle pas einmal ansatzweise "+\
                                                "glaubwürdig air. si du une passage des Lorem Ipsum utilise, devrait du aufpassen, dass "+\
                                                "in qui Mitte des Textes aucun ungewollten Wörter stehen. Viele qui Generatoren im Internet "+\
                                                "neigen en supplément, vorgefertigte Stücke trop wiederholen - quoi es nötig machte, une richtigen "+\
                                                "Generator trop entwickeln. Wir nutzen un Wörterbuch aus sur 200 Lateinischen Wörter, "+\
                                                "kombiniert avec einer Handvoll Kunstsätzen, quelle cela Lorem Ipsum glaubwürdig pouvoir. "+\
                                                "Das generierte Lorem Ipsum ist aussi libre de Wiederholungen, Humor ou bien unqualifizierten "+\
                                                "Bemerkungen etc. qui Text selbs peux sur https://de.lipsum.com/feed/html erzeugt werden"

                                            ENDPROC

                                            PROGEND