XProfan

Título de la ventana "TEXTANALYSE: Häufigkeit de Textelementen ermitteln"
'(CL) CopyLeft 2014-10 by P.Pájaro carpintero, Wien; Ohne jede Gewähr!
Init:
Ventana de Estilo 24
Declarar texto$,t$[],v&[],n&,w$[],h&[],m&,i&,j&,wd$,gef&,maxh&,maxw$
Declarar kk$,kl&,key$[]
Beginn:
Font 2:randomize:CLS rnd(8^8)
TEXT_EINLESEN
' TEXTVORBEREITUNG, verändert el eingelesenen Texto! Alternative: Auf Duplikat trabajo...
text$=translate$(texto$,"\n"," "):texto$=translate$(texto$,"\t"," ")
text$=translate$(texto$,"."," . "):texto$=translate$(texto$,","," , ")
text$=translate$(texto$,"!"," ! "):texto$=translate$(texto$,"?"," ? ")
text$=translate$(texto$,"-"," - "):texto$=translate$(texto$,"("," ( ")
text$=translate$(texto$,")"," )"):texto$=translate$(texto$,"'"," ' ")
text$=translate$(texto$,"´"," ´ "):texto$=translate$(texto$,"'"," ' ")
text$=translate$(texto$,":"," : "):texto$=translate$(texto$,"  "," ")
text$=translate$(texto$,"  "," "):texto$=translate$(texto$,""," \ \ ")
text$=translate$(texto$,"//"," / / ")
t$[]=explode(texto$," "):t$[]=upper$(t$[&index])
n&=sizeof(t$[]):imprimir " ";n&;" Textteile aufbereitet."
' UNIFIZIERUNG: En Wörtern sólo 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:imprimir tab(69);mid$("--\\||//",1+(m& mod 8),1);'AKTIVITÄTS-MARKER

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

    más :gef&=0:whileloop 0,m&:j&=&Loop:if w$[j&]=wd$:h&[j&]=h&[j&]+1
    ' El folgende Línea se sólo gebraucht, si Häufigkeit h &[] en el Schlüsselfeld k$[] 'invertiert'...

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

        gef&=1:romper :endif :endwhile :caso gef&:continue : inc m&:w$[m&]=wd$:h&[m&]=1:endif :endwhile
        imprimir "\n ";int(m&+1);" verschiedene Worte oder Signo gefunden.\n"
        imprimir " 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: Como sólo aufsteigende Indexierung verfügbar, se Schlüsselfeld gespiegelt a Maxh&:
        h&[]= maxh&-h&[&index]
        key$[] = right$( kk$+str$(h&[&index]),kl&)+w$[&index]
        h&[]= maxh&-h&[&index]' en Original rückwandeln, alternativ podría uno separates Array aufbauen
        ' INDEXIEREN DES SCHLÜSSELFELDES: después de Feld h &[] absteigend y Feld w$[] aufsteigend
        setsize v&[],m&+1
        v&[]=QuickIndex$Up(key$[])
        ' Aufräumen
        Claro key$[]' hier no mehr benötigt
        '{ AUSGABE
        imprimir "\n Texto-Elemente después de Häufigkeit: "
        imprimir "----------------------------------------------------------"

        whileloop 0,m&

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

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

            endwhile

            imprimir "----------------------------------------------------------"
            '}
            BEEP:Waitinput
            Imprimir " Wiedersehen!"
            waitinput 6000
            FIN

            proc QuickIndex$Up :parámetros a$[]

                declarar 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

                mientras que s&>0:l&=sl&[s&]:r&=sr&[s&]:dec s&:mientras que 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&]]

                                mientras que i&<=j&:mientras que a$[v&[i&]]<x$:inc i&:endwhile :mientras que 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&:más

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

                                                volver v&[]

                                            ENDPROC

                                            proc TEXT_EINLESEN'Eingabeteil: Texto$ z.B. con LOREM IPSUM inicializar

                                                Texto$="The quick brown fox jumps over the lazy dog. \n\n" +\
                                                "Lorem Ipsum es una einfacher Demo-Texto para el Imprimir- y Schriftindustrie. "+\
                                                "Lorem Ipsum es en el Industrie ya el Standard Demo-Texto seit 1500, como "+\
                                                "ein unbekannter Schriftsteller una Hand voll Wörter nahm y esta durcheinander "+\
                                                "warf en una Musterbuch a redactar. Lo ha no sólo 5 Jahrhunderte überlebt, "+\
                                                "sondern auch en Spruch en el elektronische Schriftbearbeitung geschafft (bemerke, "+\
                                                "nahezu unverändert). Bekannt wurde lo 1960, con el erscheinen de 'Letraset', "+\
                                                "welches Passagen de Lorem Ipsum enthielt, como Desktop Software como 'Aldus PageMaker' "+\
                                                "- ebenfalls con Lorem Ipsum. " +\
                                                "Es es una lang erwiesener Fakt, que un Leser vom Texto abgelenkt se, si él se "+\
                                                "ein Layout ansieht. Der Punkt, Lorem Ipsum a nutzen, es, dass lo o más weniger "+\
                                                "die normale Anordnung de Buchstaben darstellt y somit después de lesbarer Lingua aussieht. "+\
                                                "Viele Desktop Publisher y Webeditoren nutzen mittlerweile Lorem Ipsum como el "+\
                                                "Standardtext, auch el Búsqueda Internet después de 'lorem ipsum' macht viele Webseiten sichtbar, "+\
                                                "wo esta todavía siempre vorkommen. Mittlerweile hay mehrere Versionen des Lorem Ipsum, "+\
                                                "einige zufällig, otro bewusst (beeinflusst de Witz y des eigenen Geschmacks). \n\n" +\
                                                \
                                                "Glauben oder no glauben, Lorem Ipsum es no sólo una zufälliger Texto. Er ha "+\
                                                "Wurzeln de el Lateinischen Literatur de 45 v. Chr, qué ihn encima 2000 Jahre alt macht. "+\
                                                "Richar McClintock, una Lateinprofessor des Hampden-Sydney College en Virgnia untersuche "+\
                                                "einige undeutliche Worte, 'consectetur', uno Lorem Ipsum Passage y fand una "+\
                                                "unwiederlegbare Quelle. Lorem Ipsum komm de el Sektion 1.10.32 y 1.10.33 des "+\
                                                "'de Finibus Bonorum et Malorum' (El Extreme de Gut y Böse) de Cicero, geschrieben "+\
                                                "45 v. Chr. Dieses Buch es Abhandlung el Ethiktheorien, muy bekannt wärend el Renaissance. "+\
                                                "Die erste Línea des Lorem Ipsum, ''Lorem ipsum dolor sit amet...'', kommt de uno Línea "+\
                                                "der Sektion 1.10.32. \n"+\
                                                \
                                                "Der Standardteil de Lorem Ipsum, genutzt seit 1500, es reproduziert para el, el lo "+\
                                                "interessiert. Sektion 1.10.32 y 1.10.33 de ''de Finibus Bonorum et Malroum'' de Cicero "+\
                                                "sind auch reproduziert en ihrer Originalform, abgeleitet de el Englischen Versión de "+\
                                                "von 1914 (H. Rackham).\n\n"+\
                                                \
                                                "Es son viele Variationen el Passages des Lorem Ipsum, pero la Hauptteil erlitt Los cambios "+\
                                                "in irgendeiner Form, por Humor oder zufällige Wörter welche no una vez ansatzweise "+\
                                                "glaubwürdig aussehen. Wenn du una Passage des Lorem Ipsum nutzt, solltest du aufpassen, dass "+\
                                                "in el Mitte des Textes no ungewollten Wörter posición. Viele el Generatoren Internet "+\
                                                "neigen dazu, vorgefertigte Stücke a wiederholen - qué lo nötig machte, una richtigen "+\
                                                "Generator para desarrollar. Wir nutzen una Wörterbuch de encima 200 Lateinischen Wörter, "+\
                                                "kombiniert con uno Handvoll Kunstsätzen, welche el Lorem Ipsum glaubwürdig macht. "+\
                                                "Das generierte Lorem Ipsum es außerdem frei de Wiederholungen, Humor oder unqualifizierten "+\
                                                "Bemerkungen etc. Der Texto selbs podrá, a https://de.lipsum.com/feed/html producido werden"

                                            ENDPROC

                                            PROGEND