PureBasic Forums - English

Posted: **Sat May 09, 2009 8:49 am**

Hello

A little script to generate randome name.
I adapted a code I found. My code it's not clean.
I'm not happy from the result. but this run ok !
If you know a better code to generate random name please share it !
best regards !

Code: Select all

;Source:http://www.uselesspython.com/download.php?script_id=32

;Init fricatives
Restore fricatives
Global Dim fricatives.s(1);
n.l=0;
While fricatives(n)<>"*" 
  n+1
  ReDim fricatives.s(n)
  Read.s fricatives(n)
Wend
;Init vowels
Restore vowels
Global Dim vowels.s(1);
n.l=0;
While vowels(n)<>"*" 
  n+1
  ReDim vowels.s(n)
  Read.s vowels(n)
Wend
;Init consonantsNormal
Restore consonantsNormal
Global Dim consonantsNormal.s(1);
n.l=0;
While consonantsNormal(n)<>"*" 
  n+1
  ReDim consonantsNormal.s(n)
  Read.s consonantsNormal(n)
Wend
Restore consonantsNasal
Global Dim consonantsNasal.s(1);
n.l=0;
While consonantsNasal(n)<>"*" 
  n+1
  ReDim consonantsNasal.s(n)
  Read.s consonantsNasal(n)
Wend

Global result.s, vowelSyllables.l, randomLength.l, vowelRatio.l,syllableOnlyVowels.l

Declare maincongen()
Declare sylgen()
Declare fricgen()
Declare vowgen()
Declare congen()
Declare con2gen()
Declare con3gen()

Procedure.s namegen(ratio.l=5, lower_limit.l=3, upper_limit.l=11)
    ratio = ratio + 3
    If ratio < 4:
        ratio = 4
    ElseIf ratio > 14:
        ratio = 14
    EndIf
    vowelRatio = ratio
    result = ""
    vowelSyllables = 0
    randomLength = Random(upper_limit-lower_limit)+lower_limit
    sylgen()
ProcedureReturn result
EndProcedure


Procedure sylgen()
    syllableOnlyVowels = 1
    maincongen()
    If vowelSyllables < (vowelRatio/4):
        vowgen()
    EndIf
    maincongen()
    If syllableOnlyVowels = 1:
        vowelSyllables = vowelSyllables + 1
    EndIf
    If Len(result) < randomLength:
        sylgen()
    EndIf
EndProcedure


Procedure fricgen()
     result = result + fricatives(Random(ArraySize(fricatives())-1))
    syllableOnlyVowels = 0
    vowelSyllables = 0
EndProcedure


Procedure vowgen()
    result = result + vowels(Random(ArraySize(vowels())-1))
EndProcedure

Procedure congen()
    result = result + consonantsNormal(Random(ArraySize(consonantsNormal())-1))
    syllableOnlyVowels = 0
    vowelSyllables = 0
EndProcedure

Procedure con2gen()
    If Random(2) = 0:
        result = result + "r"
    Else:
        result = result + "l"
    EndIf
    syllableOnlyVowels = 0
    vowelSyllables = 0
EndProcedure

Procedure con3gen():
    result = result + consonantsNasal(Random(ArraySize(consonantsNasal())-1))
    syllableOnlyVowels = 0
    vowelSyllables = 0
EndProcedure


Procedure maincongen()
    
    If Len(result) < randomLength:
        randomNumber = Random(vowelRatio)
        If randomNumber = 0:
            fricgen()
            If Len(result) < randomLength:
                randomNumber = Random(vowelRatio/4 * 3)
                If randomNumber = 0:
                    congen()
                    If Len(result) < randomLength:
                        randomNumber = Random(vowelRatio/2)
                        If randomNumber = 0:
                            con2gen()
                        EndIf
                    EndIf
                ElseIf randomNumber = 1:
                    con2gen()
                ElseIf randomNumber = 2:
                    con3gen()
                EndIf
            EndIf
        ElseIf randomNumber = 1:
            congen()
            If Len(result) < randomLength:
                randomNumber = Random(vowelRatio/2)
                If randomNumber = 0:
                    con2gen()
                EndIf
            EndIf
        ElseIf randomNumber = 2:
            con2gen()
        ElseIf randomNumber = 3:
            con3gen()
        EndIf
  EndIf
EndProcedure

For z=1 To 10
  Debug namegen(Random(10))
Next
DataSection
fricatives:
Data.s  "j", "ch", "h", "s", "sh", "th", "f", "v", "z","*"
vowels:
Data.s  "a", "e", "i", "o", "u", "y", "ya", "ye", "yi", "yo", "yu", "wa", "we", "wi", "wo", "wu", "ae", "au", "ei", "ie", "io", "iu", "ou", "uo", "oi", "oe", "ea","*"
consonantsNormal:
Data.s  "c", "g", "t", "d", "p", "b", "x", "k", "ck", "ch","*"
consonantsNasal:
Data.s  "n", "m", "ng", "nc","*"
EndDataSection

Posted: **Sat May 09, 2009 11:09 am**

my version

Code: Select all



Procedure.s alea_name(longueur) 
    
    ; by dobro
    RandomSeed(Random(1000))
    Dim voy.s (6) : voy(1)="A": voy(2)="O": voy(3)="I": voy(4)="E": voy(5)="U"
    For i=2 To longueur Step 2 
        de_voyelle=Random(4)+1
        d:
        de_consone=Random(25)+1 ; 65 a 90
        If (de_consone+64<>65) And  (de_consone+64<>79) And (de_consone+64<>73) And (de_consone+64<>69) And (de_consone+64<>85) And (de_consone+64<>89)
            nom$=nom$+Chr(de_consone+64)+voy(de_voyelle)
        Else
            RandomSeed(Random(1000))
            Goto d:
        EndIf 
    Next i
    ProcedureReturn LCase(nom$ )
EndProcedure

; mise en application

For i= 1 To 50 ; on genere 50 nom de longueur variable entre 4 et 8 caracteres
    
    longueur=Random(4)+4 
    Debug alea_name(longueur)
Next i

Posted: **Sat May 09, 2009 1:03 pm**

my approach from Nov.2004

alternating vowels and consonats following a few rules.

corrected for 4.3, but didn't experiment with the flags again.

Code: Select all

; Flags:
; 0 = may be followed by any next
; 1 = may be followed by any next except itself
; 2 = may be followed by any next except special
; 4 = is special
;
; e.g.: 6 = is special and may be followed only by not-special

Global Dim Char$(1)
Global Dim ChFl$(1)

Char$(0) = "aeiouy"                 ; all vowels
ChFl$(0) = "002015"                 ; their flags
Char$(1) = "bcdfghjklmnpqrstvwxz"   ; all consonants
ChFl$(1) = "04000111000030400020"   ; their flags

Procedure.s Create_Name(Lang.l)

  n.l
  Nummer.l
  NumFlg.l
  DopFlg.l = 0
  Out$ = ""
  Wrk$ = ""
  Typ.l = Random(1) ; type of first char: vowel or consonant
 
  For n = 1 To Lang
 
    Repeat
 
      Nummer = 1+Random(5+Typ*14) ; 6 vowels, 20 consonants....
      NumFlg = Val( Mid( ChFl$(Typ), Nummer, 1) )
      Weiter = 1
     
      If DopFl > 0

        If (LastFlg & 1)= 1 And Nummer = LastNum : Weiter=0 : EndIf
        ; Flag & 1 may not follow itself

      EndIf
     
        If (LastFlg & 2)= 2 And (NumFlg & 4)= 4 : Weiter=0 : EndIf
        ; special may not follow Flag & 2
     
    Until Weiter = 1
   
    Wrk$ + Mid(Char$(Typ), Nummer , 1)
   
    If Random(3) = 0 And DopFl = < 2 And n>1
    ; same type for next char
    ; with 25% probability
    ; only if max 2 of same type 
    ; and not on first char
      DopFl + 1
      LastNum = Nummer
      LastFlg = NumFlg
    Else
      Typ = 1-Typ ; Type change
      DopFl = 0
    EndIf
   
  Next

  Out$ = UCase(Left(Wrk$,1))+Mid(Wrk$,2)

  ProcedureReturn Out$

EndProcedure

For x = 0 To 50
  LO = 3+Random(6)
  Debug Create_Name(LO)
Next

Posted: **Sat May 09, 2009 4:02 pm**

thanks dobro and kaeru Gaman ! Your's code are better than mine !

Posted: **Sat May 09, 2009 4:10 pm**

Yeah! ^^
I want to participate.

Alien name maker:

Code: Select all

; 2008 (c) Hroudtwolf
; http://purebasic-lounge.com/viewtopic.php?t=5918
; Linux, Windows, OS X
; PureBasic 4.3x

EnableExplicit

Structure tStringItem
   sString  .s
   nHash    .i
EndStructure

Procedure.i _NameMaker_CreateHash ( sSource.s )
   Protected *ptrSource .CHARACTER = @ sSource
   Protected nHash      .i
   
   While *ptrSource\c   
      nHash       = nHash + ( *ptrSource\c *( *ptrSource\c * $FF ) )
      *ptrSource  + SizeOf ( CHARACTER )
   Wend
   
   ProcedureReturn nHash
EndProcedure

Procedure.s _NameMaker_GetArray ( nIndex.i )
   Static Dim  sSyllable.s ( 28 )
   Static      blInit   .i
   Protected   sTemp    .s
   Protected nI               .i
   
   If blInit
      ProcedureReturn sSyllable ( nIndex )
   EndIf
   
   blInit = #True
   
   Restore RES_SYLLABLES
   For nI = 1 To 28
      Read.s sTemp
      sSyllable ( nI ) = sTemp
   Next
     
   ProcedureReturn sSyllable ( nIndex )
EndProcedure

Procedure.i _NameMaker_IsName ( sName.s )
   Protected      nHash.i              = _NameMaker_CreateHash ( sName )
   Static NewList Names.tStringItem ()
   
   ForEach Names ()
      If Names ()\nHash = nHash
         
         ProcedureReturn #True
      EndIf
   Next
   
   AddElement ( Names () )
   Names ()\sString  = sName
   Names ()\nHash    = nHash
   
   ProcedureReturn #False
EndProcedure

Procedure.s NameMaker_Generate ( nMaxnSyllables.i )
   Protected sOutput          .s
   Protected nSyllables       .i
   Protected nMaxApostrophes  .i          = Random ( 2 )
   Protected *Source          .CHARACTER
   Protected nI               .i
   
   Repeat
      sOutput     = ""
      nSyllables  = 2 + Random ( nMaxnSyllables - 2 )
     
      For nI = 1 To nSyllables
         sOutput + _NameMaker_GetArray ( Random ( 28 ) )
         If nMaxApostrophes And Random ( 1 )
            sOutput + "'"
            nMaxApostrophes - 1
         EndIf
      Next nI
     
   Until Not _NameMaker_IsName ( sOutput )
   
   *Source     = @ sOutput
   *Source\c   = Asc ( UCase ( Chr ( *Source\c ) ) )
   
   If Right ( sOutput , 1 ) = "'"
      sOutput = Left ( sOutput , Len ( sOutput ) - 1 )
   EndIf
   
   ProcedureReturn sOutput
EndProcedure

;--- test
Define.i nI

For nI = 0 To 255
   Debug NameMaker_Generate ( 6 )
   Next nI
End

DataSection
   RES_SYLLABLES:
   Data.s "ob" , "ab" , "eb" , "ib" , "ub"
   Data.s "ar" , "or" , "en" , "in" , "er"
   Data.s "lu" , "lak" , "el" , "lib" , "loc"
   Data.s "juc" , "jat" , "job" , "jen" , "jyc"
   Data.s "ra" , "ro" , "qi" , "me" , "ma"
   Data.s "rum" , "hem" , "her" , "rem" , "ge"
   Data.s "ger" , "jor" , "jar" , "jir" , "zi"
EndDataSection

PureBasic Forums - English

Generate Randome name

Generate Randome name