Ehct ksras!

[AND51]

Ehct ksras! Das ghet wicklirh!

Gmäeß eneir Sutide eneir elgnihcesn Uvinisterät, ist es nchit witihcg, in wlecehr Rneflogheie die Bstachuebn in eneim Wort snid, das ezniige was wcthiig ist, ist, dsas der estre und der leztte Bstabchue an der ritihcegn Pstoiion snid. Der Rset knan ein ttoaelr Bsinöldn sien, tedztorm knan man ihn onhe Pemoblre lseen. Das ist so, wiel wir nciht jeedn Bstachuebn enzelin leesn, snderon das Wrot als gseatems. Ehct ksras! Das ghet wicklirh!

Quelle: http://www.goko.de/

Weiß einer, wie man eine Prozedur schreibt, die Texte derartig umgestaltet?

[Leo]

Das ist alt .

Sylvia hat dazu auch schon eine Prozedur geschrieben .

[Sylvia]

Sylvia hat dazu auch schon eine Prozedur geschrieben

N€In, I¢H HÅB€ mI¢H £€DiG£I¢H €iN€® §Ø£¢H€N B€Di€n†.
hI€® I§† D€® GÅNg§†Å-Üb€®§€†z€® ¥ØØØ!!!

[Batze]

Das ist glaub ich nicht was er meint.
So enie Perzoudr slolte man dcoh railtev scehlnl hgrekeinin, oedr?

Code: Alles auswählen

Procedure SwapLetters(String.l, L1.l, L2.l)
  A = PeekB (String + L1 + 1)
  PokeB     (String + L1 + 1, PeekB (String + L2 + 1))
  PokeB     (String + L2 + 1, A)
  ProcedureReturn
EndProcedure

#Forbidden = ",.;:-_*/\()[]{}&<>$%=?!"+Chr(10)+Chr(13)+Chr(34)

Procedure.s MixText(Text$)
  For i=1 To CountString(Text$, " ")+1
    Wort$ = StringField(Text$, i, " ")
    L = Len(Wort$)-3
    If L > 0
      While FindString(#Forbidden, Mid(Wort$,L+3,1), 1) : L - 1 : Wend
      For j=0 To L*2
        SwapLetters(@Wort$, Random(L), Random(L))
      Next
    EndIf 
    Ausgabe$ + Wort$ + " "
  Next
  ProcedureReturn Ausgabe$
EndProcedure

Text$ = "Gemäß einer Studie einer englischen Universität, ist es nicht wichtig,"
Text$ + " in welcher Reihenfolge die Buchstaben in einem Wort sind."

Debug MixText(Text$)

Man müsste wohl noch ein par Abfragen nach , . : usw. einbauen, aber sonst dürfte es meistens genügen.
Edit: Jetzt sollte auch das gehen.

[Macros]

Ach nö Batze war schneller,
hier meine:

Code: Alles auswählen

NewList part.s()
#Forbidden = ",.;:-_*/\()[]{}&<>$%=?!"+Chr(10)+Chr(13)+Chr(34) 
Procedure.s mix(string.s)
  While StringField(string,a+1," ")
    c$=StringField(string,a+1," ")
    a+1
    If FindString(#Forbidden,Right(c$,1),0)
    x=2
    Else
    x=1
    EndIf
    For b=2 To Len(c$)-x
      AddElement(part.s())
      part()=Mid(c$,b,1)
    Next
    output$+Left(c$,1)
    While CountList(part())
      SelectElement(part(),Random(CountList(part())))
      output$+part()
      DeleteElement(part())
    Wend
    output$+Right(c$,x)+" "
  Wend
  ProcedureReturn output$
EndProcedure 

[Batze]

Vom Ansatz her wohl die gleiche Idee gehabt.

[Macros]

Ja, daher gehen bei mir ja auch die ,.: ... nicht

[Batze]

Ist mir auch nur wegen dem Beispieltext aufgefallen, aber ich hatte keinen Bock das noch zu ändern.

Edit:
Meine hat aber eine recht hohe Fehlerquote (Wort bleibt gleich)

Code: Alles auswählen

Text$ = "Gemäß einer Studie einer englischen Universität , ist es nicht wichtig ,"
Text$ + " in welcher Reihenfolge die Buchstaben in einem Wort sind ."

Repeat
  B$ = MixText(Text$)
  If Nr % 1000 = 0
    Debug B$
  EndIf
  Nr + 1
Until FindString(B$, "Universität", 0)
Debug Nr
Beep_(750,300)

Bei mir am schnellsten nach 18659 Durchgängen.

[Macros]

So, meiner versteht jetzt auch Kommas

Code: Alles auswählen

NewList part.s()
#Forbidden = ",.;:-_*/\()[]{}&<>$%=?!"+Chr(10)+Chr(13)+Chr(34) 
Procedure.s mix(string.s)
  While StringField(string,a+1," ")
    c$=StringField(string,a+1," ")
    a+1
    If FindString(#Forbidden,Right(c$,1),0)
    x=2
    Else
    x=1
    EndIf
    For b=2 To Len(c$)-x
      AddElement(part.s())
      part()=Mid(c$,b,1)
    Next
    output$+Left(c$,1)
    While CountList(part())
      SelectElement(part(),Random(CountList(part())))
      output$+part()
      DeleteElement(part())
    Wend
    output$+Right(c$,x)+" "
  Wend
  ProcedureReturn output$
EndProcedure 

Edit: sofern sie schön nach Grammatik
in der form " wort, Wort " stehen

[Macros]

[Angeb]meiner erst nach 612471 [/Angeb]