Indice: 2. Introducción .................................................................... 2 3. Desarrollo ......................................................................... 3 Tema 3: Estructuras de control .................................... 4 Tema 4: Entrada / Salida de datos ................................ 6 Tema 5: Tipos de datos definidos por el Usuario, y conjuntos ....................................... 8 Tema 6: Subprogramas ................................................... 11 Tema 7: Arrays .............................................................. 17 Tema 8: Registros ......................................................... 34 Tema 9: Ficheros .......................................................... 42 Tema 10: Punteros ......................................................... 58 Tema 11: Recursividad ................................................... 100 4. Conclusiones .................................................................... 105 5. Bibliografía ..................................................................... 106

INTRODUCCIÓN Con el trabajo propuesto, se pretende afianzar los conocimientos obtenidos durante todo el curso, y sobre todo adquirir mayor grado de conocimientos que el exigido por la asignatura. El trabajo consiste en la solución mediante programación en Pascal de diversos problemas, propuestos como ejercicios. Dichos ejercicios están clasificados por temas, según las estructuras de control y/o de datos necesarias para su resolución. Asimismo, dentro de cada tema, los ejercición están ordenados según su grado de dificultad, de manera que para resolver los últimos de cada tema será necesario un nivel de conocimientos mayor que el exigido por la asignatura. Para la realización del trabajo, se ha contado con el compilador de pascal de Borland ®, TURBO PASCAL 7.0, cuyo manejo no es el objetivo del presente trabajo, pero que ha requerido de un estudio específico a nivel de funciones y procedimientos propios de las unidades que incluye, especialmente de la unidad Crt, para el control de las entradas y salidas de datos. El presente trabajo, puede servir de ayuda a aquellos alumnos que quieran consurtarlo, ya que los programas están comentados, y están disponibles en soporte magnético. Además se ha realizado un esfuerzo por hacer que la interacción de los mismos con el usuario sea agradable, con presentaciones por pantalla estudiadas, e introducción de datos en muchos casos controladas para evitar errores en tiempo de ejecución (run time 1

errors). Con el presente trabajo, se ha conseguido adquirir conocimientos más alla de los exigidos por la asignatura, en cuanto a que ya no se limita a la programación de Pascal estándar, y que se ha adquirido práctica en métodos de presentación por pantalla, y de entradas de datos desde el teclado, cuestiones que quedan fuera de los requisitos específicos de la asignatura.

DESARROLLO A lo largo del curso se han realizado una serie de ejercicios, destinados a la asimilación de técnicas para la programación, así como de adquirir la metodología necesaria. En la realización de estos ejercicios, sin embargo, no se tubieron en cuenta aspectos de la programación tales como la comunicación entre el programa y el usuario, aunque sea éste un aspecto fundamental en la programación de aplicaciones hoy en día. Además, los ejercicios realizados a continuación, han sido programados en Turbo Pascal, habiendo sido compilados con éxito, estando por tanto disponibles en soporte magnético, para ser revisados. El trabajo podría dividirse en dos partes: Una primera en la que se resuelven problemas sin excesiva dificultad, y que tienen como objetivo el afianzamiento de las nociones teóricas sobre el tema al que pertenecen, y una segunda parte en la que se resuelven problemas con mayor grado de dificultad, con lo que se consigue un mayor grado de conocimientos sobre el tema específico. Sin más comenzamos con el desarrollo del trabajo: Ejercicios tema 3 8. Escribir un programa que lea 7 valores de temperatura, y escriba el número de veces que esta tuvo un valor inferior a 0º. Hacer una traza del código para las siguientes entradas: • 10, 0, −3. 12. 18, 5, 1 • 20, 15, 18, 5, −5, −3, −2 • 5, 10, 12, 18, 22, 30, 35 program t3e8(Input, Output); var cont, temp, index: integer; begin cont := 0; {Contador, nº de veces que la temperatura es inferior a 0 grados.} for index := 1 to 7 do begin write('Dime temperatura(',index,'): '); readln(temp); 2

{ Leer temperatura desde teclado} if temp < 0 then cont := cont + 1 { Si es menor que cero, incrementar el contador} end; write('La temperatura fue ',cont); { Escribir resultado por pantalla.} if cont = 1 then write(' vez ') else write(' veces '); writeln('inferior a cero.') end. 12. Calcular los M primeros factoriales de un valor N entero. program t3e12(Input, Output); Uses Crt; var index1, index2, N, M: integer; fac: longint; begin ClrScr; writeln('Calcular los factoriales de los números entre N y M:'); write('Dime N: '); readln(N); repeat {Para no aceptar M > N } write('Dime M (ha de ser M <= N): '); readln(M); {Se lee desde teclado hasta que sea M <= N} until (M <= N); for index1 := N downto M do

3

{Calcular el factorial de los números comprendidos entre N y M ambos inclusive.} begin fac := 1; {inicializar la variable que acumular los productos} for index2 := index1 downto 1 do fac := fac * index2; {Cálculo del factorial} writeln('El factorial de ',index1,' es ',fac,'.'); {Escribir resultado.} end; readkey end.

Ejercicios tema 4 4. Escribir un programa que lea un número entero, lo multiplique por dos y a continuación lo escriba en la pantalla: program t4e4(Input, Output); Uses Crt; var num: integer; begin ClrScr; {Borrar la pantalla. Rutina de la unidad Crt} write('Dime un número entero: '); {Se pide por pantalla lo que ha de introducir el usuario (write), y se lee desde teclado (readln).} readln(num); num := 2 * num; {Se opera y se guarda el resultado en la misma variable.} 4

writeln('Tu número multiplicado por 2 es ',num); {Se Muestra el resultado.} readkey {Lee un carácter desde teclado, y no lo muestra por pantalla (rutina de la unidad Crt)} end. 6. Escribir un programa que lea dos números enteros A y B, y obtenga los valores A div B, A mod B. program t4e6(Input, Output); Uses Crt; var A, B, aDb, aMb: integer; begin ClrScr; write('Dime un número entero:'); readln(A); write('Dime otro número entero:'); readln(B); aDb := A div B; aMb := A mod B; writeln('A div B = ',aDb); writeln('A mod B = ',aMb); readkey end. 8. Escribir un programa que convierta un número de segundos en su equivalente en minutos y segundos. program t4e8(Input, Output); uses Crt; var iniseg, segundos, minutos: integer;

5

begin ClrScr; write('Dime un número de segundos:'); readln(iniseg); minutos := iniseg div 60; {Cada 60 segundos, son 1 minuto} segundos := iniseg mod 60; {Son los segundos que sobran de hacer grupos de 60 segundos} writeln(iniseg,' segundos son ',minutos,' minutos y ',segundos,' segundos.'); readkey end.

Ejercicios tema 5 4. Implementar en Pascal un algoritmo que solicitando al usuario una hora de un determinado día en el formato hora (de 1 a 24), minutos (de 1 a 60) y segundos (de 1 a 60), el programa calcule y visualice la hora un segundo más. Usar para ello los tipos mas apropiados. program t5e4(Input, Output); uses Crt; var Horas, horasf: 0..23; minutos, segundos, minf, segf: 0..59; {formatos: Horas (de 0 a 23), Minutos y segundos (de 0 a 59)} begin ClrScr; write('Dime horas: '); readln(horas); write('Dime minutos: '); readln(minutos);

6

write('Dime segundos: '); readln(segundos); segf := segundos; minf := minutos; horasf := horas; {Para no perder los valores iniciales, se asignan a las variables segf, minf y horasf, y se opera con ellas. Así, los valores que introduzca el usuario no se modifican, y se pueden usar luego} if segundos < 59 then segf := segundos + 1 {si los segundos son menos de 59 se suma uno m s.} else begin {si son 59, al sumarle uno, habrá que sumar un minuto y poner los segundos a cero.} segf := 0; if minutos < 59 then minf := minutos + 1 {Si los minutos eran menos de 59, se suma el minuto.} else begin {Si eran 59 habrá que sumar una hora, y poner a cero los minutos} minf := 0; if horas < 23 then horasf := horas + 1 {Si las horas eran menos de 23, se suma una hora más, y si eran 23, se ponen a cero.} else horasf := 0 end end; write(horas, 'h ',minutos, 'm ',segundos, 's + 1s = ');

7

writeln(horasf, 'h ',minf, 'm ',segf, 's.'); readkey end. 10. Análisis de un texto. El usuario introduce una serie de caracteres por teclado, hasta finalizar con un asterisco. Obtener las letras del alfabeto que han aparecido y las que no han aparecido. program t5e10(Input, Output); Uses Crt; var Estan: Set of Char; Entrada: Char; begin clrscr; Writeln('Introduce una frase, y termina con un * (asterisco):'); writeln; Estan := []; {Se inicializa el conjunto "Estan" como vacío} repeat entrada := upcase(readkey); {Se lee de teclado un carácter, y se pasa a mayúsculas con la función upcase().} if entrada in ['A'..'Z',' ',',','.',';'] then write(entrada); {Si el carácter introducido es una letra, un signo de puntuación, o un espacio en blanco, entonces se muestra por pantalla. } if not(entrada in Estan) then Estan := Estan + [entrada] {Si el carácter no est en el conjunto "Estan", entonces se añade} until entrada = '*'; {Se repite el proceso hasta que se introduzca un *} writeln; 8

writeln; writeln('Las siguientes letras han aparecido:'); {Se procede a mostrar los caracteres que pertenecen al conjunto} for entrada := 'A' to 'Z' do {Se recorren los valores desde la A hasta la Z} if entrada in Estan then write(entrada,' '); {para cada letra, si est en el conjunto "Estan", significa que ha sido introducido por teclado, y entonces se muestra por pantalla} writeln; writeln; writeln('Las siguientes letras NO han aparecido:'); {Ahora se procede a mostrar los que no pertenecen al conjunto. Para ello se sigue el mismo proceso que antes, pero mostrando la letra sólo si NO pertenece al conjunto. } for entrada := 'A' to 'Z' do if not(entrada in Estan) then write(entrada,' '); readkey end. 12. Las notas de un examen pueden ser únicamente enteras, del 0 al 10. Obtener el numero de veces que ha aparecido el 0, el 5 y el 10 en el examen. Obtener las notas que no ha obtenido ningún alumno en la clase. El usuario debe introducir tantas notas como alumnos tenga la clase. program t5e12(Input, Output); Uses Crt; var Notas: Set of 0..10; index, alumno, veces0, veces5, veces10, N: integer; begin

9

clrscr; Notas := []; {Se inicializa a conjunto vacío el conjunto donde se guardar n las calificaciones obtenidas por los alumnos} write('Cuántos alumnos hay en clase?: '); readln(N); veces0 := 0; veces5 := 0; veces10 := 0; {Se inicializan a cero los contadores que guardarán las veces que se obtuvieron puntuaciones de 0, 5, y 10 } for index := 1 to N do {N es el número de alumnos.} {Repetir N veces el siguiente proceso:} begin write('Nota de alumno(',index,'): '); readln(alumno); {Leer la nota del alumno. Si la nota no esta en el conjunto, entonces se añade:} if not(alumno in notas) then notas := notas + [alumno]; case alumno of {si la nota es cero, cinco o diez, se incrementa en uno el contador correspondiente: veces0, veces5 o veces10} 0: veces0 := veces0 + 1; 5: veces5 := veces5 + 1; 10: veces10 := veces10 + 1

10

end end; writeln; writeln('Número de alumnos con un cero: ',veces0); {Se muestran los } writeln('Número de alumnos con un cinco:',veces5); {resultados } writeln('Número de alumnos con un diez: ',veces10); writeln; writeln('Ningún alumno ha obtenido ninguna de las siguientes puntuaciones:'); {Se muestran las notas que no est n en el conjunto, que no estar n, porque ningún alumno habrá obtenido esa calificación.} for index := 0 to 10 do if not(index in notas) then write(index,' '); readkey end.

Ejercicios tema 6 2. Escribir un programa que lea dos números enteros A y B, y obtenga los valores A div B, A mod B, utilizando subprogramas. Program t6e2(Input, Output); Uses Crt; Var A, B: Integer; Function XdivY(X, Y: Integer): Integer; {Función de dos par metros, que devuelve un entero que es el resultado de realizar la división entera de los par metros pasados:} begin XdivY := X div Y end; 11

Function XmodY(X, Y: Integer): Integer; {Función de dos par metros, que devuelve un entero que es el resultado de realizar la operación resto (mod) de los par metros pasados:} begin XmodY := X mod Y end; Begin ClrScr; writeln('*** Escribe dos números enteros ***'); write('Numero A = '); readln(A); write('Numero B = '); readln(B); writeln; writeln('Calculando la división entera (div), y el resto (mod) ...'); writeln; write(A,' div ',B,' = ', XdivY(A, B)); write(' porque ',B,' x ',XdivY(A, B),' es ',B * XdivY(A, B)); writeln(' y ',B,' x ',XdivY(A, B)+1,' es ',B*(XdivY(A, B)+1),' que se pasa.'); writeln; write(A,' mod ',B,' = ', XmodY(A, B),' porque es lo que sobra de dividir '); writeln(A,' entre ',B); writeln; writeln(A,' = ',XdivY(A,B),' x ',B,' + ',XmodY(A,B)); readkey end.

12

10. Escribir un programa que lea tres números enteros y emita un mensaje que indique si están o no en orden numérico. Program t6e10(Input, Output); Uses Crt; Var n1, n2, n3: integer; Function ordenados(i, j: Integer): Boolean; {Función booleana de dos par metros enteros, que devuelve TRUE si el primer número es menor o igual que el segundo y FALSE si es mayor:} begin ordenados := (i <= j) end; Begin ClrScr; writeln('*** Introduce tres números enteros ***'); write('Primero: '); readln(n1); write('Segundo: '); readln(n2); write('Tercero: '); readln(n3); writeln; {Mediante la función, se comprueba si el primer número es menor que el segundo, y si el segundo es además menor que el tercero.} if ordenados(n1,n2) and ordenados(n2,n3) then writeln('Los tres números est n en orden.') else writeln('Los tres números NO est n en orden'); readkey 13

end. 14. Implementar un programa que calcule recursivamente el factorial de un número. Program t6e14(Input, Output); Uses Crt; Var n: Longint; Function Factorial(n: longint): longint; {Función de un par metro entero, que devuelve un entero largo (longint) que es el resultado de calcular recursivamente su factorial:} begin if n <= 1 then factorial := 1 else factorial := n * factorial(n−1) end; Begin ClrScr; repeat write('Introduce un número entero positivo: '); readln(n); if n < 0 then writeln('- Positivo significa mayor o igual que cero !') until n >= 0; writeln; writeln('El factorial de ',n,' es: ',n,'! = ',factorial(n)); readkey end. 16. Torres de Hanoi. Se tienen tres postes y una serie de discos de diferentes tamaños, cada disco tiene un agujero en el centro permitiendo que los discos de apilen en los postes. Inicialmente los discos están apilados en el poste de la izquierda, ordenados según su tamaño, el menor en la parte de abajo y el menor en la parte de arriba. El objetivo del juego es trasladar los discos desde el poste izquierdo al derecho sin colocar nunca un disco mayor sobre uno mas pequeño. Los discos se deben mover de uno en uno y las discos siempre deben estar en un poste. 14

La estrategia es considerar uno de los postes como origen y otro como destino, el tercer poste se utiliza como almacenamiento intermedio para permitir el traslado de discos. Por tanto si los discos se encuentran inicialmente en el poste izquierdo el problema se convierte en: • Trasladar los n−1 discos superiores al poste central, usando el poste derecho como almacenamiento intermedio. • Trasladar el disco restante al poste derecho. • Trasladar los n−1 discos del poste central al poste derecho, usando el poste izquierdo como almacenamiento intermedio. El problema se define de forma recursiva. Program t6e16(Input, Output); Uses Crt; Const Max = 9; Type disco = String[max]; arrdisco = array [1..max] of disco; Var vdiscos: arrdisco; {Array que contendrá los discos} poste: array [1..3] of arrdisco; {tres postes para mover los discos} cima: array [1..3] of 0..max; {altura del último disco de cada poste} maxdiscos: 1..max; {número de discos} movimientos: word; {número de movimientos de disco efectuados.} ralentizar: boolean; {Si es True la visualización ser m s lenta} Function sacardisco(numposte: integer): disco; {Extrae el último disco de un poste, y devuelve un String con el disco que ha extraído} begin gotoxy(20*numposte−maxdiscos, 24−cima[numposte] ); write(' ':maxdiscos, '³',' ':maxdiscos); sacardisco := poste[numposte, cima[numposte]]; {Este es el último disco.} poste[numposte, cima[numposte]] := '';

15

{En el poste ya no queda disco.} dec(cima[numposte]); {El último disco en el poste est una posición m s abajo.} end; Procedure meterdisco(numposte: integer; nuevodisco: disco); {Inserta un disco encima del último que haya en un poste.} begin inc(cima[numposte]); {El último disco, está ahora una posición más alta.} gotoxy(20*numposte−length(nuevodisco), 24−cima[numposte] ); write(nuevodisco, '³', nuevodisco); poste[numposte, cima[numposte]] := nuevodisco {Este es el disco insertado} end; Procedure inicio; {Prepara la posición inicial de los postes, y llena el primero con los discos que se hayan determinado.} var i: integer; Procedure hacerdiscos; {Crea los discos, que son Strings} var i: integer; begin vdiscos[1] := 'ß'; {El primer disco: Radio = 1, di metro = 2} for i:= 2 to maxdiscos do vdiscos[i] := vdiscos[i−1]+'ß' {Cada disco es una unidad m s grande que el anterior.}

16

end; Procedure verposte(numposte: integer); {Visualiza por pantalla los postes y los discos que contienen.} var i: integer; begin gotoxy(20*numposte−(maxdiscos+1), 24); for i := 1 to 2*(maxdiscos+1)+1 do write('±'); {Base de los postes} for i := 1 to maxdiscos do begin if length(poste[numposte, i]) = 0 then {Si la altura "i" del poste est vacía, entonces:} begin gotoxy(20*numposte, 24−i ); write('³') {Solo est el poste, no hay disco.} end else begin {Si en la altura "i" hay un disco:} gotoxy(20*numposte−length(poste[numposte, i]), 24−i ); write(poste[numposte, i],'³', poste[numposte, i]) {Se dibuja el disco: mitad−poste−mitad} end end end; begin

17

movimientos := 0; {Inicializar el nº de movimientos de disco realizados.} hacerdiscos; cima[1] := maxdiscos; {El primer poste empieza lleno.} for i:= 1 to maxdiscos do begin {Los discos se sitúan el m s grande abajo, y en orden ascendente} poste[1,i] := vdiscos[maxdiscos−i+1]; poste[2,i] := ''; poste[3,i] := '' {Los postes 2 y 3, empiezan vacíos.} end; cima[2] := 0; cima[3] := 0; {No hay discos inicialmente en los postes 2 y 3.} for i := 1 to 3 do verposte(i) {Visualizar los 3 postes.} end; Procedure transferir (n, origen, destino, otro : integer); { Transfiere n discos del origen al destino (Recursivamente)} Procedure moverdisco (origen, destino : integer); { Traslada un disco desde el origen al destino } var dibu: disco; {Contendrá el disco que sale de un poste hasta que sea introducido en el siguiente.}

18

begin inc(movimientos); {Incrementar el n§ de movimientos} gotoxy(50,8); write(movimientos:3); dibu := sacardisco(origen); {se saca el disco del poste origen} meterdisco(destino, dibu); {y se mete en el poste destino} if ralentizar {para que de tiempo a ver el proceso: } then delay(25 + 100*(max−maxdiscos+1)) {La velocidad depende del n§ de discos.} else delay(25) end; begin if n > 0 then begin {transferir los discos que est n encima (que ser n "n−1" discos) desde el poste origen al otro, utilizando el destino de apoyo.} transferir(n−1, origen, otro, destino); {Mover el disco deseado del origen al destino} moverdisco(origen, destino); {y transferir al destino los que se quedaron en el otro.} transferir(n−1, otro, destino, origen) end

19

end; Begin ClrScr; write('Número de discos [Máximo 9]: '); repeat maxdiscos := ord(readkey) − ord('0') until (maxdiscos <= 9) and (maxdiscos > 0); writeln(maxdiscos); write('¨ Ralentizar ? [S/N]:'); ralentizar := (upcase(readkey) = 'S'); inicio; gotoxy(24,8); write('Movimientos realizados ..:'); transferir(maxdiscos, 1, 3, 2); gotoxy(1,3); writeln('That`s All Folks ...'); readkey end

Ejercicios tema 7 2. Contar el número de vocales que aparecen en un array. El array termina con un punto. Program t7e2(Input, Output); Uses Crt; Const vocales: Set of Char = (['A','E','I','O','U',' ',' ','¡','¢','£','£']); LetBuenas: Set of Char = (['a'..'z','A'..'Z','0'..'9', ' ','.',',',':',';','(',')','−','¨',' ',' ','¡','¢','£',

20

'£','?','-','!','"','%','/','<','>']); Var letra: Char; {para guardar cada carácter introducido desde teclado.} Frase: array [1..80] of Char; index, numvocales: integer; Begin ClrScr; Writeln('Escribe tu frase, y termina con un punto.'); index := 0; numvocales := 0; repeat letra := readkey; if letra in letbuenas then {para no guardar caracteres especiales.} begin inc(index); {incrementar el ¡índice del array.} write(letra); {Readkey no muestra por pantalla el carácter leído.} frase[index] := letra; {se asigna el carácter al array.} if upcase(letra) in vocales then inc(numvocales) {Si el carácter está en el conjunto "vocales" se incrementa el contador de vocales "numvocales":} end until (index >= 80) or (letra = '.'); {La frase termina con un punto.} writeln;

21

writeln; writeln('La frase tiene ',numvocales,' vocales.'); readkey end. 4. Comparar dos arrays de caracteres y obtener si son idénticos o no. Program t7e4(Input, Output); Uses Crt; Const long_frase = 80; {Máxima longitud permitida para una frase.} Type frase = array [1..long_frase] of Char; Var Frase1, frase2: frase; {Arrays donde se almacenarán las frases.} iguales: boolean; index: integer; Procedure leerfrase(var arraychar: frase); {Lee desde teclado una frase, y la almacena en un array de caracteres.} var letra: Char; index: integer; begin index := 0; repeat letra := readkey; inc(index); write(letra); arraychar[index] := letra; until (index >= long_frase) or (letra = #13); {La frase termina con INTRO } writeln

22

end; Begin ClrScr; Writeln('Escribe la primera frase, y termina con INTRO.'); leerfrase(frase1); {Leer la primera frase} Writeln('Escribe la segunda frase, y termina con INTRO.'); leerfrase(frase2); {Leer la segunda frase} index := 1; iguales := (frase1[index] = frase2[index]); {Se inicializa "iguales" a true o false según el primer carácter de "frase1" sea igual al primer carácter de "frase2" } while iguales and (index <= long_frase) and (frase1[index] <> #13) do {Mientras que iguales sea true y no se alcance el final de la frase, que puede ser porque se detecte un INTRO o porque se llegue a la longitud máxima de frase "long_frase".} begin inc(index); iguales := (frase1[index] = frase2[index]) end; if iguales then writeln('Las dos frases son idénticas.') else begin writeln('Las frases NO son idénticas.'); writeln('Difieren a partir del carácter nº', index) end;

23

readkey end. 6. Mostrar una frase en el orden inverso en que se escribió. La frase termina con un punto. Program t7e6(Input, Output); Uses Crt; Const long_frase = 80; Type frase = array [1..long_frase] of Char; Var Frase1: frase; iguales: boolean; index, max: integer; Procedure leerfrase(var arraychar: frase; var index: integer); {Lee una frase desde teclado, y la almacena en un array. Además, devuelve en una variable entera la longitud de la frase.} var letra: Char; begin index := 0; repeat letra := readkey; inc(index); write(letra); arraychar[index] := letra; until (index >= long_frase) or (letra = '.'); writeln end; Begin ClrScr;

24

writeln('Visualizar una frase al revés.'); Writeln('Escribe la frase, y termina con un punto:'); leerfrase(frase1,max); for index := max downto 1 do write(frase1[index]); {Para visualizar la frase al revés, se recorre el array que la contiene empezando desde el final, que se ha guardado en la variable "max".} writeln; readkey end. 8. Imprimir la media de los elementos que se encuentran en las posiciones pares y la media de los elementos que se encuentran en las posiciones impares de un vector numérica. Program t7e8(Input, Output); uses Crt; Const maxnum = 5; Type listadenumeros = array [1..maxnum] of real; Var lista: listadenumeros; pares, impares, index: integer; imedia, pmedia, isuma, psuma: real; Begin ClrScr; writeln('Dada una lista de números, calcular la media de los que ocupan '); writeln('posiciones pares, y la de los que ocupan posiciones impares.'); writeln; writeln('Introduce los ',maxnum,' números de la lista:'); isuma := 0; {acumulador de impares} psuma := 0; {acumulador de pares} pares := 0; {contador de pares} 25

impares := 0; {contador de impares} for index := 1 to maxnum do begin write('Elemento ',index,': '); readln(lista[index]); {leer elemento de la lista.} if odd(index) then {si ocupa posición impar:} begin inc(impares); {incrementar contador de números impares,} isuma := isuma + lista[index] {sumar al acumulador de impares} end else begin {si no ocupa posición impar:} inc(pares); {incrementar contador de números pares,} psuma := psuma + lista[index] {sumar al acumulador de pares} end end; imedia := isuma / impares; {calcular la media de impares} pmedia := psuma / pares; {calcular la media de pares} writeln; writeln(impares,' elementos impares y ',pares,' elementos pares.'); writeln;

26

writeln('Media de los elementos impares: ',imedia:10:5); writeln('Media de los elementos pares..: ',pmedia:10:5); readkey end. 10. Realizar un algoritmo que dada una oración de tamaño máximo N y terminada en punto, determine si es un palíndromo o no. Un palíndromo es una oración que, atendiendo sólo a sus letras e ignorando los espacios, acentos, signos de puntuación y tipo de letra (mayúscula o minúscula) expresa lo mismo leída de izquierda a derecha que de derecha a izquierda. dábale arroz a la zorra el abad. Program t7e10(Input, Output); uses Crt; Const long_frase = 80; Type frase = array [1..long_frase] of Char; Var frase1, palin: frase; conta, cont2, palindex: integer; letra: Char; palíndromo: boolean; Procedure leerfrase(var arraychar: frase; var index: integer); var letra: Char; begin writeln('La frase acaba con INTRO.'); index := 0; repeat letra := readkey; inc(index); write(letra); arraychar[index] := letra; until (index >= long_frase) or (letra = #13); if letra = #13 then dec(index); 27

{Porque la marca de fin de frase no forma parte de ella.} writeln end; Begin ClrScr; Writeln('Escribe una frase para comprobar si es un palíndromo:'); leerfrase(frase1,conta); palindex := 0; for cont2 := 1 to conta do begin letra := upcase(frase1[cont2]); {pasar a mayúsculas.} inc(palindex); case letra of {no tener en cuenta los acentos.} 'A'..'Z', '0'..'9': palin[palindex] := letra; ' ': palin[palindex] := 'A'; ' ': palin[palindex] := 'E'; '¡': palin[palindex] := 'I'; '¢': palin[palindex] := 'O'; '£': palin[palindex] := 'U' else dec(palindex) {Si no es ni un carácter o un número, no incluirlo en "palin", para ello se decrementa el ¡índice del array para que no quede ningún hueco.} end end;

28

palíndromo := true; for cont2 := 1 to (palindex div 2) do {Desde el primer elemento hasta el que ocupe la posición intermedia:} begin {"palíndromo" ser true mientras que los caracteres sean simétricos respecto al punto medio de la frase.} palíndromo := palíndromo and (palin[cont2] = palin[palindex−cont2 + 1]); gotoxy (palindex−cont2+1,5); {Las posiciones "cont2" y "palindex−cont2 + 1" son simétricas respecto al punto medio de la frase.} write(palin[palindex−cont2 + 1]); gotoxy (cont2,5); write(palin[cont2]); delay(500) end; if odd(palindex) then write(palin[(palindex div 2) + 1]); writeln; writeln; if palíndromo then writeln('La frase es un palíndromo.') else writeln('La frase NO es un palíndromo.'); writeln; readkey end. 12. Dado un vector que contiene un texto de tamaño N como máximo, eliminar los espacios que existen delante del carácter salto de carro. El texto no tiene porqué ocupar todo el vector. El final de texto se marca con el carácter *. Program t7e12(Input, Output);

29

uses Crt; Const long_frase = 80; Type frase = array [1..long_frase] of Char; Var frase1: frase; numblancos, conta, cont2, long: integer; letra: Char; Procedure leerfrase(var arraychar: frase; var pos_intro, index: integer); {Lee una frase y devuelve además la posición de la frase en la que se pulsó el primer INTRO, y la longitud total de la frase.} var letra: Char; pulsado: boolean; begin writeln('La frase acaba con un *'); pulsado := false; index := 0; repeat letra := readkey; inc(index); if letra <> #13 then begin write(letra); arraychar[index] := letra end else begin if not pulsado then begin

30

pulsado := true; write(''); arraychar[index] := letra; pos_intro := index end else dec(index) end until (index >= long_frase) or (letra = '*'); if letra = '*' then dec(index); writeln end; Begin ClrScr; Writeln('Escribe una frase con blancos y un INTRO en medio.'); leerfrase(frase1,conta,long); cont2 := conta − 1; {Posición anterior a la del INTRO} numblancos := 0; while (frase1[cont2] = ' ') and (cont2 >= 1) do {mientras que el carácter sea un blanco, y no se llegue al principio:} begin inc(numblancos); {incrementar el contador de blancos} dec(cont2) {decrementar la posición del array para ser comprobada.} end; {Para eliminar los blancos, se copian los caracteres que ocupan las

31

posiciones siguientes a las del INTRO, encima de las que ocupan los blancos hasta el final de la frase.} for cont2 := (conta−numblancos) to (long−numblancos) do frase1[cont2] := frase1[cont2+numblancos]; writeln; writeln('La frase sin blancos antes del INTRO:'); writeln; for cont2 := 1 to (long−numblancos) do if frase1[cont2] <> #13 then write(frase1[cont2]) else write(''); writeln; readkey end. 14. Escribir un programa que cuente el número de palabras en un texto, que tengan al menos cuatro vocales diferentes. Program t7e14(Input, Output); Uses Crt; Const long_frase = 80; maxppf = 30; vocales: Set of Char = (['A','E','I','O','U',' ',' ','¡','¢','£']); puntsigns: Set of Char = ([' ','.',',',':',';','(',')','?','¨','-','!']); Type frase = array [1..long_frase] of Char; lista = array [1..maxppf, 0..1] of integer; Var texto: frase; palabras: lista; letra: Char; 32

vocs: Set of Char; longtexto, numpal, pal4voc, index, index2, numvoc: integer; Procedure leerfrase(var arraychar: frase; var index: integer); var letra: Char; begin writeln('El texto acaba con un punto.'); writeln('Introducir texto: '); index := 0; repeat letra := readkey; if not(letra in [#13, #27]) then begin inc(index); write(letra); arraychar[index] := letra end until (index >= long_frase) or (letra = '.'); writeln end; Procedure contarpalabras(var texto: frase; longtexto: integer; var pal: lista; var npal: integer); {Cuenta las palabras que hay en el texto (una palabra es una sucesión de caracteres seguidos), y almacena la posición de cada comienzo y final de palabra, en la tabla "pal", con 2 columnas (una para la posición de comienzo, y otra para la posición de final).} var cont: integer;

33

enpal, anterior: boolean; begin npal := 0; anterior := false; for cont := 1 to longtexto do begin enpal := not(texto[cont] in puntsigns); if enpal then {Estamos sobre una palabra} begin if not(anterior) {Si en el paso anterior era "enpal" = false} then begin inc(npal); {Se trata de una palabra nueva.} {se guarda la posición en donde empieza} pal[npal,0] := cont end end else if anterior then pal[npal,1] := cont; {si ya no estamos sobre una palabra, se guarda la posición donde termina.} anterior := enpal end end; Begin ClrScr; leerfrase(texto, longtexto);

34

contarpalabras(texto, longtexto, palabras, numpal); {En "palabras", tenemos almacenadas las posiciones que ocupan en el texto los comienzos y finales de las palabras que lo componen, y en "numpal" el número de palabras que componen el texto.} pal4voc := 0; {Puesta a cero del contador de palabras con al menos 4 vocales.} for index := 1 to numpal do {Se repite el siguiente proceso para cada palabra:} begin vocs := vocales; {El conjunto "vocs" contiene ahora todas las vocales.} numvoc := 0; for index2 := palabras[index,0] to palabras[index,1] do {"index2" toma valores desde la posición de comienzo de la palabra "palabras[index,0]", hasta la posición de final de palabra [index,1]} begin if upcase(texto[index2]) in vocs then begin inc(numvoc); vocs := vocs − [upcase(texto[index2])] {Si el carácter es una vocal:} {Se incrementa el contador de vocales, y se elimina la vocal correspondiente del conjunto "vocs"} end end; if numvoc >= 4 then inc(pal4voc) {Si la palabra tenía m s de 4 vocales, se incrementa el contador de

35

palabras con 4 vocales.} end; writeln('longitud de texto: ',longtexto); writeln('palabras en texto: ',numpal); writeln('Palabras con al menos 4 vocales: ',pal4voc); readkey end. 16. Escribir un programa que lea una tabla de números reales (dos dimensiones), calcule la suma por filas y por columnas y muestre por pantalla la tabla y las sumas. Si los datos de entrada son: 2.5 10.8 −7.2

−6.3 12.4 3.1

14.7 −8.2 17.7

4.0 5.5 −9.1

Los datos de salida son: 2.5 10.8 −7.2 6.1

−6.3 12.4 3.1 9.2

14.7 −8.2 17.7 24.2

4.0 5.5 −9.1 0.4

14.9 20.5 4.5 0.0

Program t7e16(Input, Output); Uses Crt; Const maxN = 6; {Máximo número de líneas y de columnas de la matriz} Type matriz = array [1..maxN, 1..maxN] of real; vector = array [1..maxN] of real; Var col, afila, fN, cN: integer; sumF, sumC: vector; {Almacenarán las sumas por filas y columnas.} mat1: matriz; {Es la matriz que introduce el usuario.} Begin ClrScr; write('Dime n§ de columnas (m x = 6): '); 36

repeat cN := ord(readkey) − ord('0') until (cN<=6) and (cN>=2); writeln(cN); write('Dime n§ de filas (m x = 6): '); repeat fN := ord(readkey) − ord('0') until (fN<=6) and (fN>=2); writeln(fN); writeln('Introducir elementos de la matriz:'); for mfila := 1 to fN do { para cada fila, y } for col := 1 to cN do { para cada columna:} begin gotoxy(1,5); write('Fila:',mfila:2,' Columna:',mcol:2); gotoxy(7*mcol,mfila+7); read(mat1[mfila, col]); {Se lee el elemento [ mfila, col ] } gotoxy(7*mcol,mfila+7); if mat1[mfila, col] < 0 then textcolor(9) else textcolor(7); write(mat1[mfila, col]:6:1) end; for mfila := 1 to fN do sumf[mfila] := 0; for col := 1 to cN do sumc[col] := 0; {Se inicializan la fila y la columna de sumas. } for mfila := 1 to fN do for col := 1 to cN do begin {Se acumulan las sumas de los elementos por filas y cols.} sumf[mfila] := sumf[mfila] + mat1[mfila, col];

37

sumc[col] := sumc[col] + mat1[mfila, col] end; textcolor(12); for mfila := 1 to fN do begin {Se escriben las sumas por filas} gotoxy(7*(cN+1),mfila+7); {La columna donde se escribe es fija.} write(sumf[mfila]:6:1); {A la derecha de la última.} end; for col := 1 to cN do begin {Se escriben las sumas por columnas} gotoxy(7*mcol,(fN+8)); {La fila donde se escribe es debajo de la última.} write(sumc[col]:6:1); end; writeln; readkey end. 18. Dada una matriz A de orden NxN, girarla 90º en el sentido de las agujas del reloj y guardar el resultado en la matriz B. 1 5 9 13

2 6 10 14

3 7 11 15

4 8 12 16

13 14 15 16

9 10 11 12

5 6 7 8

1 2 3 4

Program t7e18(Input, Output); Uses Crt; Const N = 4; mat1: array [1..N, 1..N] of integer { Matriz de entrada.} = ( ( 1, 2, 3, 4), ( 5, 6, 7, 8), 38

( 9,10,11,12), (13,14,15,16) ); Type matriz = array [1..N, 1..N] of integer; Var col, mfila: integer; mat2: matriz; {Matriz de salida} Begin ClrScr; writeln; writeln(' Se procede a girar la matriz 90 grados'); writeln(' en el sentido de las agujas del reloj:'); for mfila := 1 to N do for col := 1 to N do begin gotoxy(4*mcol,mfila+4); write(mat1[mfila,mcol]:2) end; gotoxy(22,6); write('−−−>'); for mfila := 1 to N do for col := 1 to N do begin mat2[mfila,mcol] := mat1[N−(mcol−1),mfila]; {lo que eran filas, ahora pasan a ser columnas, y además al revés, o sea, la primera fila ser la última columna ...} gotoxy(4*mcol+25,mfila+4); write(mat2[mfila,mcol]:2)

39

end; writeln; readkey end. 20. Dado un array de NxN, sumar los elementos situados por encima de la diagonal principal. Es decir:

Program t7e20(Input, Output); Uses Crt; Const N = 4; mat1: array [1..N, 1..N] of integer = ( ( 1, 2, 3, 4), ( 5, 6, 7, 8), ( 9,10,11,12), (13,14,15,16) ); Type matriz = array [1..N, 1..N] of integer; Var col, mfila: integer; suma: integer; {Ir acumulando la suma de los elementos deseados.} Begin ClrScr; writeln; writeln(' Se procede a sumar los elementos de la matriz'); writeln(' que se encuentren por encima de la diagonal: '); for mfila := 1 to N do for col := 1 to N do {Todos los elementos por encima de la diagonal, cumplen la propiedad de ser su ¡índice de columna mayor que su ¡índice de fila}

40

begin if col > mfila then textcolor(12) else textcolor(7); {se escribir n en rojo los elementos a sumar.} gotoxy(4*mcol+18,mfila+4); write(mat1[mfila,mcol]:2) end; suma := 0; for mfila := 1 to N do for col := mfila+1 to N do suma := suma + mat1[mfila,mcol]; writeln; writeln; writeln(' La suma de los elementos'); write(' por encima de la diagonal es: '); textcolor(12); writeln(suma); textcolor(7); readkey end. 23.− Implementar un subprograma que reciba como dato una frase (tira de longitud máx 80 caracteres) ya leída, y la procese de forma que a través de una ventana (array de 20 caracteres), aparezca dicha frase moviéndose de derecha a izquierda. Cuando por la ventana pase el último carácter de la frase, ésta volverá a desfilar de nuevo desde el principio. Así un número de veces. Dicho número debe ser facilitado al subprograma. También se le facilitará la longitud de la frase. Como salida para la visualización del array ventana, se hará simplemente invocando al procedimiento VISUALIZAR (sin argumentos) que se supondrá ya declarado. Program t7e23(Input, Output); Uses Crt;

41

Const Long_frase = 80; Long_ventana = 20; LetBuenas: Set of Char = (['a'..'z','A'..'Z','0'..'9', ' ','.',',',':',';','(',')','−','¨',' ',' ','¡','¢','£', '£','?','-','!','"','%','/','<','>']); Type frase = array [1..long_frase] of Char; Var texto: frase; veces, long_texto, rapido: integer; Procedure leerfrase(var arraychar: frase; var index: integer); {Lee una frase desde el teclado, sin permitir que se introduzcan caracteres especiales, como , ...Devuelve la longitud.} var letra: Char; begin write('Introduce la frase: '); writeln('La frase acaba con INTRO.'); index := 0; {Se inicializa el ¡índice del array a llenar.} repeat {Se leen caracteres desde teclado hasta leer un INTRO} letra := readkey; if letra in letbuenas then {Si el carácter leído no es de control:} begin inc(index); {se incrementa el índice del array.} write(letra);

42

arraychar[index] := letra {Se guarda en el array.} end until (index >= long_frase) or (letra = #13); repeat {Si el texto leído tiene menor longitud que la ventana,} inc(index); arraychar[index] := ' ' until index >= long_ventana; {se rellena hasta completar.} writeln end; Procedure win(var texto: frase; textlenght, rep: integer); {Visualiza "rep" veces una frase, a través de una ventana de texto.} Type ventana = array [1..long_ventana] of Char; var win1: ventana; {Esta es la porción de texto a visualizar} index, ini, dentro: integer; Procedure visualizar(var winx: ventana); {visualiza un array de caracteres (tipo ventana)} Const posY = 12; {Coordenada de fila.} posX = 30; {Coordenada de columna.} var index: integer; begin textbackground(4); {La ventana ser de fondo de color rojo} for index := 0 to long_ventana−1 do begin

43

{Visualizar el array en pantalla.} gotoxy(posX+index,posY); write(winx[index+1]) end; delay(20*rapido); {Pausa entre "frames" para hacer que el mensaje aparezca más o menos rápido en la ventana} textbackground(0) {Devolver el fondo a color negro.} end; begin repeat {Repetir el número de veces que haya introducido el usuario.} gotoxy(30,15); write('Quedan ',rep−1,' repeticiones.'); for ini := 1 to long_ventana−1 do {La frase comienza a entrar en la ventana por la derecha.} begin dentro := 0; {controla el nº de caracteres del texto que entran en la ventana.} for index := 1 to long_ventana−ini do begin win1[index] := ' '; {La ventana comienza a llenarse con blancos por la izquierda.} inc(dentro); { n§ de blancos que hay a la izquierda del texto} end;

44

for index := dentro to long_ventana do win1[index] := texto[index−dentro+1]; {El resto de caracteres pertenecen al texto.} visualizar(win1) {Se visualiza la ventana.} end; for ini := 1 to textlenght do {Toda la ventana es llenada por caracteres del texto.} begin for index := 1 to long_ventana do win1[index] := texto[ini+index−1]; visualizar(win1) {Se visualiza la ventana.} end; dec(rep) {Se decrementa el contador de repeticiones.} until (rep <= 0) end; Begin ClrScr; writeln('Visualizar una frase en una ventana de texto.'); leerfrase(texto,long_texto); writeln; write('Introduce el número de repeticiones [1..9]: '); repeat veces := ord(readkey) − ord('0') until veces in [1..9]; writeln(veces);

45

write('Velocidad [Rápido = 1 .... 9 = lento]: '); repeat rapido := ord(readkey) − ord('0') until veces in [1..9]; ClrScr; gotoxy(34,11); write('V E N T A N A'); win(texto,long_texto,veces); gotoxy(30,18); write('That`s All Folks ...'); readkey end.

Ejercicios tema 8 2. Leer los nombres y notas de parcial y final de N alumnos de una clase. Hacer un listado con cada una de las notas, la nota media de los dos exámenes y poner APTO si han aprobado y NO APTO si han suspendido. Utilizar un array de registros. Program t8e2(Input, Output); Uses Crt; Const numalumnos = 5; Type tiponotas = record nombre: String; parcial, final: real end; notasclase = array [1..Numalumnos] of tiponotas; Var I3: notasclase; nota1, nota2: real;

46

alumno: String; index: integer; Begin ClrScr; for index := 1 to numalumnos do begin write('Nombre de alumno(',index,'): '); readln(alumno); write('Nota del examen parcial: '); readln(nota1); write('Nota del examen final: '); readln(nota2); writeln; with i3[index] do begin nombre := alumno; parcial := nota1; final := nota2 end end; ClrScr; writeln('NOMBRE ':30,'Parcial':10,'Final':10,'Media':10,' CALIFICACION'); for index := 1 to 75 do write('−'); writeln; for index := 1 to numalumnos do with i3[index] do

47

begin {Escribir la lista con los resultados.} nota1 := (parcial+final)/2; {Se calcula la media.} write(nombre:30,parcial:10:2,final:10:2); write(nota1:10:2); {Si la nota media es superior a 5, el alumno est aprobado:} if nota1 >= 5 then writeln(' *** APTO *** ') else writeln(' NO APTO') end; readkey end.4. Un array de registros contiene la descripción de personas a efectos estadísticos. Cada registro tiene los campos: nombre, edad, sexo, altura, color de pelo, color de piel, color de ojos, nacionalidad y región. Escribir un programa que lea y almacene los datos en este array y visualice después su contenido. Program t8e4(Input, Output); Uses Crt; Const totalmuestreo = 5; Type datos = record nombre: String[25]; nacion, region: String[11]; edad: integer; altura: real; sexo, ColOjos, colPelo, colPiel: Char end; estadistica = array [1..totalmuestreo] of datos; Var Grupo1: Estadistica; nom: String[25];

48

cont, index: integer; Begin ClrScr; index := 1; repeat {Repetir hasta que se introduzca un nombre en blanco:} with grupo1[index] do begin write('Nombre (',index,'): '); readln(nom); {Leer el nombre.} if not(nom = '') then {Si no se introdujo un nombre vacío, entonces leer el resto de datos.} begin nombre := nom; write('País de origen: '); readln(nacion); write('región: '); readln(region); write('Sexo [V/M]: '); repeat sexo := upcase(readkey) until sexo in ['V','M']; {restringe la entrada a "V" o "M".} writeln(sexo); write('Altura [x.xx metros]: ');

49

readln(altura); write('Color de ojos [V, A, M, N, G]: '); repeat colojos := upcase(readkey) until colojos in ['V','A','M','N','G']; writeln(colojos); write('Color de piel [N, B, A, R]: '); repeat colpiel := upcase(readkey) until colpiel in ['N','B','A','R']; writeln(colpiel); write('Color de pelo [N, B, C, R, P]: '); repeat colpelo := upcase(readkey) until colpelo in ['N','B','C','R','P']; writeln(colpelo); writeln; index := index + 1 {Se incrementa el número de muestras.} end end until (index >= totalmuestreo) or (nom = ''); ClrScr; write('NOMBRE':25,'NACION':12,'REGION':12,' EDAD',' SEXO',' ALT.'); writeln(' OJOS',' PIEL',' PELO'); for cont := 1 to 79 do write('Í');

50

writeln; for cont := 1 to index do {Presentar los resultados por pantalla.} with grupo1[cont] do {Cada elemento del array es un registro.} begin write(nombre:25,nacion:12,region:12,edad:5,sexo:5,altura:5:2); writeln(colojos:4,colpiel:5,colpelo:5) end; readkey end. 6. Se dispone de un array con la hora de finalización de un determinado experimento en cada uno de los días del año. Escribir las estructuras de datos necesarias. Implementar un subprograma que modifique la hora de un día en concreto. Program t8e6(Input, Output); Uses Crt; Const diasmes: array [1..12] of integer = (31,28,31,30,31,30,31,31,30,31,30,31); Type experimento = record dia, mes: integer; hora, minuto, segundo: integer end; Var exp: array [1..365] of experimento; {Cada día un registro experimento} index: integer; control, correcto: Char; nomascorrec: boolean; Procedure llenararray;

51

{Para inicializar aleatoriamente los registros de cada día del año.} var diadelmes, numdemes: integer; begin randomize; diadelmes := 1; {Los meses tienen longitud distinta.} numdemes := 1; for index := 1 to 365 do with exp[index] do begin mes := numdemes; dia := diadelmes; hora := random(24); {Valor de 0 a 23.} minuto := random(60); {Valor de 0 a 59.} segundo := random(60); if diadelmes < diasmes[numdemes] then inc(diadelmes) else begin {Si ya se ha completado un mes:} diadelmes := 1; {El siguiente mes empieza en día 1} numdemes := numdemes + 1 {Incrementar número del mes.} end end end; Procedure verarray; {Visualiza los registros de experimento de todos los días.} begin for index := 1 to 365 do with exp[index] do

52

begin write(dia:2,'/',mes:2,' .......... Hora: '); writeln(hora:2,':',minuto:2,':',segundo:2); if (index mod 24) = 0 then readkey end end; Function numdia(dia, mes: integer): integer; {Calcula el número de día del año que corresponde a un día de un mes.} var i, sum: integer; begin sum := 0; for i := 1 to mes − 1 do sum := sum + diasmes[i]; {Todos los meses anteriores están completos.} numdia := sum + dia {Al número de día del mes, hay que sumarle el número de días de los meses anteriores.} end; Procedure editarfecha; var exp_erroneo: experimento; begin repeat writeln('Introducir la fecha del experimento erróneo:'); with exp_erroneo do begin repeat repeat

53

write('Mes: '); readln(mes) until (mes > 0) and (mes <= 12); {El número de mes ha de estar entre 1 y 12.} repeat write('Día: '); readln(dia) until (dia > 0) and (dia <= diasmes[mes]); {El número de día ha de estar entre 1 y el nº de días que tenga el mes.} index := numdia(dia, mes); write('Hora a cambiar: ',exp[index].hora:2,':'); writeln(exp[index].minuto:2,':',exp[index].segundo); write('¨Es este el experimento a modificar? [S/N]: '); repeat correcto := upcase(readkey) until correcto in ['S','N']; writeln(correcto); until correcto = 'S'; writeln('Nueva hora: '); write('Hora: '); readln(hora); write('Minuto: '); readln(minuto); write('Segundo: '); readln(segundo);

54

end; write('¨Todo correcto? [S/N]: '); repeat control := upcase(readkey) until control in ['S','N']; writeln(control) until control = 'S'; with exp[index] do begin hora := exp_erroneo.hora; minuto := exp_erroneo.minuto; segundo := exp_erroneo.segundo end; writeln('Corrección guardada.') end; Begin ClrScr; llenararray; repeat verarray; editarfecha; write('¨Más cambios? [S/N]: '); repeat control := upcase(readkey) until control in ['S','N']; writeln(control); nomascorrec := (control = 'N') until nomascorrec; writeln; writeln('That`s All Folks ...');

55

readkey end. 12. Se plantea subir el sueldo de los empleados de una empresa en un 20% si tienen una antigüedad mayor que 40 años y casados. Un 10% a los no casados y con igual antigüedad. Un 5% al resto. Escribir el programa con los tipos de datos mas apropiados. Program t8e12(Input, Output); uses Crt; Const MaxEmpl = 5; {Suficiente para contemplar todas las combinaciones de actualización.} Type Empleado = record nombre: String[25]; casado: Boolean; Antiguedad: integer; salario: longint end; Var nomina: array [1..MaxEmpl] of empleado; Procedure hazplantilla; {Lee desde teclado los datos referentes a los empleados.} var numempleado: integer; est_civil: Char; begin for numempleado := 1 to MaxEmpl do with nomina[numempleado] do begin write('Nombre empleado(',numempleado,'): '); readln(nombre); write('Antigüedad [en años]: ');

56

readln(antiguedad); write('Estado civil [S/C]: '); repeat est_civil:= upcase(readkey) until est_civil in ['S','C']; {Solo acepta como entradas S, o C} writeln(est_civil); casado := (est_civil = 'C'); write('Salario base: '); readln(salario); writeln; end end; Procedure Subirsueldo; {Actualiza los sueldos, y muestra por pantalla el listado de los datos de los empleados.} var numempleado: integer; Procedure actualizar(var trabajador: empleado); {Actualiza el salario de un trabajador.} var incremento: integer; Function porcentaje(antig: integer; estciv: boolean): integer; {Devuelve el porcentaje de aumento en función de la antigüedad y del estado civil del empleado.} begin if (antig >= 40) then if estciv

57

then porcentaje := 20 else porcentaje := 10 else porcentaje := 5 end; begin with trabajador do begin incremento := porcentaje(antiguedad, casado); {Guarda el porcentaje de aumento para el empleado.} salario := salario + ((salario * incremento) div 100) {Calcula el nuevo salario y lo guarda en su registro.} end end; begin ClrScr; writeln('NOMBRE':25,'Ant':5,' E.civ',' Salario',' Actualizado'); for numempleado := 1 to MaxEmpl do {Para cada empleado, hacer:} with nomina[numempleado] do {Con el registro de datos del empleado:} begin write(nombre:25,antiguedad:5); if casado then write(' C ') else write(' S '); write(salario:8); {Escribir los datos personales y el salario antiguo.}

58

actualizar(nomina[numempleado]); {Actualizar el salario, y escribir el salario actualizado.} writeln(salario:12) end end; Begin ClrScr; hazplantilla; subirsueldo; readkey end.

Ejercicios tema 9 2. Contar el número de vocales (cada una) que aparecen en un fichero de texto. Program t9e2(Input, Output); uses Crt; Type vocales = (a,e,i,o,u); Var acumulador: array [a..u] of integer; fichero: Text; letra: Char; index: vocales; archivo: String; control: boolean; contador: integer; Begin ClrScr;

59

for index := a to u do acumulador[index] := 0; {Inicializa los elementos del acumulador a cero.} contador := 0; {Contar el n§ de veces que se intente abrir un archivo de texto.} repeat write('Nombre de archivo: '); readln(archivo); inc(contador); if archivo = '' then archivo := 'c:\tp\bin\temas\tema9\t9e2dat.txt'; {Si el usuario no introduce el nombre, se aplica uno por defecto. } assign(fichero, archivo); {Se asigna el nombre del archivo a la variable fichero de texto.} {$I−} reset(fichero); {Antes de intentar abrir el archivo, se desactiva el control de errores mediante la directiva del compilador $I− que ha de ir entre llaves. Después se intenta abrir el archivo, y se vuelve a activar el control.} {$I+} control := (ioresult = 0); if not control then writeln('Error en apertura de fichero.!!'); {Si se produjo un error en la apertura del archivo porque el archivo no existe o cualquier otra causa, la variable "ioresult" contendrá un valor distinto de cero, y si no se produjo ningún error y el archivo pudo ser abierto, contendrá el valor cero. } writeln until control or (contador >= 3);

60

if (contador >= 3) and not(control) then Halt(1); {Si no se pudo abrir el archivo parar la ejecución del programa.} while not eof(fichero) do {Repetir el siguiente proceso hasta que se detecte la marca de final de fichero.} begin while not eoln(fichero) do {Para cada línea de texto se repite el siguiente proceso:} begin read(fichero, letra); {Leer un carácter del archivo.} write(letra); {Escribir el carácter por pantalla.} letra := upcase(letra); {convertir el carácter a mayúsculas.} case letra of {Si el carácter es una vocal o una vocal acentuada, se incrementa el acumulador correspondiente a dicha vocal.} 'A','á': inc(acumulador[a]); 'E','é': inc(acumulador[e]); 'I','í': inc(acumulador[i]); 'O','ó': inc(acumulador[o]); 'U','ú','ü': inc(acumulador[u]) end end; if not eof(fichero) then

61

{Se ha alcanzado una marca de final de línea, y si no es final de archivo, hay que leer otro carácter, porque la marca de final de línea se compone de dos: Avance de línea (#10) y retorno de carro (#13).} begin read(fichero, letra); write(letra) end end; close(fichero); {Una vez se ha leído todo el archivo, hay que cerrarlo} writeln; for index := a to u do {Presentar por pantalla los valores de los acumuladores:} begin case index of a: write(' A: '); e: write(' E: '); i: write(' I: '); o: write(' O: '); u: write(' U: ') end; writeln(acumulador[index]:3,' veces.') end; readkey end. 5. Escribir un programa que cuente el número de palabras de un texto. Las palabras terminan cuando hay un espacio en blanco, o un `.', `,', `;' o termina la línea o el fichero. 62

Program t9e5(Input, Output); uses Crt; Var fichero: Text; letra: Char; contador: integer; palabra: String; control: boolean; Begin ClrScr; contador := 0; {Contar el nº de veces que se intente abrir un archivo de texto.} repeat write('Nombre de archivo: '); readln(palabra); inc(contador); if palabra = '' then palabra := 'c:\tp\bin\temas\tema9\t9e2dat.txt'; {Si el usuario no introduce el nombre, se aplica uno por defecto. } assign(fichero, palabra); {Se asigna el nombre del archivo a la variable fichero de texto.} {$I−} reset(fichero); {Antes de intentar abrir el archivo, se desactiva el control de errores mediante la directiva del compilador $I− que ha de ir entre llaves. Después se intenta abrir el archivo, y se vuelve a activar el control.} {$I+} control := (ioresult = 0);

63

if not control then writeln('Error en apertura de fichero.!!'); {Si se produjo un error en la apertura del archivo porque el archivo no existe o cualquier otra causa, la variable "ioresult" contendrá un valor distinto de cero, y si no se produjo ningún error y el archivo pudo ser abierto, contendrá el valor cero. } writeln until control or (contador >= 3); if (contador >= 3) and not(control) then Halt(1); {Si no se pudo abrir el archivo parar la ejecución del programa.} contador := 0; palabra := ''; control := false; while not eof(fichero) do {Mientras que no se encuentre el final de archivo:} begin while not eoln(fichero) do {Para cada línea de texto hacer:} begin read(fichero, letra); {Leer un carácter del archivo.} if not(letra in [' ', ',', '.', ';', ':', #13, #10]) {Si el carácter no es un signo de puntuación o un blanco:} then begin if not control then inc(contador); {"Control" vale true cuando el anterior carácter no era un signo de puntuación, o sea, que la palabra ya había

64

empezado, y false si la palabra empieza en este carácter.} control := true; palabra := palabra + letra {Se añade el carácter a la palabra.} end else begin {El carácter leído es un signo de puntuación o un blanco, por lo que la palabra ha terminado.} control := false; writeln('Palabra(',contador,'): ',palabra); {Se escribe la palabra en pantalla.} palabra := ''; {Se borra la palabra para empezar con la siguiente.} if (contador mod 24) = 0 then readkey; {Pausa para ver una pantalla (24 líneas)} while ((letra in [' ', ',', '.', ';', ':', #13, #10]) or eoln(fichero)) and not(eof(fichero)) do {Mientras que el carácter leído siga siendo un signo, o un blanco, o una marca de final de línea o de fichero, que son los que separan las palabras, hay que seguir leyendo caracteres sin aumentar el n§ de palabras:} begin read(fichero, letra); if not(letra in [' ', ',', '.', ';', ':', #13, #10]) {Se ha encontrado el comienzo de una nueva palabra.} then begin

65

inc(contador); palabra := palabra+letra; {Se añade el carácter a la nueva palabra.} control := true {Se activa el control de palabra.} end end end end; if not eof(fichero) then {Se alcanzó el final de línea.} begin {Hay que leer el segundo carácter de la marca.} read(fichero, letra); write(letra) end end; close(fichero); {Una vez terminada la lectura del archivo, hay que cerrarlo.} writeln; writeln('Total: ',contador,' palabras.'); readkey end. 6. Realizar un programa que lea un fichero de texto (entrada) y que escriba un fichero de texto (salida) que contenga solamente las palabras leídas que tengan un número impar de letras y además la del medio sea vocal. El fichero de entrada sólo contendrá caracteres alfabéticos, espacios en blanco y saltos de línea. Se supone que la longitud de las palabras no excede en ningún caso de 33 caracteres. Program t9e6(Input, Output); 66

uses Crt; Const vocales: Set of Char = (['A','E','I','O','U']); Var fichero, ficsalida: Text; letra: Char; contletras, contpal, escritas: integer; palabra: String; control: boolean; Begin ClrScr; contpal := 0; repeat write('Nombre de archivo: '); readln(palabra); inc(contpal); if palabra = '' then palabra := 'c:\tp\bin\temas\tema9\t9e2dat.txt'; {Si el usuario no introduce el nombre, se aplica uno por defecto. } assign(fichero, palabra); {Se asigna el nombre del archivo a la variable fichero de texto.} {$I−} reset(fichero); {Antes de intentar abrir el archivo, se desactiva el control de errores mediante la directiva del compilador $I− que ha de ir entre llaves. Después se intenta abrir el archivo, y se vuelve a activar el control.} {$I+} control := (ioresult = 0); if not control then writeln('Error en apertura de fichero.!!');

67

{Si se produjo un error en la apertura del archivo porque el archivo no existe o cualquier otra causa, la variable "ioresult" contendrá un valor distinto de cero, y si no se produjo ningún error y el archivo pudo ser abierto, contendrá el valor cero. } writeln until control or (contpal >= 3); if (contpal >= 3) and not(control) then Halt(1); {Si no se pudo abrir el archivo parar la ejecución del programa.} write('Nombre de archivo de salida: '); readln(palabra); if palabra = '' then {Si el usuario no introduce el nombre, se aplica uno por defecto. } begin palabra := 't9e6out.txt'; writeln; writeln('El archivo de salida es T9E6OUT.TXT'); readkey; writeln end; assign(ficsalida, palabra); {Se asigna el fichero de salida.} rewrite(ficsalida); {Se abre el fichero de salida. No hace falta controlar si ha habido un error en la apertura, porque "rewrite" crea un nuevo archivo.} palabra := ''; control := false;

68

contpal := 0; contletras := 0; escritas := 0; while not eof(fichero) do begin while not eoln(fichero) do begin read(fichero, letra); if not(letra in [' ', ',', '.', ';', ':', #13, #10]) then begin if not control then inc(contpal); control := true; inc(contletras); palabra := palabra + letra end else begin control := false; write('Palabra (',contpal,'): ',palabra); if odd(contletras) {Una vez separada la palabra del archivo, se comprueba si la letra central es una vocal. Para ello, lo primero es saber si existe una letra central comprobando si la palabra tiene un número impar de letras.} then begin if (upcase(palabra[(contletras div 2)+1]) in vocales) {Si hay una letra central, se comprueba si es una vocal.}

69

then begin {En caso de serlo, se incrementa el n§ de palabras que se escriben el fichero de salida, y se escribe la palabra en el archivo.} inc(escritas); writeln(' ....... **** Escrita en fichero. **** '); writeln(ficsalida,palabra) end else writeln end else writeln; palabra := ''; {Se comienza el proceso con una nueva palabra.} contletras := 0; if (contpal mod 24) = 0 then readkey; {Pausa} while ((letra in [' ', ',', '.', ';', ':', #13, #10]) or eoln(fichero)) and not(eof(fichero)) do begin read(fichero, letra); if not(letra in [' ', ',', '.', ';', ':', #13, #10]) then begin inc(contpal); inc(contletras); palabra := palabra+letra; control := true end

70

end end end; if not eof(fichero) then begin read(fichero, letra); write(letra) end end; close(fichero); close(ficsalida); {Se cierran los dos ficheros, el de lectura y el de escritura.} writeln; writeln('Total: ',contpal,' palabras.'); writeln; writeln(escritas,' palabras escritas en el archivo de salida.'); readkey end. 7. Escribir un programa que cuente el número de palabras en un texto, que tengan al menos cuatro vocales diferentes. Se supone que las palabras no están cortadas al final de las líneas. Program t9e7(Input, Output); uses Crt; Const vocales: Set of Char = (['A','E','I','O','U',' ',' ','¡','¢','£','£']); separadores: Set of Char = ([' ', ',', '.', ';', ':', #13, #10, '(',')','?','¨','-','!','"','−','+','[','''',']']); Var fichero: Text; vocenpal: Set of Char; 71

letra: Char; contador, index, contletras, contpal, pal4voc, numvoc: integer; palabra, archivo: String; control: boolean; Begin ClrScr; contador := 0; {Contar el nº de veces que se intente abrir un archivo de texto.} repeat write('Nombre de archivo: '); readln(archivo); inc(contador); if archivo = '' then archivo := 'c:\tp\bin\temas\tema9\t9e7dat.txt'; {Si el usuario no introduce el nombre, se aplica uno por defecto. } assign(fichero, archivo); {Se asigna el nombre del archivo a la variable fichero de texto.} {$I−} reset(fichero); {Antes de intentar abrir el archivo, se desactiva el control de errores mediante la directiva del compilador $I− que ha de ir entre llaves. Después se intenta abrir el archivo, y se vuelve a activar el control.} {$I+} control := (ioresult = 0); if not control then writeln('Error en apertura de fichero.!!'); {Si se produjo un error en la apertura del archivo porque el archivo no existe o cualquier otra causa, la variable "ioresult" contendrá un

72

valor distinto de cero, y si no se produjo ningún error y el archivo pudo ser abierto, contendrá el valor cero. } writeln until control or (contador >= 3); if (contador >= 3) and not(control) then Halt(1); {Si no se pudo abrir el archivo, parar la ejecución del programa.} palabra := ''; control := false; contpal := 0; contletras := 0; pal4voc := 0; while not eof(fichero) do begin while not eoln(fichero) do begin read(fichero, letra); if not(letra in separadores) {Si el carácter leído no es un signo:} then begin if not control then inc(contpal); control := true; inc(contletras); palabra := palabra + letra end else begin control := false;

73

write('Palabra (',contpal,'): ',palabra); numvoc := 0; vocenpal := vocales; {El conjunto vocenpal contiene ahora las 5 vocales} for index := 1 to contletras do {Hay que comprobar si la palabra contiene al menos cuatro vocales distintas, para ello se recorren todos los caracteres que componen la palabra.} if (upcase(palabra[index]) in vocenpal) {Si el carácter de la palabra est en el conjunto,} then begin inc(numvoc); {Se incrementa el contador de vocales,} vocenpal := vocenpal − [upcase(palabra[index])] {Se elimina la vocal del conjunto.} end; if numvoc >= 4 {Si se han contado al menos 4 vocales,} then begin inc(pal4voc); {Se incrementa el contador de palabras con 4 vocales} writeln(' ....... **** Palabra con 4 vocales ****') end else writeln; palabra := ''; contletras := 0;

74

if (contpal mod 24) = 0 then readkey; {Pausa} while ((letra in separadores) or eoln(fichero)) and not(eof(fichero)) do begin read(fichero,letra); if not(letra in separadores) then begin inc(contpal); inc(contletras); palabra := palabra+letra; control := true end end end end; if not eof(fichero) then begin read(fichero,letra); write(letra) end end; close(fichero); {Se cierra el fichero.} writeln; writeln('Total: ',contpal,' palabras.'); writeln;

75

writeln('Palabras con al menos 4 vocales distintas: ',pal4voc,' palabras.'); readkey end. 9. Se dispone de dos archivos de enteros, cada uno en una línea. Se desea sumar los valores de los números que ocupan la misma línea y llenar con ellos un archivo. Los archivos pueden tener longitudes distintas. Program t9e9(Input, Output); Uses Crt; Type intfic = file of integer; Var fic1, fic2, outfic: intfic; int1, int2, suma, contador: integer; Extension: String; Begin ClrScr; writeln('Se trata de crear un archivo de números enteros '); writeln('que son la suma de los que hay en otros dos archivos:'); writeln('Los números se suman por filas, y si los dos archivos'); writeln('no contienen el mismo número de filas, cuando se acabe'); writeln('el contenido de uno, se escribirá sólo lo que quede de el otro.'); writeln; writeln('Pulsa una tecla para continuar ...'); readkey; ClrScr; extension := '\tp\bin\temas\tema9\'; assign(fic1, extension + 't9e9dat1.txt'); assign(fic2, extension + 't9e9dat2.txt'); assign(outfic, extension + 't9e9out.txt'); rewrite(fic1); 76

rewrite(fic2); for contador := 1 to 15 do write(fic1,contador); for contador := 20 to 30 do write(fic2,contador); reset(fic1); reset(fic2); rewrite(outfic); contador := 0; {Cuenta la línea de archivo leída.} while not(eof(fic1)) and not(eof(fic2)) do {Mientras que no se llegue al final en alguno de los dos archivos:} begin inc(contador); read(fic1,int1); read(fic2,int2); suma := int1+int2; writeln('Línea ',contador:3,': ',int1:3,' + ',int2:3,' = ',suma:4); write(outfic,suma) end; {Si uno de los archivos aun no ha llegado al final, hay que añadir al archivo de salida los números que queden en el.} if eof(fic1) then begin while not(eof(fic2)) do begin inc(contador); read(fic2,int2);

77

writeln('Añadiendo de fichero 2 línea ',contador,': ',int2); write(outfic,int2) end end else while not(eof(fic1)) do begin inc(contador); read(fic1,int1); writeln('Añadiendo de fichero 1 línea ',contador,': ',int1); write(outfic,int1) end; writeln; writeln('Ficheros procesados.'); close(fic1); close(fic2); close(outfic); readkey end. 11. Se dispone de tres ficheros de alumnos, uno para cada grupo I1, I2, I3. Se quiere obtener un nuevo fichero con los alumnos no presentados en la convocatoria. Un alumno no presentado tiene como nota final un 0. Program t9e11(Input, Output); Uses Crt; Const ficI1 = 'I1.dat'; ficI2 = 'I2.dat'; ficI3 = 'I3.dat'; Type alumno = record nombre: String[25]; 78

nota_exam, nota_final: real end; ficalumnos = file of alumno; Var I1, I2, I3, NoPres: ficalumnos; ficha: alumno; Datosnuevos: Char; Procedure llenarfic(archivo: String); {Crea un archivo con los datos de los alumnos de un grupo.} var fic: file of alumno; ficha: alumno; fin: boolean; entrada: Char; begin writeln('Llenando archivo .... ',archivo); assign(fic,archivo); rewrite(fic); repeat with ficha do begin writeln; writeln('*** Alumno Nuevo ***'); write('Nombre: '); readln(nombre); write('Nota de examen: '); read(nota_exam); write(' Nota final: ');

79

readln(nota_final) end; writeln; write('¨Introducir otro alumno? [S/N]: '); repeat entrada := upcase(readkey) until entrada in ['S','N']; writeln(entrada); fin := (entrada = 'N'); write(fic,ficha) {Escribir el registro en el archivo.} until fin; close(fic) end; Procedure AddNoP(var fic, NoP: ficalumnos); {Añade los alumnos de un grupo que sean no presentados al archivo de no presentados.} var ficha: Alumno; begin while not(eof(fic)) do {mientras que no se llegue al final del fichero de alumnos del grupo:} begin read(fic,ficha); {Lee los datos de un alumno, y los almacena en el registro "ficha"} with ficha do {Presenta por pantalla los datos del alumno.}

80

begin write('Alumno: ',nombre); write(' −−− Nota final: ',nota_final:5:2) end; if ficha.nota_final = 0 then {Si la nota final es cero, se considera como no presentado.} begin writeln(' *** NO PRESENTADO ***'); write(NoP,ficha) end else writeln end; writeln; end; Begin ClrScr; write('¨ Crear los archivos de los grupos ? [S/N]: '); repeat datosnuevos := upcase(readkey) until datosnuevos in ['S','N']; ClrScr; if datosnuevos = 'S' then begin llenarfic(ficI1); llenarfic(ficI2); llenarfic(ficI3)

81

end; assign(I1,ficI1); assign(I2,ficI2); assign(I3,ficI3); reset(I1); reset(I2); reset(I3); Assign(Nopres,'No_pres.dat'); rewrite(Nopres); {Se abre para escritura el archivo de no presentados.} writeln('Grupo I1:'); AddNoP(I1,Nopres); writeln('Grupo I2:'); AddNoP(I2,Nopres); writeln('Grupo I3:'); AddNoP(I3,Nopres); close(I1); close(I2); close(I3); {Se cierran los archivos de los grupos.} reset(Nopres); {Se abre para lectura el archivo de no presentados.} writeln; writeln('*** ALUMNOS NO PRESENTADOS ***'); while not(eof(Nopres)) do begin

82

read(Nopres,ficha); writeln(' −> ',ficha.nombre) end; close(Nopres); {Se cierra el archivo de no presentados.} readkey end.

Ejercicios tema 10 2. Crear una lista enlazada con los datos de los alumnos de una clase. Los datos son: nombre, nota parcial, nota final, nota de trabajos y un campo booleano que indique si está suspendido o aprobado. Los datos los introduce el usuario. No se sabe el número de alumnos de la clase. Cada vez que el usuario introduzca los datos de un alumno el programa preguntará si quiere seguir introduciendo datos. Considerar primero que cada nuevo alumno que se inserta es el primero de la lista y después que es el ultimo de la lista. Al finalizar la inserción de datos, recorrer la lista mostrando el orden en el que han quedado los alumnos. Program t10e2(Input, Output); Uses Crt; Type alumno = record nombre: String[34]; parcial, final, trabajos: real; apto: boolean end; Pnodo = ^nodo; nodo = record info: alumno; enlace: Pnodo {Listas simplemente enlazadas.} end; Var cabeza1, cabeza2, cola2: Pnodo; 83

Procedure iniciar1(var lista: Pnodo); {Inicializa una lista poniendo a NIL su puntero cabeza.} begin lista := nil end; Procedure iniciar2(var lista,cola: Pnodo); {Inicializa una lista poniendo a NIL sus punteros cabeza y cola.} begin lista := nil; cola := nil end; Procedure introdatos; {Lee los datos de los alumnos desde el teclado y los enlaza en una lista} var ficha: alumno; nombrefic: String; fic: file of alumno; puntaux: Pnodo; desdearchivo, terminar, correcto: boolean; entrada: Char; redondeo: integer; notamedia: real; Function si_no(pregunta: String): Char; {Devuelve un carácter, que es la respuesta a una pregunta del tipo SI − NO. Se le pasa como par metro un String que contenga la pregunta a realizar al usuario.}

84

var oSioNo: Char; begin pregunta := pregunta + ' [S/N]: '; {Se añade a la pregunta, las respuestas posibles, para que el usuario las vea en pantalla.} write(pregunta); repeat osiono := upcase(readkey) until osiono in ['S','N']; {La respuesta del usuario podrá ser sólo S o N.} writeln(osiono); si_no := oSioNo end; Function creanodo(nuevaficha: alumno): Pnodo; {A partir de un registro de tipo alumno, crea una variable din mica de tipo nodo.} var aux: Pnodo; begin new(aux); {Se reserva memoria din mica para un nodo.} aux^.info := nuevaficha; {Se inicializa el campo info del nodo con el registro de los datos del alumno.} aux^.enlace := nil; {Se inicializa el enlace del nodo a NIL} creanodo := aux

85

end; Procedure inscabeza(var lista: Pnodo; nuevo: Pnodo); {Inserta un nodo en la cabeza de una lista.} var aux: Pnodo; begin if lista = nil then lista := nuevo {Si la lista estaba vacía, se asigna al puntero cabeza para que apunte al nuevo nodo. No hace falta modificar el nodo porque su campo enlace ya apunta a NIL.} else begin {La lista no estaba vacía.} aux := lista; {Se guarda en un puntero auxiliar la dirección del primer nodo de la lista, que es el que apunta la cabeza.} lista := nuevo; {Se hace que la cabeza de la lista sea el nuevo nodo.} nuevo^.enlace := aux {Se hace que el puntero enlace del nodo insertado, apunte al nodo que antes era la cabeza de la lista. De esta manera la lista vuelve a quedar enlazada.} end end; Procedure inscola(var lista, coladelista: Pnodo; nuevo: Pnodo); {Inserta un nodo en el final de una lista.} var aux: Pnodo; begin

86

if lista = nil {Si la lista estaba vacía:} then begin lista := nuevo; coladelista := nuevo {Se asigna tanto al puntero cabeza como al de cola, para que apunten al nuevo nodo, ya que como es el único nodo en la lista, es a la vez cabeza y cola de la lista.} end else begin {La lista no estaba vacía, entonces:} aux := coladelista; {Se almacena en un puntero auxiliar, a donde apunta el puntero de cola de la lista.} coladelista := nuevo; {Se asigna al puntero de cola, para que apunte al nuevo nodo.} aux^.enlace := nuevo {Se hace que el puntero enlace del nodo que antes era la cola de la lista, apunte al nodo que se inserta, de esta forma la lista vuelve a estar enlazada.} end end; Procedure leerteclado; {Si no se leen los datos desde un archivo, hay que leerlos desde el teclado, y guardarlos en un archivo para que pueda accederse a ellos posteriormente.}

87

begin writeln('****** Nuevo alumno ******'); writeln; repeat with ficha do begin write('Nombre: '); readln(nombre); if nombre <> '' then begin write('Examen parcial (20%): '); readln(parcial); write('Examen final (60%): '); readln(final); write('Trabajos (20%): '); readln(trabajos); notamedia := (20*parcial+60*final+20*trabajos)/100; {Se calcula la nota media según los pesos de cada nota.} redondeo := round(notamedia); {Se redondea la nota media.} apto := redondeo >= 5; {Se considera apto al alumno que como mínimo saque un 5.} writeln('Nota media obtenida: ',notamedia:5:2); write('Nota después del redondeo: ',redondeo); if apto then writeln(' APROBADO') else writeln(' SUSPENSO')

88

end end; entrada := si_no('¨Los datos son correctos?'); {Llamada a la función si_no, que devolverá la respuesta.} correcto := (entrada = 'S'); writeln until correcto; write(fic,ficha); {Se escribe la ficha en el archivo.} writeln end; begin terminar := false; Entrada := si_no('¨Introducir datos desde archivo?'); desdearchivo := (entrada = 'S'); if desdearchivo then write('Nombre del archivo de datos:') else write('Escribir los datos en el archivo:'); readln(nombrefic); if nombrefic = '' then nombrefic := 't10e2.dat'; writeln('Introduciendo datos de alumnos ...'); writeln; assign(fic,nombrefic); if desdearchivo then begin {$I−}

89

reset(fic); {$I+} if ioresult <> 0 then begin writeln('Error en la apertura del archivo ',nombrefic); halt(1) end end else rewrite(fic); repeat if not(desdearchivo) then Leerteclado else begin if not(eof(fic)) then read(fic,ficha) else terminar := TRUE end; if not(terminar) then begin if ficha.nombre <> '' then begin puntaux := creanodo(ficha); {El puntero auxiliar "puntaux", apunta ahora al nuevo nodo creado por la función "creanodo" con los datos introducidos por el usuario desde el teclado, que se guardan en "ficha".} inscabeza(cabeza1,puntaux); {Se inserta el nodo en cabeza de la lista 1 ("cabeza1" apunta

90

al nodo cabeza de la lista 1)} puntaux := creanodo(ficha); {Se crea otro nodo con los mismos datos, para insertarlo en la cola de la segunda lista.} inscola(cabeza2,cola2,puntaux) {Se inserta el nodo en la cola de la lista 2. } end end; if not(desdearchivo) then begin entrada := si_no('¨Introducir m s alumnos?'); writeln; terminar := (entrada = 'N') end until terminar; close(fic) end; Procedure Verlistas(lis1, lis2: Pnodo); {Visualiza por pantalla las dos listas, mostrando cómo el orden en que quedan las fichas de los alumnos insertando en la cabeza de la lista, es al revés de como quedan insertando en la cola. Los par metros "lis1" y "lis2" son los punteros cabeza de las listas.} var orden: integer; begin ClrScr; if lis1 = nil then writeln('No hay ningún alumno en la lista.')

91

{Si la lista 1 est vacía, la otra también. Como las dos listas tienen el mismo número de nodos, no es necesario controlar m s que una de ellas.} else begin {Si las listas no est n vacías, entonces:} write('INSERTANDO EN CABEZA':27); writeln('INSERTANDO EN COLA':34); for orden := 1 to 79 do write('Í'); writeln; orden := 0; while (lis1 <> nil) do {Mientras que el puntero "lis1" no apunte a NIL, cosa que ocurrir cuando se alcance el último nodo de la lista.} begin inc(orden); write(orden:3,' '); write(lis1^.info.nombre,' ':36−length(lis1^.info.nombre)); {Escribir en pantalla el campo nombre del registro info del nodo al que apunta el puntero "lis1".} lis1 := lis1^.enlace; {Asignar al puntero para que apunte al siguiente nodo de la lista. Si el enlace del actual nodo al que apunta "lis1", est apuntando a NIL, entonces se ha llegado al final de la lista 1.} writeln(lis2^.info.nombre); lis2 := lis2^.enlace

92

{Se sigue el mismo proceso que con la lista 1.} end; writeln; writeln('Total: ',orden,' alumnos en las listas.'); readkey end end; Procedure resetMem; {Libera la memoria din mica reservada para los nodos de las listas.} var aux: Pnodo; cont: integer; begin ClrScr; cont := 0; while cabeza1 <> nil do {Las dos listas tienen el mismo número de nodos, por lo que sólo es necesario controlar el final de lista en una de ellas. Mientras que el puntero cabeza sea distinto de NIL:} begin inc(cont); writeln('Liberando nodo n§ ',cont); aux := cabeza1; {El puntero cabeza est apuntando a un nodo. Se hace que el puntero auxiliar "aux" apunte al mismo nodo, para que éste no quede perdido cuando se avance en la lista.} cabeza1 := cabeza1^.enlace;

93

{Se asigna al puntero cabeza el siguiente nodo de la lista. El que antes era el nodo cabecera de la lista, no se ha perdido, porque queda apuntado por el puntero auxiliar "aux".} dispose(aux); {Se libera la memoria reservada para el nodo al que apunta "aux"} aux := cabeza2; {Se repite el mismo proceso para la segunda lista.} cabeza2 := cabeza2^.enlace; dispose(aux) end end; Begin ClrScr; iniciar1(cabeza1); {En la lista 1 se va a insertar en la cabeza de la lista, por lo que no hace falta inicializar la cola de la lista.} iniciar2(cabeza2,cola2); {Para insertar en cola, es aconsejable contar con un puntero que apunte al último nodo de la lista, por ello se inicializan dos punteros para la segunda lista: Uno de cabeza y otro de cola.} introdatos; {Introducir datos de los alumnos desde teclado.} verlistas(cabeza1,cabeza2); {Ver cómo han quedado las listas utilizando distinto tipo de inserción en cada una de ellas.} resetMem;

94

{Liberar la memoria din mica reservada.} writeln; writeln('That`s All Folks ...'); readkey end. 4. Dada una lista de alumnos de una clase, doblemente enlazada, ordenada alfabéticamente, mostrar la lista en orden inverso. Cabeza es un puntero al primer elemento de la lista y cola un puntero al ultimo. La lista está declarada como se indica a continuación: TYPE puntero = ^nodo; nodo = record nombre : String; parcial, final, trabajos : real; aprobado : booleano; prox, ant : puntero end; VAR cabeza, cola : puntero; Program t10e4(Input, Output); Uses Crt; Type alumno = record nombre: String[34]; parcial, final, trabajos: real; apto: boolean end; Pnodo = ^nodo; nodo = record info: alumno; prox, ant: Pnodo

95

{Lista doblemente enlazada.} end; Var cabeza, cola: Pnodo; Procedure iniciar(var lista, cola: Pnodo); {Inicializa a nil los punteros de cabeza y de cola de una lista.} begin lista := nil; cola := nil end; Procedure crealista; {Crea una lista doblemente enlazada a partir de los datos guardados en un archivo. La lista ser doblemente enlazada para poder recorrerla en sentido inverso: Cada nodo tendrá un puntero enlace hacia el nodo anterior en la lista.} var ficha: alumno; nombrefic: String; fic: file of alumno; puntaux: Pnodo; terminar: boolean; Function creanodo(nuevaficha: alumno): Pnodo; {Reserva memoria din mica para un nodo, inicializa su campo de información con los datos del nuevo alumno y devuelve un puntero apuntando al nodo.} var aux: Pnodo; begin new(aux);

96

{Reserva la memoria, y hace que el puntero apunte a la variable din mica (nodo de la lista).} aux^.info := nuevaficha; {Inicializa el campo de información con los datos.} aux^.prox := nil; aux^.ant := nil; {Inicializa a NIL los punteros de enlace del nodo con el nodo siguiente y con el nodo anterior.} creanodo := aux end; Procedure inscola(var lista, coladelista: Pnodo; nuevo: Pnodo); {Inserta un nodo en la cola de una lista doblemente enlazada.} var aux: Pnodo; begin if lista = nil then {Si la lista est vacía, } begin lista := nuevo; coladelista := nuevo {Hace que los punteros de cabeza y cola de la lista apunten al nuevo nodo.} end else begin {Si la lista no estaba vacía:} aux := coladelista; {El puntero auxiliar apunta ahora hacia el último nodo de

97

la lista, para no perder la referencia de este nodo.} nuevo^.ant := aux; {Se inicializa el enlace del nodo que se va a insertar hacia el nodo anterior en la lista, que es el que antes era la cola.} coladelista := nuevo; {La cola de la lista es ahora el nodo insertado, y se hace que el puntero de cola apunte a este nodo.} aux^.prox := nuevo {El enlace del que antes era el último nodo de la lista, hacia el próximo nodo, se hace que apunte hacia el nodo insertado, que es ahora el último, quedando as¡ la lista de nuevo enlazada.} end end; begin terminar := false; nombrefic := 't10e2.dat'; {Se utiliza el mismo archivo que para el ejercicio 2} assign(fic,nombrefic); reset(fic); while not(eof(fic)) do {Mientras que no se alcance el final de fichero:} begin read(fic,ficha); {Se lee un registro del archivo.} writeln('Leyendo ... ',ficha.nombre);

98

puntaux := creanodo(ficha); {Puntaux apunta ahora al nodo creado por la función creanodo con los datos del registro leído del archivo.} inscola(cabeza,cola,puntaux) {Se inserta el nodo en la lista.} end; close(fic); {Se cierra el fichero.} writeln; writeln('Finalizada lectura de archivo ',nombrefic); writeln; writeln('Pulsa una tecla para continuar ...'); readkey end; Procedure Veralreves(findelista: Pnodo); {Visualiza una lista en orden inverso. Hay que pasarle como par metro el puntero que apunta al final de la lista.} begin ClrScr; if findelista = nil then writeln('No hay ningún alumno en la lista.') else begin {Si la lista no est vacía:} writeln('La lista visualizada al revés:'); writeln; while (findelista <> nil) do {Mientras que el puntero que recorre la lista no apunte a NIL:}

99

begin writeln(' ':6,findelista^.info.nombre); {Escribir el nombre del alumno que almacena el nodo.} findelista := findelista^.ant {Hacer que el puntero que recorre la lista apunte al nodo anterior, que est apuntado por el enlace del nodo hacia el nodo anterior en la lista. Si el nodo al que apuntaba era ya el primero de la lista, su enlace al anterior apuntar a NIL, y el recorrido de la lista habrá terminado.} end; writeln; writeln('Pulsa una tecla para terminar ...'); readkey end end; Procedure resetMem; {Libera la memoria din mica reservada para los nodos de la lista.} var aux: Pnodo; cont: integer; begin ClrScr; cont := 0; writeln('Liberando la memoria din mica:'); while cabeza <> nil do begin inc(cont);

100

writeln('Eliminando nodo n§ ',cont); aux := cabeza; cabeza := cabeza^.prox; dispose(aux) end end; Begin ClrScr; iniciar(cabeza,cola); {Inicializar los punteros de cabeza y cola de la lista.} crealista; {Leer los datos del archivo y crear la lista enlazada.} veralreves(cola); {Visualizar la lista en orden inverso, desde la cola hasta la cabeza.} resetMem; {Liberar la memoria reservada.} writeln; writeln('That`s All Folks ...'); readkey end. 5. Dada la misma lista de alumnos, crear una nueva lista en orden inverso, pero esta vez simplemente enlazada. Program t10e5(Input, Output); Uses Crt; Type alumno = record nombre: String[34]; parcial, final, trabajos: real; 101

apto: boolean end; Pnodo = ^nodo; nodo = record info: alumno; prox, ant: Pnodo end; Var cabeza, cola: Pnodo; Procedure iniciar(var lista, cola: Pnodo); begin lista := nil; cola := nil end; Procedure crealista; var ficha: alumno; nombrefic: String; fic: file of alumno; puntaux: Pnodo; terminar: boolean; Function creanodo(nuevaficha: alumno): Pnodo; var aux: Pnodo; begin new(aux); aux^.info := nuevaficha; aux^.prox := nil; aux^.ant := nil;

102

creanodo := aux end; Procedure inscola(var lista, coladelista: Pnodo; nuevo: Pnodo); var aux: Pnodo; begin if lista = nil then begin lista := nuevo; coladelista := nuevo end else begin aux := coladelista; nuevo^.ant := aux; coladelista := nuevo; aux^.prox := nuevo end end; begin terminar := false; nombrefic := 't10e2.dat'; assign(fic,nombrefic); reset(fic); while not(eof(fic)) do begin read(fic,ficha); writeln('Leyendo ... ',ficha.nombre);

103

puntaux := creanodo(ficha); inscola(cabeza,cola,puntaux) end; readkey; close(fic) end; PROCEDURE hazlistasimple(lis1: Pnodo); {Crea una lista simplemente enlazada a partir de la lista doblemente enlazada del ejercicio 4} Type Puntero = ^nodosimple; nodosimple = record info: alumno; enlace: Puntero {Lista simplemente enlazada.} end; var listasimple, colasimple, punteroaux: puntero; Procedure inisimple(var lista: Puntero); begin lista := nil end; Function haznodosimple(nuevaficha: alumno): Puntero; {Crea un nodo para lista simplemente enlazada.} var aux: Puntero; begin new(aux);

104

aux^.info := nuevaficha; aux^.enlace := nil; haznodosimple := aux end; Procedure insnodo(var lista, cola: Puntero; nuevo: Puntero); {Inserta un nodo en la cola de una lista simplemente enlazada.} var aux: Puntero; begin if lista = nil then begin lista := nuevo; cola := nuevo end else begin aux := cola; cola := nuevo; aux^.enlace := nuevo end end; Procedure SimpleResetMem; {Libera la memoria din mica reservada para los nodos de una lista simplemente enlazada.} var aux: Puntero; cont: integer; begin ClrScr;

105

cont := 0; writeln('Liberando la memoria din mica (lista simple):'); while listasimple <> nil do begin inc(cont); writeln('Eliminando nodo n§ ',cont); aux := listasimple; listasimple := listasimple^.enlace; dispose(aux) end end; begin ClrScr; inisimple(listasimple); {Inicializar el puntero de cabeza de la lista.} if lis1 = nil then writeln('No hay ningún alumno en la lista.') else begin {Si la lista doblemente enlazada, a partir de la cual se va a construir la lista simplemente enlazada, no est vacía:} writeln('Fabricando la nueva lista:'); writeln; while (lis1 <> nil) do {Mientras que no se alcance el final de la lista doble:} begin punteroaux := haznodosimple(lis1^.info); {Se crea el nodo de lista simple, y se apunta por el

106

puntero auxiliar "punteroaux".} insnodo(listasimple, colasimple, punteroaux); {Se inserta e nodo en la cola de la lista.} lis1 := lis1^.ant {La lista doblemente enlazada se recorre en orden inverso de manera que la lista simple que se va creando queda ya ordenada al revés que la doble.} end; punteroaux := listasimple; {Se asigna al puntero auxiliar, la cabeza de la lista simple, para que sirva de puntero de recorrido a través de la lista.} writeln('As¡ queda la lista simple:'); writeln; while punteroaux <> nil do {Mientras que no se llegue al final de la lista simple:} begin writeln(' ':6,punteroaux^.info.nombre); {Escribir el nombre del alumno.} punteroaux := punteroaux^.enlace {Recorrer la lista: "Punteroaux" va apuntando uno por uno a todos los nodos de la lista, hasta llegar al último, cuyo enlace apunta a NIL.} end; writeln; writeln('Pulsa una tecla para continuar ...'); readkey

107

end; SimpleResetMem; {Liberar la memoria reservada para los nodos de la lista simple.} writeln; end; Procedure resetMem; {Libera la memoria reservada para los nodos de la lista doble.} var aux: Pnodo; cont: integer; begin cont := 0; writeln('Liberando la memoria din mica:'); while cabeza <> nil do begin inc(cont); writeln('Eliminando nodo n§ ',cont); aux := cabeza; cabeza := cabeza^.prox; dispose(aux) end end; Begin ClrScr; iniciar(cabeza,cola); crealista; {Crear la misma lista que la del ejercicio 4 (es doblemente enlazada).}

108

hazlistasimple(cola); {Fabricar la lista simplemente enlazada a partir de la doble.} resetMem; {Liberar la memoria.} writeln; writeln('That`s All Folks ...'); readkey end. 6. Dada una lista de libros, que contiene titulo, editorial, año de publicación. Mostrar todas las películas anteriores a un año determinado. Program t10e6(Input, Output); Uses Crt; Type libro = record titulo: String[35]; editorial: String[25]; ano: integer end; Pnodo = ^nodo; nodo = record info: libro; enlace: Pnodo {Lista simplemente enlazada.} end; Var cabeza: Pnodo; Procedure iniciar(var lista: Pnodo); begin lista := nil 109

end; Procedure introdatos; var ficha: libro; nombrefic: String; fic: file of libro; puntaux: Pnodo; desdearchivo, terminar, correcto: boolean; entrada: Char; Function si_no(pregunta: String): Char; var oSioNo: Char; begin pregunta := pregunta + ' [S/N]: '; write(pregunta); repeat osiono := upcase(readkey) until osiono in ['S','N']; writeln(osiono); si_no := oSioNo end; Function creanodo(nuevaficha: libro): Pnodo; var aux: Pnodo; begin new(aux); aux^.info := nuevaficha; aux^.enlace := nil; creanodo := aux

110

end; Procedure inscabeza(var lista: Pnodo; nuevo: Pnodo); var aux: Pnodo; begin if lista = nil then lista := nuevo else begin aux := lista; lista := nuevo; nuevo^.enlace := aux end end; Procedure leerteclado; begin writeln; writeln(' ****** Nuevo libro ******'); writeln; repeat with ficha do begin write('Título: '); readln(titulo); write('editorial: '); readln(editorial); write('Año de publicación: '); readln(ano); end;

111

entrada := si_no('¨Los datos son correctos?'); correcto := (entrada = 'S'); writeln; until correcto; write(fic,ficha); writeln end; begin terminar := false; Entrada := si_no('¨Introducir datos desde archivo?'); desdearchivo := (entrada = 'S'); if desdearchivo then write('Nombre del archivo de datos:') else write('Escribir los datos en el archivo:'); readln(nombrefic); if nombrefic = '' then nombrefic := 't10e6.dat'; writeln('Introduciendo datos de publicaciones ...'); writeln; assign(fic,nombrefic); if desdearchivo then reset(fic) else rewrite(fic); repeat if not(desdearchivo) then Leerteclado else begin if not(eof(fic))

112

then read(fic,ficha) else terminar := TRUE end; if not(terminar) then begin puntaux := creanodo(ficha); inscabeza(cabeza,puntaux) end; if not(desdearchivo) then begin entrada := si_no('¨Introducir m s libros?'); writeln; terminar := (entrada = 'N') end until terminar; close(fic) end; Procedure buscaren(lis1: Pnodo); {Muestra por pantalla los libros de la lista cuya fecha de publicación sea anterior a una determinada fecha.} var cont, fecha: integer; begin ClrScr; if lis1 = nil then writeln('No hay ningún libro en la lista.') else begin {Si la lista no est vacía:} write('Mostrar todos los libros anteriores al año: ');

113

readln(fecha); writeln('T¡tulo','Editorial':41,'A¤o pub.':27); for cont := 1 to 75 do write('Í'); writeln; while (lis1 <> nil) do {Mientras que no se llegue al final de la lista:} begin if lis1^.info.ano <= fecha then {Si el año de publicación es inferior a la fecha introducida:} begin write(lis1^.info.titulo,' ':38−length(lis1^.info.titulo)); write(lis1^.info.editorial,' ':30−length(lis1^.info.editorial)); writeln(lis1^.info.ano:6) {Escribir todos los datos referentes al libro, que est n almacenados en el campo información del nodo.} end; lis1 := lis1^.enlace {Apuntar con el puntero de recorrido al siguiente nodo de la lista.} end; writeln; writeln('Pulsa una tecla para terminar ...'); readkey end end; Procedure resetMem; {Liberar la memoria reservada.}

114

var aux: Pnodo; cont: integer; begin ClrScr; cont := 0; writeln('Liberando la memoria din mica:'); while cabeza <> nil do begin inc(cont); writeln('Nodo n§ ',cont); aux := cabeza; cabeza := cabeza^.enlace; dispose(aux) end end; Begin ClrScr; iniciar(cabeza); introdatos; {Fabricar la lista} Buscaren(cabeza); {Mostrar los libros anteriores a la fecha que el usuario introduzca.} resetMem; {Liberar la memoria.} writeln; writeln('That`s All Folks ...');

115

readkey end. 8. Escribir un programa que cree una lista enlazada de número enteros ordenados de forma creciente. Los números los va introduciendo el usuario. Cuando introduzca el 0 significa que ha finalizado la introducción de datos. Visualizar el contenido de la lista. Program t10e8(Input, Output); Uses Crt; Type Pnodo = ^nodo; nodo = record info: integer; prox, ant: Pnodo {Lista doblemente enlazada.} end; Var cabeza, cola, encontrado, nuevo: Pnodo; numero: integer; terminar: boolean; Procedure iniciar(var lista, coladelista: Pnodo); begin lista := nil; coladelista := nil end; Function creanodo(nuevonumero: integer): Pnodo; var aux: Pnodo; begin new(aux); aux^.info := nuevonumero; aux^.prox := nil;

116

aux^.ant := nil; creanodo := aux end; Procedure insantes(insertpoint, nuevonodo: Pnodo); {Inserta un nodo en la posición anterior al nodo al que apunte el puntero "insertpoint".} var aux: Pnodo; begin aux := insertpoint^.ant; {Se guarda en el puntero auxiliar el enlace hacia el nodo anterior al que se va a insertar.} if aux <> nil then aux^.prox := nuevonodo; {Si la posición en la que se va a insertar no es la cabeza de la lista, se hace que el enlace hacia el siguiente del nodo anterior apunte hacia el nodo a insertar } if insertpoint^.ant = nil then cabeza := nuevonodo; {Si el enlace del nodo donde se va a insertar hacia el anterior, est apuntando a NIL, significa que se va a insertar en la cabeza de la lista, por lo que hay que modificar el puntero de cabeza de lista para que apunte al nodo que se va a insertar. "cabeza" es la variable global.} nuevonodo^.ant := insertpoint^.ant; {El enlace hacia el anterior del nodo a insertar debe apuntar a donde apuntaba el del nodo donde se inserta.} nuevonodo^.prox := insertpoint; {El enlace hacia el siguiente del nodo a insertar debe apuntar hacia

117

el nodo en donde se va a insertar.} insertpoint^.ant := nuevonodo {Por último el enlace del nodo donde se va a insertar hacia el anterior, debe apuntar hacia el nodo que se inserta.} end; Procedure insencola(nuevonodo: Pnodo); {Insertar en la cola de la lista.} var aux: Pnodo; begin aux := cola; {Se guarda el puntero hacia el nodo que actualmente el último de la lista.} cola := nuevonodo; {El puntero de cola de la lista debe apuntar al nodo que se inserta. "cola" es la variable global.} nuevonodo^.ant := aux; {El enlace hacia el anterior del nodo a insertar debe apuntar al que antes era el nodo de cola de la lista, y que est apuntado por el puntero auxiliar.} aux^.prox := nuevonodo {Por último el que antes era el nodo de cola, debe enlazar al nodo siguiente, que es el nodo que se inserta en la lista.} end; Function buscar(lis1: Pnodo; num: integer): Pnodo; {Devuelve un puntero apuntando al primer nodo de la lista que almacene un número mayor que el que se desee buscar.

118

Si no hay ningún número en la lista que sea mayor que el que se desea buscar, devuelve NIL.} var puntaux: Pnodo; begin puntaux := lis1; {El puntero auxiliar, hará de puntero de recorrido.} if lis1 <> nil then {Si la lista no est vacía:} while (puntaux^.info <= num) and (puntaux <> nil) {Mientras que el número almacenado en el nodo sea menor o igual que el que se busca, y no se acabe la lista:} do puntaux := puntaux^.prox; {Se salta al siguiente nodo de la lista.} buscar := puntaux; end; Procedure verlista(lista: Pnodo); {Visualiza la lista de números.} begin ClrScr; if lista = nil then writeln('No hay ningún número en la lista.') else while lista <> nil do {Si la lista no est vacía, mientras que no se llegue al final:} begin writeln('Elemento de lista: ',lista^.info); {Se escribe el número almacenado en el nodo.}

119

lista := lista^.prox {Se salta al próximo nodo.} end; writeln; writeln('Pulsa una tecla para continuar ...'); readkey end; Procedure resetMem(lista: Pnodo); {Liberar la memoria reservada para la lista.} var aux: Pnodo; cont: integer; begin ClrScr; cont := 0; writeln('Liberando la memoria din mica:'); while lista <> nil do begin inc(cont); writeln(' Nodo n§ ',cont); aux := lista; lista := lista^.prox; dispose(aux) end end; Begin ClrScr;

120

iniciar(cabeza,cola); repeat write('Introducir número: '); readln(numero); {Se introduce un número:} if numero <> 0 then {Si el número es distinto de cero:} begin encontrado := Buscar(cabeza, numero); {Se busca el número en la lista, y se guarda el resultado de la búsqueda en el puntero "encontrado".} nuevo := creanodo(numero); {Se crea el nuevo nodo con el número introducido.} if cabeza <> nil {Si la lista no est vacía:} then begin if encontrado = nil {Si la búsqueda fue fallida:} then insencola(nuevo) {Entonces no hay en la lista ningún número mayor que el que ha sido introducido, y habrá que insertar el nuevo nodo en la cola de la lista: El último.} else insantes(encontrado, nuevo) {Si la búsqueda no fue fallida, "encontrado" apuntar al nodo que almacena el primer número de la lista que es mayor que el número introducido, y entonces para que

121

la lista est ordenada habrá que insertar el nuevo nodo justo antes que el nodo apuntado por "encontrado". } end else begin {Si la lista estaba vacía, se inicializan cabeza y cola para que apunten al nuevo nodo, porque no hay nada que ordenar.} cabeza := nuevo; cola := nuevo end end else terminar := true {Si el número introducido es el cero, se finaliza la introducción de números.} until terminar; writeln; writeln('Finalizó la introducción de números.'); writeln; writeln('Pulsa una tecla para continuar ...'); readkey; ClrScr; verlista(cabeza); {Se visualiza la lista de números para comprobar que est ordenada.} resetMem(cabeza); {Se libera la memoria reservada para la lista.} writeln; writeln('That`s All Folks ...');

122

readkey end. 10. Una lista contiene la información de los alumnos de una clase. Hacer un programa que presente un menú: 1. Nuevo alumno 2. Borrar alumno 3. Modificar alumno Para cada alumno se mantiene la siguiente información: número, nombre y nota. Los alumnos en la lista están ordenados por número. Si se elige la opción 1 se piden los datos del alumno y se insertan en la posición adecuada. Si se borra un alumno se pide el número de alumno y se elimina de la lista. Modificar un alumno es cambiar el nombre de un número determinado. Program t10e10(Input, Output); Uses Crt; Type alumno = record numero: integer; nombre: String[35]; nota: real end; Pnodo = ^Nodo; Nodo = record info: alumno; prox, ant: Pnodo {Lista doblemente enlazada.} end; Var cabeza, cola: Pnodo; salir: boolean; Procedure iniciarlista; begin cabeza := nil; 123

cola := nil end; Function si_no(pregunta: String): Char; var oSioNo: Char; begin pregunta := pregunta + ' [S/N]: '; write(pregunta); repeat osiono := upcase(readkey) until osiono in ['S','N']; writeln(osiono); si_no := oSioNo end; Function menu: Char; {Presenta por pantalla el menú con las opciones disponibles y devuelve la opción seleccionada por el usuario.} var opcion: Char; begin ClrScr; writeln(' ***** M E N U *****'); writeln; writeln(' 1. Nuevo alumno'); writeln(' 2. Borrar alumno'); writeln(' 3. Modificar alumno'); writeln(' 4. Listado de alumnos'); writeln;

124

writeln(' T. Terminar'); writeln; write (' Selecciona opción: '); repeat opcion := upcase(readkey) until opcion in ['1','2','3','4','T']; writeln(opcion); menu := opcion end; Procedure nuevo; {Añade una ficha nueva a la lista de alumnos.} var ficha: alumno; puntaux, encontrado: Pnodo; numlibre, correcto: boolean; entrada: Char; codigo: integer; Function creanodo(nuevaficha: alumno): Pnodo; var aux: Pnodo; begin new(aux); aux^.info := nuevaficha; aux^.prox := nil; aux^.ant := nil; creanodo := aux end; Procedure insantes(insertpoint, nuevonodo: Pnodo);

125

var aux: Pnodo; begin aux := insertpoint^.ant; if aux <> nil then aux^.prox := nuevonodo; if insertpoint^.ant = nil then cabeza := nuevonodo; nuevonodo^.ant := insertpoint^.ant; nuevonodo^.prox := insertpoint; insertpoint^.ant := nuevonodo end; Procedure insencola(nuevonodo: Pnodo); var aux: Pnodo; begin aux := cola; cola := nuevonodo; nuevonodo^.ant := aux; aux^.prox := nuevonodo end; Function buscar (lis1:Pnodo; num:integer; var libre: boolean): Pnodo; {Devuelve un puntero apuntando al primer número mayor que el buscado en la lista, y de no haber ninguno mayor, apuntar a NIL. Ademá s devuelve en el par metro "libre" de tipo booleano TRUE: si el número de alumno no est siendo utilizado ya, y FALSE si el número ya est ocupado.} var puntaux, AUX: Pnodo;

126

begin puntaux := lis1; if lis1 <> nil then {Si la lista no est vacía:} begin while (puntaux^.info.numero < num) and (puntaux <> nil) do puntaux := puntaux^.prox {Va saltando de nodo en nodo mientras que el número buscado sea mayor que el almacenado en el nodo, o se llegue al final de la lista.} end; if puntaux <> nil {Si no se llegó al final de la lista:} then begin if puntaux^.ant <> nil {Si el primer número que ya no es menor que el buscado no es el primero de la lista:} then begin aux := puntaux^.ant; {Se guarda un puntero apuntando al nodo anterior.} if aux^.info.numero = num then libre := false else libre := true {Si este nodo (el anterior) contiene el número buscado, se asigna FALSE a "libre", y si no contiene al número (contendrá uno menor) entonces se asigna TRUE a "libre".}

127

end else begin {Si el primer número de la lista ya no es menor que el buscado:} if puntaux^.info.numero <> num then libre := true {Si no es el número buscado (ser mayor), entonces el número buscado est libre.} end end else libre := true; {Si la lista est vacía, el número est libre.} buscar := puntaux end; begin ClrScr; writeln('****** Nuevo alumno ******'); writeln; repeat with ficha do begin write('Número de ficha: '); readln(codigo); {Se lee el número de alumno que se desea añadir.} encontrado := buscar(cabeza, codigo, numlibre); {Se busca el número en la lista.} if numlibre then

128

{Si el número est libre:} begin numero := codigo; write('Nombre: '); readln(nombre); write('Nota: '); readln(nota); {Se leen los datos correspondientes al alumno.} entrada := si_no('¨Los datos son correctos?'); correcto := (entrada = 'S') end else begin {Si el número est ocupado:} writeln('- El número ',codigo,' ya est ocupado: !'); write('Utilice la OPCION 3 del MENU PRINCIPAL '); writeln('si quiere modificar la ficha número ',codigo); writeln; entrada := si_no('¨Probar con otro número?'); correcto := (entrada = 'N') end; writeln end until correcto; writeln; if numlibre then {Si el número estaba libre:}

129

begin puntaux := creanodo(ficha); {Se crea el nodo con los datos del alumno.} if cabeza <> nil {Si la lista no est vacía:} then begin if encontrado = nil {Si la función buscar devuelve NIL, significa que el número que se desea introducir es el mayor de los que hay ya en la lista:} then insencola(puntaux) {Entonces se inserta el nuevo nodo al final de la lista.} else insantes(encontrado, puntaux) {Si la función buscar no devuelve NIL, entonces se inserta el nodo en la posición anterior al nodo al que apunta el resultado de la búsqueda.} end else begin {Si la lista estaba vacía:} cabeza := puntaux; cola := puntaux {Se asignan los punteros de cabeza y cola de lista apuntando al nuevo nodo, ya que el primero no hace falta ordenarlo.} end end end;

130

Function buscar(lista: Pnodo; num: integer; var error: boolean): Pnodo; {Devuelve un puntero al primer nodo de la lista que contenga un número de alumno que no sea menor que el buscado. Si además este nodo almacena el número buscado, entonces se devuelve en el par metro por referencia el valor FALSE (no ha habido error), y si el nodo almacena un número mayor que el buscado, devuelve TRUE (si ha habido un error en la búsqueda). } var puntaux, AUX: Pnodo; begin error := true; puntaux := lista; if lista <> nil {Si la lista no est vacía:} then begin while (puntaux^.info.numero < num) and (puntaux <> nil) do puntaux := puntaux^.prox; {Mientras que el nodo almacene un número menor que el buscado, va saltando de nodo en nodo a través de la lista, hasta que se llegue al final.} if puntaux <> nil then {Si no se llegó al final de la lista:} if puntaux^.info.numero = num then error := false {Si el número almacenado en el nodo encontrado coincide con el número buscado entonces no habrá habido error.} else error := true;

131

{Si por el contrario el número no coincide (ser mayor que el número buscado), habrá habido un error en la búsqueda.} end else begin {Si la lista est vacía:} writeln('No hay ninguna ficha en la lista.'); error := true {Entonces est claro que el número no est en la lista y habrá ocurrido un error en la lista.} end; buscar := puntaux; end; Procedure borrar; {Elimina un alumno de la lista.} var codigo: integer; seekerror: boolean; encontrado: Pnodo; Entrada: Char; Procedure borrarnodo(punt: Pnodo); {Elimina de la lista el nodo al que apunte el puntero par metro.} var puntaux: Pnodo; begin write('Eliminando ... '); if punt <> cabeza then {Si el nodo a eliminar no es el de cabeza de la lista:} begin

132

puntaux := punt^.ant; puntaux^.prox := punt^.prox {Hay que enlazar el nodo anterior con el posterior al nodo a eliminar.} end else cabeza := punt^.prox; {Si el nodo a eliminar es el nodo cabeza, el puntero cabeza debe apuntar al siguiente nodo en la lista.} if punt <> cola then {Si el nodo a eliminar no es el último de la lista.} begin puntaux := punt^.prox; puntaux^.ant := punt^.ant {Hay que enlazar el nodo posterior con el anterior al nodo que se va a eliminar.} end else cola := punt^.ant; {Si el nodo a eliminar es el último de la lista, el puntero de cola de la lista ha de apuntar al nodo anterior.} dispose(punt); {La lista ya est de nuevo enlazada, y el nodo est fuera de ella, as¡ que se libera la memoria que tenía reservada.} writeln; writeln('Ficha eliminada!'); readkey end;

133

begin ClrScr; write('Introduce el número de la ficha a eliminar: '); readln(codigo); writeln; encontrado := buscar(cabeza, codigo, seekerror); {Buscar el nodo a eliminar.} if seekerror then {Si el número de ficha buscada no est en la lista:} begin writeln('No existe ninguna ficha con el número ',codigo); readkey end else begin {Si la ficha buscada ha sido encontrada:} writeln('Se ha encontrado la siguiente ficha:'); writeln; writeln('Número: ',encontrado^.info.numero); writeln('Nombre: ',encontrado^.info.nombre); writeln(' Nota: ',encontrado^.info.nota:5:2); writeln; entrada := si_no('¨Es esta la ficha buscada?'); if entrada = 'S' then borrarnodo(encontrado) {Si el usuario confirma la eliminación, entonces se elimina el nodo.} end

134

end; Procedure modificar; {Permite modificar los datos referentes a un alumno cuya ficha est en la lista.} var codigo: integer; ficha: alumno; seekerror, correcto: boolean; encontrado: Pnodo; Entrada: Char; begin ClrScr; write('Introduce el número de la ficha a modificar: '); readln(codigo); writeln; encontrado := buscar(cabeza, codigo, seekerror); {Se busca el número de la ficha que se desea modificar.} if seekerror then begin writeln('No existe ninguna ficha con el número ',codigo); readkey end else begin {Si se encontró el número buscado en la lista:} writeln('Se ha encontrado la siguiente ficha:'); writeln; writeln('Número: ',encontrado^.info.numero);

135

writeln('Nombre: ',encontrado^.info.nombre); writeln(' Nota: ',encontrado^.info.nota:5:2); writeln; entrada := si_no('¨Es esta la ficha buscada?'); writeln; if entrada = 'S' then {Si el usuario confirma que era la ficha buscada:} begin repeat with ficha do begin numero := encontrado^.info.numero; writeln('Sustituir por:'); writeln; write('Nuevo nombre: '); readln(nombre); write('Nota: '); readln(nota); {Se modifican los datos.} entrada := si_no('¨Confirma los cambios?'); correcto := (entrada = 'S') end until correcto; encontrado^.info := ficha; {Se sustituyen en la lista los datos modificados por los antiguos.}

136

writeln; writeln('Ficha modificada.'); readkey; end end end; Procedure listar(lista: Pnodo); {Visualiza por pantalla el contenido de la lista de alumnos.} var cont: integer; begin ClrScr; writeln('******* L I S T A D O D E A L U M N O S *******'); writeln; writeln('Número', 'N O M B R E':25,'Nota':22); for cont := 1 to 53 do write('Ä'); writeln; if lista = nil then writeln('No hay ningún alumno en la lista.') else while lista <> nil do {Si la lista no est vacía, mientras que no se llegue al final:} begin write(lista^.info.numero:6,' ',lista^.info.nombre); write(' ':38−length(lista^.info.nombre)); writeln(' ':2,lista^.info.nota:5:2); {Se muestran los datos del alumno.} lista := lista^.prox

137

{Se salta al próximo nodo.} end; writeln; write('Pulsa una tecla para regresar al MENU ...'); readkey; writeln end; Procedure resetMem(lista: Pnodo); {Liberar la memoria reservada para la lista.} var aux: Pnodo; cont: integer; begin ClrScr; cont := 0; if lista <> nil then writeln('Liberando la memoria din mica:'); while lista <> nil do begin inc(cont); writeln(' Nodo n§ ',cont); aux := lista; lista := lista^.prox; dispose(aux) end end; Begin ClrScr;

138

iniciarlista; repeat case menu of {Llamada a la función menú, y selección en función del valor que devuelva.} '1': nuevo; '2': borrar; '3': modificar; '4': listar(cabeza); 'T': salir := true end until salir; writeln; resetmem(cabeza); {Liberar la memoria reservada para la lista.} writeln('That`s All Folks ...'); readkey end. 12. Generar una lista encadenada con todas las palabras de tres caracteres que aparecen en un fichero de tipo texto. Imprimir dicha lista. Program t10e12(Input, Output); Uses Crt; Const letpal = 3; separadores: Set of Char =([' ', ',', '.', ';','(',')', ':', '''','?','¨','-','!','[',']','{','}',#13, #10]); Type Puntero = ^nodo; 139

nodo = record info: String[letpal]; enlace: Puntero {Lista simplemente enlazada.} end; Var fichero: Text; letra: Char; contletras, contpal: integer; nombrefic, palabra: String; control: boolean; cabeza, cola, puntaux: Puntero; Procedure iniciar(var lista, cola: Puntero); begin lista := nil; cola := nil end; Function haznodo(nuevapal: String): Puntero; var aux: Puntero; begin new(aux); aux^.info := nuevapal; aux^.enlace := nil; haznodo := aux end; Procedure insertar(var lista, cola: Puntero; nuevo: Puntero); var aux: Puntero;

140

begin if lista = nil then begin lista := nuevo; cola := nuevo end else begin aux := cola; cola := nuevo; aux^.enlace := nuevo end end; Procedure verlista(lista: Puntero); {Visualiza la lista de palabras con 3 letras por pantalla.} var cont: integer; begin writeln('As¡ queda la lista:'); cont := 0; while lista <> nil do begin inc(cont); writeln(cont:6,' ',lista^.info); if (cont mod 24) = 0 then readkey; lista := lista^.enlace end; writeln;

141

readkey end; Procedure ResetMem(lista: puntero); var aux: Puntero; cont: integer; begin ClrScr; cont := 0; writeln('Liberando la memoria din mica:'); while lista <> nil do begin inc(cont); writeln('Eliminando nodo n§ ',cont); aux := lista; lista := lista^.enlace; dispose(aux) end end; Begin ClrScr; contpal := 0; contletras := 0; write('Nombre del fichero de entrada: '); readln(nombrefic); if nombrefic = '' then nombrefic := 'c:\tp\bin\temas\tema10\t10dat.txt'; assign(fichero,nombrefic);

142

{$I−} reset(fichero); {$I+} if ioresult <> 0 then begin writeln('Error en apertura de fichero.!!'); halt(1) end; iniciar(cabeza, cola); palabra := ''; control := false; while not eof(fichero) do begin while not eoln(fichero) do begin read(fichero,letra); if not(letra in separadores) then begin if not control then inc(contpal); control := true; inc(contletras); palabra := palabra + letra end else begin control := false; if contletras = letpal then

143

{Si la palabra tiene 3 letras: } begin puntaux := haznodo(palabra); {Se crea un nodo que contiene la palabra.} insertar(cabeza, cola, puntaux) {Se inserta el nodo en la lista.} end; palabra := ''; contletras := 0; while ((letra in separadores) or eoln(fichero)) and not(eof(fichero)) do begin read(fichero,letra); if not(letra in separadores) then begin inc(contpal); inc(contletras); palabra := palabra+letra; control := true end end end end; if not eof(fichero) then begin read(fichero,letra)

144

end end; close(fichero); writeln; writeln('Total: ',contpal,' palabras.'); writeln; verlista(cabeza); resetmem(cabeza); writeln; writeln('That`s All Folks ...'); readkey end. 14. Escribir un programa que lea un texto de longitud indeterminada y que produzca como resultado la lista de todas las palabras diferentes contenida en el texto, así como su frecuencia de aparición. Program t10e12(Input, Output); Uses Crt; Const lenpal = 25; separadores: Set of Char =([' ', ',', '.', ';','(',')', ':' ,'"','&','=','?','¨','-','!','{','}','[',']','''','+','−', #13, #10]); Type histograma = record pal: String[lenpal]; frec: integer end; Puntero = ^nodo; nodo = record info: histograma; 145

enlace: Puntero {Lista simplemente enlazada.} end; Var fichero: Text; letra: Char; contletras, contpal: integer; nombrefic, palabra: String; control, errorcode: boolean; cabeza, cola, puntaux: Puntero; Procedure iniciar(var lista, cola: Puntero); begin lista := nil; cola := nil end; Function haznodo(nuevapal: String): Puntero; {Crea un nuevo nodo para almacenar otra palabra y su frecuencia} var aux: Puntero; begin new(aux); aux^.info.pal := nuevapal; {Guarda la palabra.} aux^.info.frec := 1; {Como la palabra es nueva, solo ha aparecido una vez.} aux^.enlace := nil; haznodo := aux end;

146

Procedure insertar(var lista, cola: Puntero; nuevo: Puntero); var aux: Puntero; begin if lista = nil then begin lista := nuevo; cola := nuevo end else begin aux := cola; cola := nuevo; aux^.enlace := nuevo end end; Function buscar(lista: Puntero; palabra: String; var error: boolean): Puntero; {Busca una palabra en la lista, y devuelve un puntero apuntando al nodo que contiene la palabra. Si la palabra buscada no se encuentra en la lista, devuelve el puntero apuntando a NIL, y un valor TRUE en el par metro de control de error.} var puntaux: Puntero; begin error := true; {Si la lista est vacía, siempre ocurrir un error de búsqueda.} puntaux := lista; if lista <> nil

147

{Si la lista no est vacía:} then begin while (puntaux^.info.pal <> palabra) and (puntaux <> nil) do puntaux := puntaux^.enlace; {Mientras que el nodo no contenga la palabra buscada, y no se llegue al final de la lista, se va saltando de nodo en nodo.} if puntaux <> nil then if puntaux^.info.pal = palabra {Si no se llegó al final de la lista, y la palabra almacenada en el nodo encontrado coincide con la palabra buscada:} then error := false {Entonces no ha ocurrido un error de búsqueda.} else error := true; {Si las palabras no coinciden, entonces ha ocurrido un error en la búsqueda.} end; buscar := puntaux; end; Procedure verlista(lista: Puntero); {Visualiza el histograma con las palabras de la lista y la frecuencia de aparición de cada una de ellas.} var cont, aux: integer; begin cont := 0; {Cuenta el n§ de nodos.}

148

ClrScr; while lista <> nil do {Mientras que no se llegue al final de la lista:} begin inc(cont); {Se incrementa el contador de nodos.} write(' ',cont:4,' ',lista^.info.pal,' '); {Se escribe la palabra.} for aux := 1 to 26−length(lista^.info.pal) do write('.'); case lista^.info.frec of {Dependiendo de la frecuencia de aparición de la palabra se selecciona un color distinto.} 1..4: textcolor(9); 5..9: textcolor(10); 10..14: textcolor(11); 14..19: textcolor(12) else textcolor(14) end; write(lista^.info.frec:3); {Se escribe el n§ de veces que aparece la palabra.} textcolor(7); writeln(' veces.'); if (cont mod 24) = 0 then readkey; {pausa } lista := lista^.enlace {Se salta al siguiente nodo.} end;

149

writeln; write('Pulsa una tecla para terminar ...'); readkey end; Procedure ResetMem(lista: puntero); {Libera la memoria din mica reservada para la lista.} var aux: Puntero; cont: integer; begin ClrScr; cont := 0; writeln('Liberando la memoria din mica:'); writeln; write('Eliminando nodos: ('); textcolor(9); write('#'); textcolor(7); writeln(' = 1 Nodo)'); writeln; textcolor(9); while lista <> nil do begin inc(cont); delay(50); {aunque tarde un poco más, queda más vistoso} write('#');

150

if (cont mod 10) = 0 then {Los símbolos que representan un nodo, se mostrar n en grupos de 10.} if (cont mod 50) = 0 {Cada cinco grupos de 10 nodos, se salta de línea.} then writeln else begin {Los grupos se separan con un guión de color rojo.} textcolor(12); write('−'); textcolor(9) end; aux := lista; {Se apunta el nodo con un puntero auxiliar para que no quede perdido, sin enlace.} lista := lista^.enlace; {Se salta al siguiente nodo.} dispose(aux) {Se libera la memoria reservada para el nodo que ha quedado atrás.} end; textcolor(7); writeln; writeln(cont,' nodos eliminados.'); writeln; writeln('Memoria liberada.')

151

end; Begin ClrScr; contpal := 0; contletras := 0; writeln('Listar todas las palabras de un archivo de texto'); writeln('y contar el número de veces que aparece cada una.'); writeln; write('Nombre del fichero de entrada: '); readln(nombrefic); if nombrefic = '' then nombrefic := 'c:\tp\bin\temas\tema10\t10dat.txt'; assign(fichero,nombrefic); {$I−} reset(fichero); {$I+} if ioresult <> 0 then begin writeln('Error en apertura de fichero.!!'); readkey; halt(1) end; iniciar(cabeza, cola); palabra := ''; control := false; while not eof(fichero) do begin

152

while not eoln(fichero) do begin read(fichero,letra); if not(letra in separadores) then begin if not control then inc(contpal); control := true; inc(contletras); palabra := palabra + letra end else begin {La palabra ha finalizado porque se encontró un separador.} control := false; puntaux := buscar(cabeza, palabra, errorcode); {Se busca la palabra en la lista.} if not(errorcode) then {Si no ocurrió un error en la búsqueda, quiere decir que que la palabra ya est en la lista:} begin inc(puntaux^.info.frec) {Entonces sólo hay que incrementar el número de veces que ha aparecido la palabra.} end else begin {Si ocurre un error en la búsqueda, quiere decir que la palabra no estaba en la lista, y habrá que meterla.}

153

puntaux := haznodo(palabra); {Se crea el nodo con la palabra.} insertar(cabeza, cola, puntaux) {Y se inserta en la lista.} end; palabra := ''; contletras := 0; while ((letra in separadores) or eoln(fichero)) and not(eof(fichero)) do begin read(fichero,letra); if not(letra in separadores) then begin inc(contpal); inc(contletras); palabra := palabra+letra; control := true end end end end; if not eof(fichero) then begin read(fichero,letra) end end;

154

close(fichero); writeln; writeln('Fichero procesado.'); writeln; writeln('Total: ',contpal,' palabras.'); writeln; write('Pulsa una tecla para ver el histograma ...'); readkey; verlista(cabeza); {Visualiza el histograma.} resetmem(cabeza); {Libera la memoria din mica.} writeln; writeln('That`s All Folks ...'); readkey end.

Ejercicios tema 11 2. Hacer un programa con un procedimiento recursivo que tome un string como entrada y lo visualice en orden inverso. Program t11e2(Input, Output); Uses Crt; Var frase: String; Procedure verinver(pal: String); begin if length(pal) >= 1 then {Si la longitud de la frase no es cero } 155

begin write(pal[length(pal)]); {Se escribe el último carácter de la frase.} delete(pal, length(pal),1); {Se elimina de la frase el último carácter. El procedimiento delete es propio de Turbo−Pascal.} verinver(pal) {Se hace la llamada recursiva con la nueva frase que ahora tiene un carácter menos de longitud.} end end; Begin ClrScr; write('Introduce una frase: '); readln(frase); {Se lee la frase.} verinver(frase); {Se llama a la función que visualiza la frase en orden inverso.} writeln; writeln; write('Pulsa una tecla para terminar ...'); readkey end. 4. Comprobar si un String introducido por teclado es un palíndromo (capicúa). Program t11e4(Input, Output); Uses Crt;

156

Var frase: String; i: integer; Function capicua(pal: String): boolean; {Devuelve TRUE si la frase es capicúa y false si no lo es. Hay que tener en cuenta que la función distingue entre mayúsculas y minúsculas, y no elimina los espacios en blanco ni los signos de puntuación, etc. ..., por lo que habrá que controlarlo todo antes de llamar a la función.} var aux: boolean; begin aux := true; if length(pal) >= 1 then {Si la frase no tiene longitud cero:} begin if pal[1] = pal[length(pal)] {Si la primera letra es igual a la última de la frase:} then begin delete(pal,1,1); delete(pal, length(pal),1); {Se eliminan de la frase la primera y la última letra.} aux := aux and capicua(pal) {Se hace la llamada recursiva con la nueva frase.} end else aux := false {Si la primera y última letra no son iguales, la función devuelve FALSE.}

157

end; capicua := aux end; Begin ClrScr; writeln('Introduce una palabra (sin acentos): '); write('Por ejemplo: 1331, o 1k11k1, o 0−1−2−1−0 ...:'); readln(frase); for i := 1 to length(frase) do frase[i] := upcase(frase[i]); {Pasa todo a mayúsculas.} writeln; if capicua(frase) then writeln('Resultado: CAPICUA.') else writeln('Resultado: NO es capicúa.'); readkey end. 6. Escribir dos funciones, una recursiva y otra no, que dado un valor x entero positivo, retorne true si x es una potencia de 2. Program t11e4(Input, Output); Uses Crt; Var numero, maxiter: integer; Function DosalaN(num: integer; var iter: integer): boolean; {Función iterativa que devuelve true si el número el potencia de 2, y además cuenta el número de iteraciones hasta llegar al resultado.} var control: boolean; begin 158

control := true; iter := 0; while (num > 2) and control do {Mientras que el número sea mayor que 2 y divisible por 2: } begin inc(iter); {Se incrementa el número de iteraciones (n§ de veces que se ejecuta el bucle).} control := control and ((num mod 2) = 0); {Ser true si el número es divisible por 2.} num := num div 2 {Se divide el número por 2.} end; DosalaN := control end; Function RecDosalaN(num: integer; var iter: integer): boolean; {Función recursiva que devuelve true si el número es potencia de 2.} var aux: boolean; begin aux := true; inc(iter); {El número de iteraciones en la función recursiva, se cuenta por el n§ de veces que es llamada la función, por lo que se incrementa cada vez que se ejecute la función.} if (num > 2) and (num mod 2 = 0) {Si el número es mayor que 2, y divisible por 2:}

159

then begin num := num div 2; {se divide el número por 2.} aux := aux and RecDosalaN(num, iter) {Se hace la llamada recursiva con el nuevo número.} end else if num > 2 then aux := false; {Si el número no es divisible por dos, la función devuelve FALSE} RecDosalaN := aux end; Begin ClrScr; write('Introduce un número entero: '); readln(numero); writeln; writeln('−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−'); writeln; writeln('Cálculo mediante la función recursiva:'); maxiter := 0; if RecDosalaN(numero, maxiter) then write('Resultado: SI') else write('Resultado: NO'); writeln(' es potencia de 2'); writeln; writeln(numero,' = 2 elevado a ',maxiter); writeln;

160

writeln('Calculado en ',maxiter,' iteraciones.'); writeln; writeln('−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−'); writeln; writeln('Cálculo mediante la función NO recursiva:'); if DosalaN(numero, maxiter) then write('Resultado: SI') else write('Resultado: NO'); writeln(' es potencia de 2'); writeln; writeln(numero,' = 2 elevado a ',maxiter + 1); writeln; writeln('Calculado en ',maxiter,' iteraciones.'); readkey end. 8. Hacer un programa que calcule la suma de los n primeros números pares y la suma de los n primeros números impares. El número n lo introduce el usuario. Crear dos subprogramas que calculen recursivamente los números pares e impares. Program t11e4(Input, Output); Uses Crt; Var numero: integer; Function sumaP(num: integer): longint; {Calcula la suma de los n primeros números pares.} var sumaparcial: longint; begin if num > 0 {Si el número es mayor que cero:}

161

then sumaparcial := 2*num + sumaP(num − 1) {La suma de los primeros n números pares, ser : El número (2*n), que es el n−simo número par, m s la suma de los primeros (n−1) números pares.} else sumaparcial := 0; {La suma de los primeros "cero" números pares, es cero.} sumaP := sumaparcial end; Function sumaI(num: integer): longint; {Calcula la suma de los n primeros números impares.} var sumaparcial: longint; begin if num > 0 {Si el número es mayor que cero:} then sumaparcial := (2*num−1) + sumaI(num − 1) {La suma de los primeros n números impares, ser : El número (2*n−1), que es el n−simo número impar, m s la suma de los primeros (n−1) números impares.} else sumaparcial := 0; {La suma de los primeros "cero" números impares, es cero.} sumaI := sumaparcial end; Begin ClrScr; write('Introduce un número entero: '); readln(numero);

162

writeln; write('Suma de los primeros ',numero,' números impares: '); writeln(sumaI(numero)); writeln; write('Suma de los primeros ',numero,' números pares .: '); writeln(sumaP(numero)); readkey end.

CONCLUSIONES Con el presente trabajo se han conseguido los objetivos propuestos, en cuanto que se ha obtenido un nivel de conocimientos sobre técnicas y metodología de programación, superior al exigido por la asignatura, se han desarrollado aspectos de la programación que quedan fuera del alcance específico de ésta, y se han adquirido conocimientos valiosos sobre la herramienta de programación en Pascal de Borland ®, sobre funciones, procedimientos, constantes y variables implementadas en sus unidades, sobre el uso e unidades, sobre el uso del debugger etc...

BIBLIOGRAFÍA • Luis Joyanes Aguilar, Programación en TURBO PASCAL 5.5, 6.0 y 7.0 Madrid, McGraw Hill, 1993. • Arthur M. Keller, Programación en Pascal. Madrid, McGraw Hill, 1983. • Byron S. Gottfried, Programación en Pascal. Madrid, McGraw Hill, 1986. • M. Alpuente [ y otros ], Fundamentos de programación. Valencia, Universidad Politécnica de Valencia, 1986. • Stephen K. O'Brien, Steve Nameroff, Turbo Pascal 7, Manual de referencia. Madrid, McGraw Hill, 1993. Programación en Turbo Pascal Metodología y técnicas de programación Página 82 163