Pascal/Turbo Pascal - Separar Palabras de un archivo de texto

 
Vista:
sin imagen de perfil

Separar Palabras de un archivo de texto

Publicado por Greiz (3 intervenciones) el 26/11/2014 20:41:54
bueno resulta que tengo que hacer un diccionario(archivo binario) mediante un archivo de texto en el cual hay una parte del libro del cantar del Cid. El problema es que no se como detectar cuando empieza o termina una palabra, ademas tengo que pasar todas las letras a mayusculas y sacarles los tildes y las dieresis. Alguien por favor me puede guiar en esto? desde ya gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Separar Palabras de un archivo de texto

Publicado por ramon (2158 intervenciones) el 27/11/2014 12:34:37
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
{Mira esto espero te sirva de hayuda}
 
program pruevatexto;
 uses
   crt;
   const
      lineas = 255;
      archivo = 'e:\tp\bin\cantcid.txt';
  type
     linea = string[85];
 
   var
     texto : array[1..lineas] of linea;
     ft : text;
     tn : integer;
 
   procedure cargatexto(nomb : string);
   var
      ch : string;
      p, i : longint;
   begin
       assign(ft,nomb);
  {$I-}  reset(ft); {$I+}
      if ioresult <> 0 then
      begin
         writeln('Error de archivo o no existe pulse una tecla');
         readkey;
      end
   else
      begin
        p := 1;
        i := 1;
        while not eof(ft) do
        begin
           readln(ft,ch);
           texto[i] := ch;
           texto[i][0] := chr(length(ch));
           i := i + 1;
           if i > lineas then
           i := lineas;
         end;
      end;
         close(ft);
      end;
 
 procedure presentatexto(x,y,line : integer);
 begin
    gotoxy(x,y);write(texto[line]);
 end;
 
 procedure frases(l : integer);
 var
   pasa, cuent : integer;
 begin
    cuent := 1;
    for pasa := 1 to length(texto[l]) do
    begin
       if texto[l][pasa] = ' ' then
       begin
          cuent := cuent + 1;
       end;
    end;
      writeln;
      write('  Las Frases De La Linea [ ',l,' ] Son = ',cuent);
 end;
 
  procedure mayusculas(l : integer);
  var
    h : integer;
  begin
     for h := 1 to length(texto[l]) do
     begin
        texto[l][h] := upcase(texto[l][h]);
     end;
      writeln;
      write(texto[l]);
  end;
 
   begin
      clrscr;
      cargatexto(archivo);
      presentatexto(1,1,5);
      frases(5);
      mayusculas(5);
      readkey;
   end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Separar Palabras de un archivo de texto

Publicado por Greiz (3 intervenciones) el 27/11/2014 17:58:06
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
procedure LeerTexto;
 
 
var
 
Archivo:text;
Letra:char;
palabra:string;
 
begin
 
palabra:='';
assign(Archivo,'_leeme.txt');
reset(Archivo);
repeat
   begin
      read(Archivo,Letra);
          while (ord(Letra)<=90) and (ord(Letra)>=65) or (ord(Letra)<=122) and (ord(Letra)>=97) or (ord(Letra)=165) and (ord(Letra)<=129) or (ord(Letra)=181) or (ord(Letra)<=216) and (ord(Letra)>=211)
                 or (ord(Letra)<=237) and (ord(Letra)>=224) or (not eof(Archivo)) do
               begin
                    case Letra of
 
                    'a'..'z':Letra:=Upcase(Letra);
                    'A'..'Z':Letra:=Upcase(Letra);
                    'á','Á','ä','Ä':Letra:='A';
                    'é','É','ë','Ë':Letra:='E';
                    'í','Í','ï','Ï':Letra:='I';
                    'ó','Ó','ö','Ö':Letra:='O';
                    'ú','Ú','ü','Ü':Letra:='U';
                    'ñ','Ñ':Letra:='Ñ';
 
            palabra:=palabra+Letra;
            Read(Archivo,Letra);
         end
CrearDiccionario(palabra);
palabra:='';
end
until eof(Archivo);
close(Archivo)
end;

ahora lo tengo hecho asi pero me tira un erro en la linea 44 que es justo despues del case
alguien ve lo que esta mal?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Separar Palabras de un archivo de texto

Publicado por ramon (2158 intervenciones) el 28/11/2014 00:20:44
1
2
3
4
5
6
7
8
9
10
11
12
13
14
{Mira tienes el end mal puesto}
 
 begin case Letra of
'a'..'z':Letra:=Upcase(Letra);
'A'..'Z':Letra:=Upcase(Letra);
'á','Á','ä','Ä':Letra:='A';
 'é','É','ë','Ë':Letra:='E';
'í','Í','ï','Ï':Letra:='I';
'ó','Ó','ö','Ö':Letra:='O';
'ú','Ú','ü','Ü':Letra:='U';
'ñ','Ñ':Letra:='Ñ';
end
palabra:=palabra+Letra;
Read(Archivo,Letra);
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Separar Palabras de un archivo de texto

Publicado por Greiz (3 intervenciones) el 28/11/2014 00:23:57
unit DICCIONARIO;

INTERFACE

procedure LeerTexto;

procedure CrearDiccionario(palabra:string);

function VerifDiccionario(palabra:string):boolean;


IMPLEMENTATION

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
procedure LeerTexto;
 
var
 
Archivo:text;
Letra:char;
palabra:string;
 
begin
 
palabra:='';
assign(Archivo,'_leeme.txt');
reset(Archivo);
repeat
   begin
      read(Archivo,Letra);
          while (((ord(Letra)<=90) and (ord(Letra)>=65)) or ((ord(Letra)<=122) and (ord(Letra)>=97)) or ((ord(Letra)<=165) and (ord(Letra)>=129)) or ((ord(Letra)=181)) or ((ord(Letra)<=216) and (ord(Letra)>=211))
                 or ((ord(Letra)<=237) and (ord(Letra)>=224))) and ((not eof(Archivo))) do
               begin
                    case Letra of
 
                    'a'..'z':Letra:=Upcase(Letra);
                    'A'..'Z':Letra:=Upcase(Letra);
                    'á','Á','ä','Ä':Letra:='A';
                    'é','É','ë','Ë':Letra:='E';
                    'í','Í','ï','Ï':Letra:='I';
                    'ó','Ó','ö','Ö':Letra:='O';
                    'ú','Ú','ü','Ü':Letra:='U';
                    'ñ','Ñ':Letra:='Ñ';
                    end;
 
            palabra:=palabra+Letra;
          if not (eof(Archivo)) then  Read(Archivo,Letra);
         end;
if (palabra<>'') then CrearDiccionario(palabra);
palabra:='';
end
until eof(Archivo);
close(Archivo)
end;
 
procedure CrearDiccionario(palabra:string);
 
var
 
Igual:boolean;
Diccio:file of char;
Compara:string;
Letrita:char;
i,j:byte;
 
begin
Igual:=False;
assign(Diccio,'Diccionario.dat');
rewrite(Diccio);
while not (eof(Diccio)) and (Igual=False) do
 
    begin
       Compara:='';
       j:=0;
       read(Diccio,Letrita);
       repeat
            if ((Letrita)<>',') then
                                   begin
                                        Compara:=Compara+Letrita;
                                        read(Diccio,Letrita);
                                        inc(j);
                                    end
                                else if Compara=palabra then Igual:=True
 
       until (eof(Diccio)) or (Igual=True) or (Letrita=',');
       Compara:='';
   end;
if eof(Diccio) and Igual=false then
                               begin
                                   for i:=1 to j do
                                     write(Diccio,palabra[i]);
                               end;
write(Diccio,',');
close(Diccio)
end;
 
function VerifDiccionario(palabra:String):boolean;
 
var
Diccio:file of char;
Igual:boolean;
Comparacion:string;
Caracter:char;
 
begin
 
assign(Diccio,'Diccionario.dat');
reset(Diccio);
Igual:=false;
while not (eof(Diccio)) and (Igual=False) do
     begin
       Comparacion:='';
       read(Diccio,Caracter);
       repeat
            if ((Caracter)<>',') then
                                 begin
                                      Comparacion:=Comparacion+Caracter;
                                      read(Diccio,Caracter);
                                 end
                                 else if Comparacion=palabra then Igual:=True
 
       until (eof(Diccio)) or (Igual=True) or (Caracter=',');
       Comparacion:='';
      end;
       if  (Igual=True) then VerifDiccionario:=true
                         else VerifDiccionario:=false
end;
end.

es lo que tengo hasta ahora y no me crea bien el diccionario en el programa principal help me plox :D
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar