Pascal

Estructura de control. Lenguage de programación. Programación estructurada. Entrada-Salida de datos. Arrays. Ficheros. Punteros. Recursividad

  • Enviado por: Karlitox
  • Idioma: castellano
  • País: España España
  • 272 páginas
publicidad

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 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);

{ 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

{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.}

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;

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);

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 = ');

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;

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

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

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;

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.

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

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.

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]] := '';

    {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.}

    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

    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.}

    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

    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',

    ' ','.',',',':',';','(',')','-','¨',' ',' ','¡','¢','£',

    '£','?','­','!','"','%','/','<','>']);

    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;

    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

    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;

    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;

    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}

    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;

    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);

    {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;

    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);

    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

    pulsado := true;

    write('<enter>');

    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

    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('<enter>');

    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;

    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;

    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);

    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

    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

    -6.3

    14.7

    4.0

    10.8

    12.4

    -8.2

    5.5

    -7.2

    3.1

    17.7

    -9.1

    Los datos de salida son:

    2.5

    -6.3

    14.7

    4.0

    14.9

    10.8

    12.4

    -8.2

    5.5

    20.5

    -7.2

    3.1

    17.7

    -9.1

    4.5

    6.1

    9.2

    24.2

    0.4

    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): ');

    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];

    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

    2

    3

    4

    13

    9

    5

    1

    5

    6

    7

    8

    14

    10

    6

    2

    9

    10

    11

    12

    15

    11

    7

    3

    13

    14

    15

    16

    16

    12

    8

    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),

    ( 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)

    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}

    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;

    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 <esc>, <ctrl+> ...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);

    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

    {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;

    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);

    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;

    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

    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];

    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]: ');

    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('Í');

    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;

    {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

    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

    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);

    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 ...');

    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]: ');

    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

    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.}

    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;

    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);

    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

    {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.

    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);

    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

    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

    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);

    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.!!');

    {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;

    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.}

    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

    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;

    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

    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;

    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;

    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;

    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);

    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);

    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];

    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: ');

    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.}

    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)

    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

    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;

    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.}

    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

    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

    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.}

    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')

    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-}

    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

    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.')

    {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

    {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;

    {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;

    {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

    {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);

    {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

    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);

    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:}

    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);

    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;

    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;

    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);

    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);

    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;

    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

    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

    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).}

    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

    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

    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;

    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))

    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: ');

    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.}

    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 ...');

    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;

    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

    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.

    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.}

    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;

    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

    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 ...');

    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;

    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;

    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);

    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;

    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".}

    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

    {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:}

    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;

    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;

    {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

    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;

    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

    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);

    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.}

    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

    {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;

    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;

    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;

    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;

    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);

    {$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

    {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)

    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;

    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;

    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

    {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.}

    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;

    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('#');

    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.')

    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

    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.}

    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;

    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 }

    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;

    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.}

    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

    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:}

    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;

    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:}

    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);

    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