Hi there, are you still working on this? I'm fairly new and catching up on all the posts here - it's a great resource and i've learned a lot already. Normally if an app does roughly what i want it to do then i'm happy
It's not a better way, but here's a method:
i created "rules" for which letters can follow other letters depending on whether they start, end or are in the middle of the word.
This is more random than your method (i couldn't figure out what you put in the memo), most of the words aren't english, but you could change the rules to compenste for this.
Psuedo code:
Code:
loop through names
loop through all words in name
loop through all letters in word
pick a random letter
if it's been used already pick another one
if they've all been tried then exit to name loop
if there's only 1 letter in the word then skip checks
check vowel/consonant order (to make it semi-pronouncable)
check if this is a valid letter according to the ruleset
if any of the checks fail then exit to name loop
end letter loop
end word loop
end name loop
Here's the app. Still room for improvement, but it kinda works well enough for me [pascal]
{*------------------------------------------------------------------------------
random name generator
@author ize
@version 2009/03/03 1.0 initial revision.
@comment quick pgd app to generate random names
-------------------------------------------------------------------------------}
program rng;
{$apptype console}
type
{*------------------------------------------------------------------------------
record to hold character info and rules
code: ascii code for char
exs: character exclusion for beginning of word. character indexes are or'd together
and 1 shifted left
eg: a=0, b=1, c=2. the "exs" for this would be (1 shl 0)+(1 shl 1)+(1 shl 2)=7
exs of 0 = exclude all chars, 67108863 = allow all chars
i have written an app so i didn't have to re-calc these
exn: as above but for exclusion within a word
exf: as above but for characters ending the word
-------------------------------------------------------------------------------}
tmychar = record
code: byte;
exs,exn,exf : cardinal;
end;
{*------------------------------------------------------------------------------
constants
-------------------------------------------------------------------------------}
const
maxchar = 26;
defminlen = 3;
defmaxlen = 6;
defwrdcnt = 1;
defgencnt = 10;
cs = 97; // starting character ascii code = "a"
vowels = [0,4,8,14,20]; // signify vowels in dataset
swchar = '/';
switches : array[0..7] of string[3] = ('cfg','min','max','gen','wrd','dbg','rnd','?');
{*------------------------------------------------------------------------------
global variables
-------------------------------------------------------------------------------}
var
cfg,defcfg : array[0..maxchar-1] of tmychar;
minlen,maxlen : integer;
gencount : integer;
wrdcount,nmelen : integer;
err : integer;
incomp : Boolean=False;
{*------------------------------------------------------------------------------
character index
@param c is the character to check
@return the character index for a given char
-------------------------------------------------------------------------------}
function ci(c: char): byte;
begin
result:=ord(c)-cs;
end;
{*------------------------------------------------------------------------------
check if a character is a vowel
@param c is the character to check
@return true if it is, false if not
-------------------------------------------------------------------------------}
function isvowel(c: char): boolean;
begin
result:=ci(c) in vowels;
end;
{*------------------------------------------------------------------------------
check if the current character is valid
@param wrd is the word to be checked
@param len is the desired name length
@return true if it's valid, false if not
-------------------------------------------------------------------------------}
function valid(const wrd: string;const len: integer): boolean;
var
i : integer;
c1,c2: byte;
{*------------------------------------------------------------------------------
vowel/consonant order check
checks there aren't too many vowels/consonants in succession. three characters are
checked
@param c a true element checks for a vowel, false for consonant
@return true if it fits the v/c ruleset, false if not
-------------------------------------------------------------------------------}
function check(c: array of boolean): boolean;
var
k: integer;
begin
result:=true;
for k:=0 to 2 do
result:=result and (isvowel(wrd[i+k])=c[k]);
end;
begin
// vowel/consonant check
i:=length(wrd)-2;
if i>=1 then begin
result:=
check([true, false, false]) or
check([true, false, true]) or
check([true, true, false]) or
check([false, false, true]) or
check([false, true, false]) or
check([false, true, true]);
if not result then exit;
end;
// check character exclusions
i:=length(wrd)-1;
c1:=ci(wrd[i]);
c2:=ci(wrd[i+1]);
if i=1 then result:=(cfg[c1].exs and (1 shl c2)=(1 shl c2)) // begin name
else if (i>1) and (i<len-1) then result:=(cfg[c1].exn and (1 shl c2)=(1 shl c2)) // in name
else if (i=len-1) then result:=(cfg[c2].exf and (1 shl c1)=(1 shl c1)) // end of name
else result:=true; //default result (1 char)
end;
{*------------------------------------------------------------------------------
add a character to the current name
@param wrd is the current word
@param len is the desired name length
@return the character to be added
-------------------------------------------------------------------------------}
function addchar(const wrd: string;const len: integer): string;
var
i,c: integer;
rep: array[0..maxchar-1] of byte; // to stop repeated character checks
b : boolean;
begin
result:='';
c:=0;
fillchar(rep,sizeof(rep),0);
repeat
// safeguard for infinite loop
inc(c);
if c>maxchar then begin
err:=-1;
exit;
end;
// only use un-tried characters
repeat
i:=random(maxchar);
until rep[i]=0;
rep[i]:=1;
b:=valid(wrd+chr(cfg[i].code),len);
if ((not b) and (incomp)) or (incomp) then writeln(len,'.',c,': ',wrd+chr(cfg[i].code));
until b;
result:=chr(cfg[i].code);
end;
{*------------------------------------------------------------------------------
return the maximum value. saves adding maths unit
@param a
@param b
@return biggest of the two vars
-------------------------------------------------------------------------------}
function max(a,b: integer): integer;
begin
if a>b then result:=a else result:=b;
end;
{*------------------------------------------------------------------------------
return the minimum value. saves adding maths unit
@param a
@param b
@return smallest of the two vars
-------------------------------------------------------------------------------}
function min(a,b: integer): integer;
begin
if a<b then result:=a else result:=b;
end;
{*------------------------------------------------------------------------------
convert a string to lowercase. saves adding sysutils unit
@param s is the string to convert
@return converted string
-------------------------------------------------------------------------------}
function lowercase(s: string): string;
var
i: integer;
begin
for i:=1 to length(s) do
if ord(s[i]) in [65..90] then s[i]:=chr(ord(s[i])+32);
result:=s;
end;
{*------------------------------------------------------------------------------
check if a fileexists. saves adding sysutils unit
@param fn is the filename to check
@return true if it exists, false if not
-------------------------------------------------------------------------------}
function fileexists(fn: string): boolean;
var
f: file of byte;
begin
{$i-} // turn off runtime errors
assignfile(f,fn);
reset(f);
closefile(f);
{$i+}
result:=(ioresult=0) and (fn<>'');
end;
{*------------------------------------------------------------------------------
convert a string to an integer
@param s is the string to convert
@param i is the converted integer
@return true if successful, false if not
-------------------------------------------------------------------------------}
function str2int(s: string;out i: integer): boolean;
var
c: integer;
begin
val(s,i,c);
result:=(c=0);
end;
{*------------------------------------------------------------------------------
load configuration from file
@param fn is the filename to load
-------------------------------------------------------------------------------}
procedure loadcfg(fn: string);
var
i: integer;
f: file of tmychar;
begin
fn:=lowercase(fn); // force lowercase
// check extension
if (not fileexists(fn)) or (copy(fn,length(fn)-3,4)<>'.rng') then begin
writeln('error loading file: ',fn);
writeln;
exit;
end;
{$i-} // turn off runtime errors.
assignfile(f,fn);
reset(f);
i:=0;
while (i<maxchar) and (not eof(f)) do begin
read(f,cfg[i]);
inc(i);
end;
closefile(f);
{$i+}
if (ioresult<>0) then begin
writeln('error loading file. using defaults');
writeln;
move(defcfg,cfg,sizeof(tmychar)*maxchar);
end;
end;
{*------------------------------------------------------------------------------
show app usage
-------------------------------------------------------------------------------}
procedure usage;
begin
write('usage: rng [/cfg filename] [/min number] [/max number] [/gen number]');
Writeln(' [/wrd number] [/dbg] [/rnd number]');
writeln;
writeln(' cfg load configuration file');
writeln(' min set minimum name length [3..max], default: ',defminlen);
writeln(' max set maximum name length [min..20], default: ',defmaxlen);
writeln(' gen set attempted number of names to generate [1..100], default: ',defgencnt);
writeln(' wrd set number of words per name [1..10], default: ',defwrdcnt);
writeln(' dbg debug mode (show all attempts)');
writeln(' rnd set the "seed" for randomization(0=use system clock)');
writeln(' ? display this help');
writeln;
halt;
end;
{*------------------------------------------------------------------------------
check the parameters
-------------------------------------------------------------------------------}
procedure checkparams;
var
i,o: integer;
found: boolean;
s: string;
label
skip;
{*------------------------------------------------------------------------------
get the parameter and convert it to a number
@param p is the parameter index
@param v is the return value
@param def is the default value to assign on error
@param l is the lower limit
@param h is the upper limit
-------------------------------------------------------------------------------}
procedure num(p: byte;out v: integer;const def,l,h: integer);
begin
if not str2int(paramstr(p),v) then v:=def
else v:=min(max(v,l),h);
end;
begin
if paramcount=0 then goto skip; // use defaults
i:=1;
while i<=paramcount do begin
s:=lowercase(paramstr(i));
if s[1]=swchar then begin
found:=false;
for o:=0 to high(switches) do
if copy(s,2,4)=string(switches[o]) then begin
if (i=paramcount) or (paramstr(i+1)[1]=swchar) then begin
if (copy(s,2,3)<>'dbg') and (copy(s,2,1)<>'?') then begin
writeln('no paramater for option: ',s);
halt;
end;
end;
if copy(s,2,3)='cfg' then loadcfg(paramstr(i+1))
else if copy(s,2,1)='?' then usage
else if copy(s,2,3)='dbg' then incomp:=True
else if copy(s,2,3)='rnd' then num(i+1,RandSeed,0,-maxint,MaxInt)
else if copy(s,2,3)='min' then num(i+1,minlen,defminlen,3,maxlen)
else if copy(s,2,3)='max' then num(i+1,maxlen,defmaxlen,minlen,20)
else if copy(s,2,3)='wrd' then num(i+1,wrdcount,defwrdcnt,1,10)
else if copy(s,2,3)='gen' then num(i+1,gencount,defgencnt,1,100);
found:=true;
break;
end;
if not found then begin
Writeln('unknown switch: ',s);
usage;
end;
end;
inc(i);
end;
skip:
if RandSeed=0 then Randomize;
if incomp then Writeln('Seed: ',RandSeed);
end;
{*------------------------------------------------------------------------------
initialization
-------------------------------------------------------------------------------}
procedure init;
var
i: integer;
begin
// set default char rules. allows all char combinations so names wont make much
// sense
for i:=0 to 25 do
with defcfg[i] do begin
code:=cs+i; exn:=67108863; exs:=67108863; exf:=67108863;
end;
minlen:=defminlen;
maxlen:=defmaxlen;
gencount:=defgencnt;
wrdcount:=defwrdcnt;
move(defcfg,cfg,sizeof(tmychar)*maxchar);
RandSeed:=0;
end;
{*------------------------------------------------------------------------------
main loop
-------------------------------------------------------------------------------}
procedure main;
var
t,i,o,p: byte;
text: string;
tmp,s: string;
begin
t:=0;
for i:=1 to gencount do begin
err:=0; // reset error flag
text:='';
// loop all names
for o:=1 to wrdcount do begin
nmelen:=minlen+random((maxlen-minlen)+1); // random length between min & max
p:=nmelen;
tmp:='';
// loop through current name
while nmelen>0 do begin
s:=addchar(tmp,p);
if err<>0 then Break
else tmp:=tmp+s;
dec(nmelen,max(length(s),1));
end;
if (err=0) and (o<wrdcount) then tmp:=tmp+' '; // add a space between names
if (err=0) or (incomp) then text:=text+tmp;
if err<>0 then Break;
end;
if err<>0 then text:=text+'-';
if ((err<>0) and (incomp)) or (err=0) then begin
Inc(t);
writeln('result(',i,'): '+text);
end;
end;
if t=0 then Writeln('No valid results generated');
end;
{*------------------------------------------------------------------------------
main code start
-------------------------------------------------------------------------------}
begin
writeln('random name generator v1.0');
writeln;
init;
checkparams;
main;
end.
[/pascal]
Here are the apps: Random Name Generator
Extract to a folder somewhere
rng.exe is the console app to generate the names.
run it from a command window and use /? for options
rngcodes.exe is the app to create/load/save the rulesets
pick a letter from the listbox choose which letters are allowed on the grid to the right. each letter has 3 sections for Starting, Ending & middle of the word. LMB selects & RMB clears
example.rng is just an example ruleset (most words aren't english, needs tweaking)
Bookmarks