test/IRDnames.pas

   1 program Generador_De_Nombres_Ordenados_Alfabeticamente;
   2
   3 uses
   4     CRT;
   5
   6 const
   7      MAX_APE = 15;
   8
   9 type
  10     APELLIDO = string[MAX_APE];
  11     DOCUMENTO = 10000000..40000000;
  12     PERSONA = record
  13                     ap: APELLIDO;
  14                     dni: DOCUMENTO;
  15               end;
  16     TABLA = array[1..1000] of PERSONA;
  17     TIPO_LETRA = ( TL_VOCAL, TL_CONSO );
  18     TIPO_VOCAL = ( TV_AEIOU, TV_EI );
  19     INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );
  20
  21 (*********************************************************)
  22
  23  function GetVocal( tipo: TIPO_VOCAL ): char;
  24
  25    var
  26       valor: integer;
  27
  28    begin
  29         if tipo = TV_AEIOU then valor := random( 16 )
  30                            else valor := random( 6 ) + 5;
  31         case valor of
  32             0..4: GetVocal := 'A';
  33             5..7: GetVocal := 'E';
  34             8..10: GetVocal := 'I';
  35             11..13: GetVocal := 'O';
  36             14..15: GetVocal := 'U';
  37         end;
  38    end;
  39
  40 (*********************************************************)
  41
  42  procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );
  43
  44    var
  45       valor: integer;
  46
  47     begin
  48         case indic of
  49             I_ESQ:
  50                   begin
  51                        vocal := 'U';
  52                        indic := I_ESQU;
  53                        proxl := TL_VOCAL;
  54                   end;
  55             I_ESQU:
  56                    begin
  57                         vocal := GetVocal( TV_EI );
  58                         indic := I_NADA;
  59                         proxl := TL_CONSO;
  60                    end;
  61             else
  62               begin
  63                    vocal := GetVocal( TV_AEIOU );
  64                    indic := I_NADA;
  65                    if random( 40 ) = 0 then proxl := TL_VOCAL
  66                                        else proxl := TL_CONSO;
  67               end;
  68             end;
  69     end;
  70
  71 (*********************************************************)
  72
  73  procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );
  74
  75    var
  76       valor: integer;
  77
  78    begin
  79         proxl := TL_VOCAL;
  80         indic := I_NADA;
  81
  82         case indic of
  83             I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';
  84             I_ESB: case random( 2 ) of
  85                        0: conso := 'R';
  86                        1: conso := 'L';
  87                    end;
  88             I_ESC: case random( 4 ) of
  89                        0: conso := 'C';
  90                        1: conso := 'H';
  91                        2: conso := 'R';
  92                        3: conso := 'L';
  93                    end;
  94             I_ESL: case random( 6 ) of
  95                        0: conso := 'T';
  96                        1..5: conso := 'L';
  97                    end;
  98             I_ESM: case random( 3 ) of
  99                        0: conso := 'P';
 100                        1: conso := 'B';
 101                        2: conso := 'L';
 102                    end;
 103             I_ESN: case random( 3 ) of
 104                             0: conso := 'R';
 105                             1: conso := 'V';
 106                             2: conso := 'C';
 107                    end;
 108             else case random( 55 ) of
 109                     0..3: begin
 110                                conso := 'B';
 111                                if random( 10 ) = 0 then begin
 112                                                              indic := I_ESB;
 113                                                              proxl := TL_CONSO;
 114                                                         end;
 115                           end;
 116                     4..7: begin
 117                                conso := 'C';
 118                                if random( 5 ) = 0 then begin
 119                                                              indic := I_ESC;
 120                                                              proxl := TL_CONSO;
 121                                                         end;
 122                           end;
 123                     8..11: conso := 'D';
 124                     12..14: begin
 125                                conso := 'F';
 126                                if random( 10 ) = 0 then begin
 127                                                              indic := I_ESF;
 128                                                              proxl := TL_CONSO;
 129                                                         end;
 130                             end;
 131                     15..17: begin
 132                                conso := 'G';
 133                                if random( 5 ) = 0 then
 134                                  begin
 135                                       indic := I_ESG;
 136                                       if random( 4 ) = 0 then proxl := TL_CONSO;
 137                                  end;
 138                             end;
 139                     18..19: conso := 'H';
 140                     20..22: conso := 'J';
 141                     23..24: conso := 'K';
 142                     25..27: begin
 143                                conso := 'L';
 144                                if random( 15 ) = 0 then
 145                                  begin
 146                                       indic := I_ESL;
 147                                       proxl := TL_CONSO;
 148                                  end;
 149                             end;
 150                     28..30: begin
 151                                conso := 'M';
 152                                if random( 5 ) = 0 then
 153                                  begin
 154                                       indic := I_ESM;
 155                                       proxl := TL_CONSO;
 156                                  end;
 157                             end;
 158                     31..33: begin
 159                                conso := 'N';
 160                                if random( 5 ) = 0 then
 161                                  begin
 162                                       indic := I_ESN;
 163                                       proxl := TL_CONSO;
 164                                  end;
 165                             end;
 166                     34..36: conso := 'P';
 167                     37..38: begin
 168                                conso := 'Q';
 169                                indic := I_ESQ;
 170                             end;
 171                     39..41: begin
 172                                conso := 'R';
 173                                if random( 3 ) = 0 then
 174                                  begin
 175                                       indic := I_ESR;
 176                                       proxl := TL_CONSO;
 177                                  end;
 178                             end;
 179                     42..44: conso := 'S';
 180                     45..47: begin
 181                                conso := 'T';
 182                                if random( 10 ) = 0 then
 183                                  begin
 184                                       indic := I_EST;
 185                                       proxl := TL_CONSO;
 186                                  end;
 187                             end;
 188                     48..50: conso := 'V';
 189                     51: conso := 'W';
 190                     52: conso := 'X';
 191                     53: conso := 'Y';
 192                     54: conso := 'Z';
 193                  end; { case random( 55 ) of }
 194
 195         end; { case indic of }
 196    end; { procedimiento }
 197
 198 (*********************************************************)
 199
 200  function GetRNDApellido( max, min: integer ): APELLIDO;
 201
 202     var
 203        tam, i: integer;
 204        aux: char;
 205        apel: APELLIDO;
 206        indic: INDICADOR;
 207        proxl: TIPO_LETRA;
 208
 209     begin
 210          if max > MAX_APE then max := MAX_APE;
 211          tam := random( max + 1 ) + min;
 212          indic := I_NADA;
 213          apel := '';
 214          if random( 5 ) = 0 then proxl := TL_VOCAL
 215                             else proxl := TL_CONSO;
 216          for i := 1 to tam do
 217            begin
 218                 if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )
 219                                     else GetRNDVocal( indic, proxl, aux );
 220                 apel := apel + aux;
 221            end;
 222          GetRNDApellido := apel;
 223     end;
 224
 225 (*********************************************************)
 226
 227  function GetRNDLetra( min, max: char ): char;
 228
 229     begin
 230          GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );
 231     end;
 232
 233
 234 (*********************************************************)
 235  procedure GetInvOrdApellidos( var ar: text; cant: integer );
 236
 237     var
 238         mil: boolean;
 239         letra, letra1: char;
 240         i, j, veces: integer;
 241         dni: DOCUMENTO;
 242         ap, ape, apel: APELLIDO;
 243
 244     begin
 245          mil := false;
 246          if cant = 1000 then mil := true;
 247          dni := 34000000 + (random( 15000 ) * 100);
 248          ap := '';
 249          ape := '';
 250          apel := '';
 251          for letra := 'Z' downto 'A' do
 252            begin
 253                 ap := letra;
 254                 for letra1 := 'Z' downto 'A' do
 255                    begin
 256                         if mil then
 257                            case letra of
 258                                 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':
 259                                      case letra1 of
 260                                           'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;
 261                                           else veces := 1;
 262                                      end;
 263                                 else case letra1 of
 264                                           'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;
 265                                           else veces := 1;
 266                                      end;
 267                            end
 268                         else
 269                            case letra of
 270                                 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':
 271                                      case letra1 of
 272                                           'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;
 273                                           else veces := 1;
 274                                      end;
 275                                 else case letra1 of
 276                                           'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;
 277                                           else veces := 1;
 278                                      end;
 279                            end;
 280                         ape := ap + letra1;
 281                         for j := 1 to veces do
 282                             begin
 283                                  if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )
 284                                           else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );
 285                                  dni := dni - random( 50000 ) - 1;
 286                                  writeln( ar, apel );
 287                                  writeln( ar, dni );
 288                                  writeln( ar );
 289                                  apel := '';
 290                             end;
 291
 292                         ape := '';
 293
 294                    end; { for letra1 := 'A' to 'Z' do }
 295
 296                 ap := '';
 297
 298            end; { for letra := 'A' to 'Z' do }
 299
 300     end; { procedure }
 301
 302 (*********************************************************)
 303
 304 var
 305    datos: TABLA;
 306    arch: text;
 307    dni: DOCUMENTO;
 308    i, n: integer;
 309
 310 begin
 311      randomize;
 312
 313      n := 1000;
 314      assign( arch, 'DATOS.TXT' );
 315      rewrite( arch );
 316      readln( n );
 317      GetInvOrdApellidos( arch, n );
 318      close( arch );
 319 end.