PureBoard

Verfasst: **06.01.2006 20:58**

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?

Verfasst: **06.01.2006 21:03**

Das ist alt

.

Sylvia hat dazu auch schon eine Prozedur geschrieben

.

Verfasst: **06.01.2006 21:16**

Leo hat geschrieben: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€® ¥ØØØ!!!

Verfasst: **06.01.2006 21:38**

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.

Verfasst: **06.01.2006 21:56**

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

Verfasst: **06.01.2006 21:59**

Vom Ansatz her wohl die gleiche Idee gehabt.

Verfasst: **06.01.2006 22:01**

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

Verfasst: **06.01.2006 22:04**

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.

Verfasst: **06.01.2006 22:11**

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

Verfasst: **06.01.2006 22:16**

[Angeb]meiner erst nach 612471 [/Angeb]