ejercicios-resueltos-en-pascal

Una introducción a la programación.

Un enfoque algorítmico

Anexo I. Programas en Pascal

Jesús J. García Molina

Francisco J. Montoya Dato

José L. Fernández Alemán

María J. Majado Rosales

21 de octubre de 2005

Programas en Pascal. Una introducción a la Programación.

Índice

1. Introducción 3
1.1. Guía de usuario para Turbo Pascal 5.5 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 4

1.2. Guía de usuario para Dev-Pascal . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 4

2. Fe de erratas 6

3. Listados 8
3.1. Capítulo 2 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 8

3.2. Capítulo 3 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27

3.3. Capítulo 4 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 43

3.4. Capítulo 5 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 63

3.5. Capítulo 6 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 85

3.6. Capítulo 7 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 126

3.7. Capítulo 8 . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 147

ITES PARANINFO c 2


1. Introducción

Este documento incluye los programas Pascal que se han obtenido al codicar en este lenguaje de
programación todos los algoritmos que aparecen en el libro Una Introducción a la Programación. Un
enfoque algorítmico, según la conversión descrita en el Capítulo 9 del libro. Por tanto, el lector del
libro dispone de los programas que le permiten analizar el comportamiento de los algoritmos durante la
ejecución.

Los programas han sido creados y probados con las versiones 5.5 y 7.0 de Turbo Pascal de Borland
y con la versión 1.9.2 del entorno Dev-Pascal (compilador Free Pascal) de Bloodshed, sobre los sistemas
operativos Windows 98, 2000 y XP. Si el lector está más habituado a entornos Linux, puede optar por
emplear Free Pascal (fpc) o GNU Pascal (gpc) para Linux.

Las versiones de Turbo Pascal se ejecutan sobre DOS y ya no son soportadas por Borland; la versión
5.5 se puede descargar de forma gratuita del sitio web de Borland
httpXGG™ommunityF˜orl—ndF™omG—rti™leGHDIRIHDPHVHQDHHFhtml pero no la versión 7.0 que es más
cómoda de usar (entorno multiventana, manejo del ratón, etc.). Dev-Pascal es un entorno de pro-
gramación moderno, más potente y amigable, y se puede descargar desde el sitio web de Bloodshed
httpXGGwwwF˜loodshedFnetGdevp—s™—lFhtml.
El lector puede ejecutar los programas a partir del chero p—s™—lFzip que se encuentra en el sitio web
junto a este documento. Los programas están distribuidos en carpetas, una por cada capítulo. El nombre
de los archivos de cada capítulo hace referencia al identicador en el libro del algoritmo que implementa,
por ejemplo, evqT•RFp—s, es el programa para el Algoritmo 6.4 del Capítulo 6.
Puesto que Pascal no dispone del tipo secuencia propiamente dicho, se han implementado unas unida-
des que permiten el manejo de secuencias de caracteres, enteros y reales para el primer y segundo modelos
de acceso secuencial descritos en el Capítulo 5. Los dos últimos modelos se han construido apoyándonos
en el concepto de secuencia intermedia. En la carpeta unit están los archivos fuentes y los archivos objeto
de seis unidades, que corresponden con los dos primeros modelos de cada uno de los tres tipos de datos:
caracteres, enteros y reales.

Cada archivo que contiene una unidad se ha nombrado con el prejo unitms seguido de una letra que
indica el tipo de elemento (c, e o r) y un 1 o 2 para indicar el modelo. Por ejemplo, Unitmse2.pas
es la unidad para secuencias de enteros del segundo modelo y Unitmsc1.pas es la unidad para secuencias
de caracteres del primer modelo.

Las primitivas para el manejo de secuencias se nombran igual que en el libro (EA, Comenzar,
Avanzar, etc.) pero con un sujo que indica el tipo de elemento y el modelo secuencial (ie•wƒgI, ie•wƒiP,
ev—nz—r•wƒ‚P, ev—nz—r•wƒgP, etc.). Para conocer el léxico que puede utilizar se puede consultar la parte
interface del código fuente de cada unidad. El lector interesado también puede escudriñar el código de las
unidades con el objetivo de aprender sobre estructuras de datos dinámicas (se han implementado como
listas).

Se han creado archivos que almacenan secuencias que se utilizan como ejemplo de entrada en la
ejecución de los programas, y que están preparados para que el lector pueda modicarlos. Estos archi-
vos de datos se identican con el prejo datos seguido del identicador del algoritmo. Por ejemplo,
d—tosRFQFtxt corresponde con la entrada de datos del programa evqR•QFp—s. Las secuencias de datos se
almacenan como líneas de caracteres y las secuencias de números con un número por línea de entrada. En
la carpeta con los programas del Capítulo 6 se incluyen dos programas (qixpT•IFp—s y qixpT•RFp—s) que
crean los archivos de datos Pascal para el Algoritmo 6.1 y el Algoritmo 6.4 (también se proporcionan
los programas que permiten la visualización de los dos archivos creados, †i‚pT•IFp—s y †i‚pT•RFp—s).
En los programas no se ha realizado la comprobación de que los datos de entrada son válidos, por lo

3 c ITES PARANINFO


que en el caso de una entrada incorrecta, el resultado es impredecible.

En una próxima versión de este documento se incluirá el código de todas las acciones y funciones
del Capítulo 8, así como de la aplicación gestor de archivos indexados que se discute en dicho capítulo.
También estarán disponibles en el sitio web del libro, algoritmos y programas que son soluciones a los
ejercicios del libro, así como la implementación de las unidades del tercer y cuarto modelo de acceso
secuencial.

1.1. Guía de usuario para Turbo Pascal 5.5

Existen numerosos libros que ofrecen información sobre el uso de los entornos de Borland, por ejemplo:
Programación en Turbo Pascal. Versiones 5.5, 6.0, 7.0 de L. Joyanes, McGraw-Hill, 1993, y Programa-
ción en Turbo/Borland Pascal 7 de L. Joyanes, Mc Graw Hill, 1998. Aquí ofrecemos una breve guía para
ejecutar los programas, pero el lector puede consultar esos libros para obtener más detalles. Los pasos
para ejecutar un programa serían:

1. Abrir el entorno desde la ventana del sistema operativo (™Xtpbtur˜o).

2. Establecer el directorio en el que se encuentran los programas (opción Change dir del menú File).

3. Indicar el directorio en el que se encuentran las unidades (añadir directorio en el cuadro de texto
Unit Directories de la opción Directories del menú Options). Este paso sólo sería necesario
realizarlo una vez.

4. Cargar el programa (opción Load del menú File).

5. Ejecutar el programa (opción Run menú Run).

La carpeta unit incluye tanto los archivos fuente de las unidades como los archivos compilados, pero
si fuese necesario compilar una unidad se debe proceder del siguiente modo:

1. Introducir el directorio en el que se almacenan las unidades (añadir directorio en el cuadro de texto
EXE TPU Directory de la opción Directories del menú Options).

2. Cargar el archivo con el código fuente de la unidad, opción Load del menú File.

3. Indicar que la compilación se almacenará en disco con la opción Destination del menú Compile.

4. Compilar con la opción Compile del menú Compile. Si no se indica el directorio en el paso 1, el
archivo objeto (extensión TPU) se almacenará en el mismo directorio que el archivo fuente.

1.2. Guía de usuario para Dev-Pascal

El entorno dispone de una ayuda y un tutorial. Los pasos para ejecutar un programa, una vez abierto
el entorno, serían (existen botones para ejecutar las órdenes, además de teclas rápidas):

1. Establecer el directorio en el que se encuentran las unidades en el cuadro de texto Add the
directory below ... de la opción Compiler options del menú Options. Este paso sólo sería
necesario realizarlo una vez.

2. Cargar el programa (opción Open le del menú File).

ITES PARANINFO c 4


3. Compilar el programa (opción Compile del menú Execute).

4. Ejecutar el programa (opción Run del menú Execute).

Para ejecutar los programas que utilizan las máquinas secuenciales bastarían los pasos anteriores si en
el directorio de las unidades se encuentran el archivo fuente de la unidad empleada, ya que se generaría
automáticamente el archivo objeto de la unidad. Si por alguna razón se necesitase compilar las unidades
de forma independiente, los pasos para crear el archivo objeto de una unidad son los siguientes:

1. Crear un proyecto con el nombre de la unidad. Seleccionar Empty project de la opción New
project del menú File. Eliminar el archivo incluido por defecto en el proyecto y cargar el archivo
que contiene el código fuente de la unidad, opción Add to project del menú Project.

2. Habilitar la creación de una DLL en la opción Project options del menú Project.

3. Compilar la unidad mediante la opción Compile del menú Execute.

Sobre los sistemas operativos Windows 2000 y XP, durante la ejecución del programa con la última
versión de Dev-Pascal, el directorio actual es el directorio en que se instala DevPascal (por defecto
™XhevE€—sA y no funciona la opción de establecer como directorio actual aquel en el que se encuentra el
ejecutable. Por tanto, cuando en un programa hay referencias a cheros, o bien se indica la ruta completa,
o bien se ejecuta el programa desde fuera del entorno, por ejemplo, desde el explorador de Windows. Este
problema no se tiene con el sistema operativo Windows 98.

5 c ITES PARANINFO


2. Fe de erratas

Hemos encontrado en el libro las erratas que indicamos abajo organizadas por capítulos. En el sitio
web del libro iremos actualizando esta fe de erratas en un chero aparte.

Capítulo 4

Algoritmo 4.4

El segundo argumento de la llamada a la acción is™ri˜ir que escribe el resultado debe ser sum—Gnumilem
en vez de sum—Gnum.

Capítulo 6

Algoritmo 6.17

La función €osin„—˜l— no coincide en el texto y en el algoritmo. El algoritmo válido es el que aparece
en el texto.

En la función godifi™—™ion hay que cambiar nuevo€—rF™ por nuevo€—rFs en la segunda asignación
de la cláusula ix•y„‚y•geƒy de la instrucción ƒiqÚx.

Capítulo 7

Algoritmo 7.13

ist—™— debe denirse
El tipo fuera de la acción r—noi, ya que se utiliza como tipo de los parámetros
origen, intermedio y destino.
r—noi debería ser r—noi@nEID intermedioD origenD destinoA
La segunda llamada a la acción en
vez de r—noi@nEID intermedioD destinoD origenA.

Sección 7.5.4 (Página 377)

En la postcondición de la acción yrden—rs debería decir tk a „viej—k en vez de tk a „viej—k.

Capítulo 8

Sección 8.3 (Página 395)

En la tercera línea debería decir una secuencia de cuatro nodos: en vez de una secuencia de tres
nodos:.


En la acción snsert—rer™hivosndex—do hay que cambiar:
ƒs @fus™—r€osi™ionsndi™e@—r™h↑Findi™eD pF™l—veA X €yƒ•x…veA
por:

ƒs @fus™—r€osi™ionsndi™e@—r™h↑Findi™eD pF™l—veA = €yƒ•x…veA

ITES PARANINFO c 6


Capítulo 9


En la Figura 9.4 el elemento ‘H“‘PW“ debería ser t‘H“‘PW“

7 c ITES PARANINFO


3. Listados

3.1. Capítulo 2
§ ¤
program elgoritmoP•IY
(*
* Algoritmo 2.1. Calculo de la nota final de una asignatura
* Titulo del libro: Una introduccion a la programacion.
* Un enfoque algoritmico
* Autores del libro: Jesus J. Garcia Molina
* Francisco J. Montoya Dato
* Jose L. Fernandez Aleman
* Maria J. Majado Rosales
* Fecha: 1/9/2005
* Capitulo 2. Secuenciacion y analisis de casos
*)

uses ™rtY

var
not—„eori— X realY
not—€r—™ti™— X realY
not—pin—l X realY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.1. Calculo de la nota final de una asignatura *****'AY
writeln@'*****'AY
writelnY
write@'Nota de teoria: 'AY
readln@not—„eori—AY
writelnY
write@'Nota de practicas: 'AY
readln@not—€r—™ti™—AY
not—pin—l Xa not—„eori— B HFU C not—€r—™ti™— B HFQY
writelnY
write@'La nota final es: 'AY
writeln@not—pin—lXIXPAY
writelnY
write@'Pulse enter para continuar'AY
readln
endF
¦
¥
§ ¤
program elgoritmoP•PY
(*

ITES PARANINFO c 8


* Algoritmo 2.2. Convertir temperatura Fahrenheit en temperatura Celsius
* Fecha: 1/9/2005
*)

uses ™rtY

var
tempp—hrenheit X realY (* dato, temperatura en grados Fahrenheit *)
tempgelsius X realY (* resultado, temperatura en grados Celsius *)

procedure gonvertirp—hrenheitgelsiusY
(* PRE 0 = tempFahrenheit = 200 *)
(* POST convierte a grados celsius la temperatura de tempFahrenheit *)
begin
tempgelsius Xa @SFH G WFHA B @tempp—hrenheit E QPFHA
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.2. Convertir temperatura Fahrenheit en *****'AY
writeln@'***** temperatura Celsius *****'AY
writeln@'*****'AY
writelnY

write@'Temperatura Fahrenheit (= 0) y (= 200): 'AY
readln@tempp—hrenheitAY
gonvertirp—hrenheitgelsiusY
writeln@'La temperatura en grados Celsius es: 'D tempgelsiusXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•QY
(*
* Algoritmo 2.3. Calculo del salario neto de un trabajador (version 1)

9 c ITES PARANINFO


* Fecha: 1/9/2005
*)

uses ™rtY
const
sw€…iƒ„y a HFPHY
ƒiq…‚y•wihsgy a HFHSY
gyw€viwix„y•…sx…ixsy a THY
gyw€viwix„y•ex‰y a TY

var
s—l—riof—se X longintY (* dato, sueldo base del trabajador *)
—ntigued—d X wordY (* dato, anyos en la empresa *)
s—l—rioxeto X realY (* resultado, salario percibido por el trabajador *)
s—l—riofruto X longintY (* salario bruto del trabajador *)
des™uentos X realY (* descuentos aplicados *)

procedure g—l™ul—rƒ—l—riofrutoY
(* PRE salarioBase y antiguedad tienen un valor valido *)
(* POST salarioBruto contiene el salario bruto del trabajador *)
var
numerouinquenios X wordY
numeroenyos X wordY
p—gouinquenios X wordY
p—goeyos X wordY

begin
numerouinquenios Xa —ntigued—d div SY
numeroenyos Xa —ntigued—d mod SY
p—gouinquenios Xa numerouinquenios B gyw€viwix„y•…sx…ixsyY
p—goeyos Xa numeroenyos B gyw€viwix„y•ex‰yY
s—l—riofruto Xa s—l—riof—se C p—gouinquenios C p—goeyos
endY

procedure g—l™ul—rhes™uentosY
(* PRE se ha calculado el salario bruto y se ha asignado a salarioBruto *)
(* POST descuentos almacena el valor total de los descuentos sobre el salario bruto *)

begin
des™uentos Xa s—l—riofruto B @sw€…iƒ„y C ƒiq…‚y•wihsgyA
endY

ITES PARANINFO c 10


procedure g—l™ul—rƒ—l—rioxetoY
(* PRE salarioBruto y descuentos almacenan, respectivamente, el salario bruto y el
descuento que le corresponde *)
(* POST salarioNeto contiene el salario recibido por el trabajador,
salarioNeto = salarioBruto - descuentos *)

begin
s—l—rioxeto Xa s—l—riofruto E des™uentos
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.3. Calculo del salario neto de un *****'AY
writeln@'***** trabajador (version 1) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el salario base: 'AY
readln@s—l—riof—seAY
write@'Introduzca la antiguedad: 'AY
readln@—ntigued—dAY
g—l™ul—rƒ—l—riofrutoY
g—l™ul—rhes™uentosY
g—l™ul—rƒ—l—rioxetoY
writeln@'El sueldo neto es: 'D s—l—rioxetoXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•RY
(*
* Fecha: 1/9/2005
*)

uses ™rtY
const
sw€…iƒ„y a HFPHY

11 c ITES PARANINFO


ƒiq…‚y•wihsgy a HFHSY
var
s—l—riof—se X wordY (* dato, sueldo base del trabajador *)
s—l—riofruto X wordY (* salario bruto del trabajador *)
des™uentos X realY (* descuentos aplicados *)
numeroenyos X wordY
p—goenyos X wordY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.4. Calculo del salario neto de *****'AY
writeln@'***** un trabajador (version 2) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el salario base: 'AY
readln@s—l—riof—seAY
write@'Introduzca la antiguedad: 'AY

(* Calculo del salario bruto *)
numerouinquenios Xa —ntigued—d div SY
numeroenyos Xa —ntigued—d mod SY

p—goenyos Xa numeroenyos B gyw€viwix„y•ex‰yY
s—l—riofruto Xa s—l—riof—se C p—gouinquenios C p—goenyosY

(* Calculo de los descuentos y el salario neto *)
des™uentos Xa s—l—riofruto B @sw€…iƒ„y C ƒiq…‚y•wihsgyAY
s—l—rioxeto Xa s—l—riofruto E des™uentosY

writeln@'El sueldo neto es: 'D s—l—rioxetoXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•SY
(*

ITES PARANINFO c 12


* Algoritmo 2.5. Expresar una cantidad de bytes en megabytes y kilobytes
* Fecha: 1/9/2005
*)

uses ™rtY

var
n X longintY (* dato, numero de bytes a descomponer *)
m˜ X longintY (* resultado, numero de megabytes *)
k˜ X HFFIHPRY (* resultado, numero de kilobytes *)
˜ X HFFIHPRY (* resultado, numero de bytes *)

procedure gonvertirY
(* PRE 0 = n *)
(* POST (n = 1048576mb + 1024kb + b) y (0 = kb 1024) y (0 = b 1024) *)
var
r˜ X HFFIHRVSUSY (* resto de bytes *)

begin
m˜ Xa n div IHRVSUTY
r˜ Xa n mod IHRVSUTY
(* E1: n = 1048576 mb + rb y 0 = rb 1048576 *)
k˜ Xa r˜ div IHPRY
˜ Xa r˜ mod IHPR
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.5. Expresar una cantidad *****'AY
writeln@'***** de bytes en megabytes y kilobytes *****'AY
writeln@'*****'AY
writelnY
writeln@'Descomposicion en bytes, kilobytes y megabytes'AY
write@'Introduzca un entero (= 0): 'AY
readln@nAY
gonvertirY
writeln@'La descomposicion es:'AY
writeln@' Megabytes: 'D m˜AY

13 c ITES PARANINFO


writeln@' Kilobytes: 'D k˜AY
writeln@' Bytes: 'D ˜AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•TY
(*
* Algoritmo 2.6. Dibujar un cuadrado
* Fecha: 1/9/2005
*)

uses qr—phQD ™rtY

var
l—do X integerY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.6. Dibujar un cuadrado *****'AY
writeln@'*****'AY
writelnY
write @'Introduzca la longitud de lado del cuadrado:'AY
readln @l—doAY

(* E0: Indiferente *)
qr—phwodeY (* 320 x 200 modo grafico blanco-negro *)
gle—rƒ™reenY
ƒhow„urtleY (* Muestra la tortuga *)
(* E1: pos = (0, 0), dir = 0, trazo = Verdadero *)
porwd@l—doAY „urn‚ight @WHAY
(* E2: pos = (0, lado), dir = 90, trazo = Verdadero,
se ha dibujado el primer lado *)
(* E3: pos = (lado, lado), dir = 180, trazo = Verdadero,
se han dibujado dos lados *)

ITES PARANINFO c 14


(* E4: pos = (lado, 0), dir = 270, trazo = Verdadero,
se han dibujado tres lados *)
(* Ef: pos = (0, 0), dir = 0, trazo = Verdadero,
se ha dibujado el cuadrado *)
writelnY
write @'Pulse enter para continuar'AY
readln
endF
¦
¥
§ ¤
program elgoritmoP•UY
(*
* Algoritmo 2.7. Correspondencia entre calificaciones (version 1)
* Fecha: 1/9/2005
*)

uses ™rtY

var
not— X HFFPHY (* nota en la universidad extranjera, 0 = nota = 20 *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.7. Correspondencia entre calificaciones (version 1)
*****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la nota (= 0) y (= 20): 'AY
readln@not—AY
write@'La calificacion es 'AY
case not— of
PH X write@'matricula de honor'AY
IWD IV X write@'sobresaliente'AY
IUD IT X write@'notable'AY
ISD IR X write@'aprobado'AY
else if not— ` IR then write@'suspenso'A
endY
writelnY

15 c ITES PARANINFO


writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•VY
(*
* Algoritmo 2.8. Correspondencia entre calificaciones (version 2)
* Fecha: 1/9/2005
*)

uses ™rtY

var
not— X integerY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.8. Correspondencia entre calificaciones (version 2)
*****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la nota (= 0) y (= 20): 'AY
readln @not—AY
write@'La calificacion es 'AY
case not— of
PH X write@'matricula de honor'AY
IWD IV X write@'sobresaliente'AY
IUD IT X write@'notable'AY
ISD IR X write@'aprobado'AY
HFFIQX write@'suspenso'AY
else write@'no valida'AY
endY
writelnY
writelnY
readln
endF
¦
¥

ITES PARANINFO c 16


§ ¤
program elgoritmoP•WY
(*
* Algoritmo 2.9. Simulacion de una calculadora simple
* Fecha: 1/9/2005
*)

uses ™rtY

var
oper—ndoID oper—ndoP X longintY
oper—dor X charY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.9. Simulacion de una calculadora simple *****'AY
writeln@'*****'AY
writelnY
write @'Introduzca el primer operando entero: 'AY
readln @oper—ndoIAY
write @'Introduzca el segundo operando entero: 'AY
readln @oper—ndoPAY
write @'Introduzca el operador (+, *, -, /): 'AY
readln @oper—dorAY
write @'El resultado de la operacion es: 'AY
case oper—dor of
'+' X writeln@oper—ndoI C oper—ndoPAY
'*' X writeln@oper—ndoI B oper—ndoPAY
'-' X writeln@oper—ndoI E oper—ndoPAY
'/' X writeln@oper—ndoI div oper—ndoPAY
else writeln@'operador incorrecto'A
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•IHY
(*

17 c ITES PARANINFO


* Algoritmo 2.10. Obtener el mayor de dos numeros enteros
* Fecha: 1/9/2005
*)

uses ™rtY

var
xD z X longintY
m—yor X longintY

begin
™lrs™rY
(* PRE (x = X) y (z = Z) *)
(* POST ((x = z) = (mayor = X)) y ((z = x) = (mayor = Z)) *)
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.10. Obtener el mayor de dos numeros enteros *****'AY
writeln@'*****'AY
writelnY
write @'Introduzca el primer entero: 'AY
readln @xAY
write @'Introduzca el segundo entero: 'AY
readln @zAY
if x ba z then m—yor Xa x
else m—yor Xa zY
writeln @'El numero mayor es: 'D m—yorAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•IIY
(*
* Algoritmo 2.11. Comprobar si una fecha es correcta (version 1)

ITES PARANINFO c 18


* Fecha: 1/9/2005
*)

uses ™rtY

var
di— X wordY
mes X wordY
—nyo X wordY
esfisiesto X booleanY (* indicador de anyo bisiesto *)
fe™h—†—lid— X booleanY (* indicador de fecha valida *)

procedure enyofisiestoY
(* POST esBisiesto es Verdadero si el anyo es bisiesto y Falso en caso contrario *)
begin
esfisiesto Xa @—nyo mod R a HA and @—nyo mod IHH `b HA or
@—nyo mod RHH a HA and @—nyo `b QTHHA
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.11. Comprobar si una fecha es correcta (version 1) *****
'AY
writeln@'*****'AY
writelnY
write@'Introduzca el dia: 'AY
readln@di—AY
write@'Introduzca el mes: 'AY
readln@mesAY
write@'Introduzca el anyo: 'AY
readln@—nyoAY
fe™h—†—lid— Xa trueY
if di— ` I then fe™h—†—lid— Xa false
else
case mes of
ID QD SD UD VD IHD IPX (* meses de 31 dias *)
if di— b QI then fe™h—†—lid— Xa falseY
RD TD WD IIX (* meses de 30 dias *)
if di— b QH then fe™h—†—lid— Xa falseY
PX (* mes de febrero *)
begin
enyofisiestoY
if @di— b PWA or @not esfisiesto and @di— b PVAA
then fe™h—†—lid— Xa false

19 c ITES PARANINFO


end
else fe™h—†—lid— Xa false
endY
write @di—D '/'D mesD '/'D —nyoAY
if fe™h—†—lid— then writeln@' es una fecha valida'A
else writeln@' no es una fecha valida'AY
writelnY
readln
endF
¦
¥

§ ¤
program elgoritmoP•IPY
(*
* Fecha: 1/9/2005
*)

uses ™rtY

var
di— X wordY
mes X wordY
—nyo X wordY

(* igual que en Algoritmo 2.11 *)

(* POST esBisiesto es Verdadero si el anyo es bisiesto y Falso en caso contrario *)
begin
esfisiesto Xa @—nyo mod R a HA and @—nyo mod IHH `b HA or
@—nyo mod RHH a HA and @—nyo `b QTHHA
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY

ITES PARANINFO c 20


'AY
writeln@'*****'AY
writelnY
readln@di—AY
readln@mesAY
readln@—nyoAY
if di— ` I then fe™h—†—lid— Xa false
else
case mes of
ID QD SD UD VD IHD IPX fe™h—†—lid— Xa di— à QIY
RD TD WD IIX fe™h—†—lid— Xa di— à QHY
PX begin
enyofisiestoY
fe™h—†—lid— Xa @di— à PWA and @esfisiesto or @di— à PVAAY
end
else fe™h—†—lid— Xa false
endY
write @di—D '/'D mesD '/'D —nyoAY
if fe™h—†—lid— then writeln@ ' es una fecha valida'A
else writeln@ ' no es una fecha valida'AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•IQY
(*
* Fecha: 1/9/2005
*)

uses ™rtY

const
ry‚e•xy‚wev a IHY
ry‚e•iˆ„‚e a IPY

21 c ITES PARANINFO


…wf‚ev•ry‚eƒ•iˆ„‚eƒ a IRHY
sw€…iƒ„y•fety a HFITY
sw€…iƒ„y•ev„y a HFPPY
…wf‚ev•ƒ…ivhy a IQHHY
var
numeroror—s X wordY (* dato, horas trabajadas en un mes por el empleado id *)
id X wordY (* dato, identificador del empleado *)
s—l—riof—se X wordY
s—l—riofruto X wordY
des™uentos X realY

procedure g—l™ul—rƒ—l—riofrutoY
(* PRE numeroHoras y antiguedad tienen un valor *)
(* POST salarioBruto contiene el salario bruto del trabajador *)

var
numeroenyos X wordY
p—goenyos X wordY

begin
(* calcular sueldo base por horas trabajadas *)
if numeroror—s b …wf‚ev•ry‚eƒ•iˆ„‚eƒ
then s—l—riof—se Xa @numeroror—s E …wf‚ev•ry‚eƒ•iˆ„‚eƒA B ry‚e•iˆ„‚e
C …wf‚ev•ry‚eƒ•iˆ„‚eƒ B ry‚e•xy‚wev
else s—l—riof—se Xa numeroror—s B ry‚e•xy‚wevY

(* calcular gratificacion por antiguedad *)
numerouinquenios Xa —ntigued—d DIV SY
numeroenyos Xa —ntigued—d MOD SY
p—goenyos Xa numeroenyos B gyw€viwix„y•ex‰yY

(* calcular salario bruto *)
s—l—riofruto Xa s—l—riof—se C p—gouinquenios C p—goenyos
endY

procedure g—l™ul—rhes™uentosY
(* PRE salarioBruto almacena el salario bruto calculado *)
(* POST descuentos almacena el valor total de los descuentos sobre el salario
bruto *)

ITES PARANINFO c 22


begin
if s—l—riofruto b …wf‚ev•ƒ…ivhy
then des™uentos Xa s—l—riofruto B sw€…iƒ„y•ev„y
else des™uentos Xa s—l—riofruto B sw€…iƒ„y•fety
endY

procedure g—l™ul—rƒ—l—rioxetoY
(* PRE salarioBruto y descuentos almacenan, respectivamente, el salario bruto y el
descuento correspondiente *)
(* POST salarioNeto contiene el salario percibido por el trabajador,
salarioNeto = salarioBruto !descuentos *)

begin
s—l—rioxeto Xa s—l—riofruto E des™uentos
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.13. Calculo del salario neto de *****'AY
writeln@'***** un trabajador (version 3) *****'AY
writeln@'*****'AY
writelnY
write@'Identificador del empleado: 'AY
readln@idAY
write@'Numero de horas trabajadas en un mes por el empleado: 'AY
readln@numeroror—sAY
write@'Antiguedad del empleado: 'AY
g—l™ul—rƒ—l—riofrutoY
g—l™ul—rhes™uentosY
g—l™ul—rƒ—l—rioxetoY
writeln@'El salario del empleado 'D idD ' es: 'D s—l—rioxetoXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoP•IRY
(*
* Algoritmo 2.14. Dibujar un cuadrado a partir de la posicion de los vertices

23 c ITES PARANINFO


* Fecha: 1/9/2005
*)

uses ™rtD gr—phY

type
€unto a record
—˜s X integerY (* valores enteros en lugar de reales *)
ord X integerY
endY
gu—dr—do a record
vID vPD vQD vR X €untoY
endY

var
™ X gu—dr—doY
™gD mg X integerY (* controlador y modo grafico *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 2.14. Dibujar un cuadrado a partir *****'AY
writeln@'***** de la posicion de los vertices *****'AY
writeln@'*****'AY
writelnY

(* E0: Indiferente *)

writeln @'Introduzca los puntos de un cuadrado'AY
write @' Punto 1 (abscisa ordenada): 'AY
readln @™FvIF—˜sD ™FvIFordAY
readln @™FvPF—˜sD ™FvPFordAY
readln @™FvQF—˜sD ™FvQFordAY
readln @™FvRF—˜sD ™FvRFordAY

snitqr—ph@™gDmgD'c:tp'AY (* inicializa modo grafico*)

(* E1: pos = (0, 0), dir = 0, trazo = Verdadero;
los puntos de c son vertices de un cuadrado *)

wove„o@™FvIF—˜sD ™FvIFordAY (* mover al vertice v1 *)

ITES PARANINFO c 24


(* E2: pos = c.v1, dir = 0, trazo = Verdadero *)
vine„o@™FvPF—˜sD™FvPFordAY (* mover al vertice v2 y traza linea *)
vine„o@™FvQF—˜sD™FvQFordAY (* mover al vertice v3 y traza linea *)
vine„o@™FvRF—˜sD™FvRFordAY (* mover al vertice v4 y traza linea *)
vine„o@™FvIF—˜sD™FvIFordAY (* mover al vertice v1 y traza linea *)
(* Ef: cuadrado dibujado , pos = c.v1, dir = 0, trazo = Verdadero *)
readlnY
™loseqr—phY
endF
¦
¥
§ ¤
program elgoritmoP•ISY
(*
*)

uses ™rtY

(*$R+*)

type
pe™h— a record
di— X IFFQIY
mes X IFFIPY
—nyo X word
endY
var
f X pe™h—Y (* dato, fecha dia/mes/anyo *)

(* POST esBisiesto es Verdadero si f.anyo es bisiesto y Falso en caso contrario *)

begin
esfisiesto Xa @fF—nyo mod R a HA and @fF—nyo mod IHH `b HA or
@fF—nyo mod RHH a HA and @fF—nyo `b QTHHA
endY

begin
™lrs™rY

25 c ITES PARANINFO


writelnY
writeln@'*****'AY
'AY
writeln@'*****'AY
writelnY
readln@fFdi—AY
readln@fFmesAY
readln@fF—nyoAY
case fFmes of
ID QD SD UD VD IHD IPX fe™h—†—lid— Xa trueY
RD TD WD IIX fe™h—†—lid— Xa fFdi— `b QIY
PX begin
enyofisiestoY
fe™h—†—lid— Xa @fFdi— `a PWA and @esfisiesto or @fFdi— `b PWAA
endY
endY
write @fFdi—D '/'D fFmesD '/'D fF—nyoAY
if fe™h—†—lid— then writeln@' es una fecha valida'A
else writeln@' no es una fecha valida'AY
writelnY
readln

endF
¦
¥

ITES PARANINFO c 26


3.2. Capítulo 3

§ ¤
program elgoritmoQ•IY
(*
* Algoritmo 3.1. Calcular el perimetro de un cuadrilatero irregular (version 1)
* Fecha: 1/9/2005
* Capitulo 3. Acciones y funciones
*)

uses ™rtY

type
goorden—d— a realY
€unto a record
x X goorden—d—Y
y X goorden—d—Y
endY
var
pID pPD pQD pR X €untoY
poD pd X €untoY
distD perimetro X realY

procedure hist—n™i—Y
(* PRE po y pd almacenan dos puntos *)
(* POST dist almacena la distancia entre los puntos po y pd *)
begin
dist Xa sqrt@sqr@pdFx E poFxA C sqr@pdFy E poFyAA
endY

procedure veer€unto@var xD y X realY n X shortintAY
begin
write@' Coordenada x del punto 'D nD': 'AY
readln@xAY
write@' Coordenada y del punto 'D nD ': 'AY
readln@yAY
writeln
endY

begin
™lrs™rY
writelnY

27 c ITES PARANINFO


writeln@'*****'AY
writeln@'***** Algoritmo 3.1. Calcular el perimetro de un *****'AY
writeln@'***** cuadrilatero irregular (version 1) *****'AY
writeln@'*****'AY
writelnY
writeln@'Introduzca los puntos del cuadrilatero (en orden de adyacencia):'AY
writelnY
veer€unto@pIFxD pIFyD IAY
veer€unto@pPFxD pPFyD PAY
veer€unto@pQFxD pQFyD QAY
veer€unto@pRFxD pRFyD RAY
perimetro Xa HFHY
(* E0 : perimetro = 0 *)

po Xa pIY
pd Xa pPY
hist—n™i—Y
perimetro Xa distY
(* E1 : perimetro = Distancia (p1, p2) *)

po Xa pPY
pd Xa pQY
hist—n™i—Y
perimetro Xa perimetro C distY
(* E2 : perimetro = Distancia (p1, p2) + Distancia (p2, p3) *)

po Xa pQY
pd Xa pRY
hist—n™i—Y
(* E3 : perimetro = Distancia (p1, p2) + Distancia (p2, p3) + Distancia (p3, p4) *)

po Xa pRY
pd Xa pIY
hist—n™i—Y
(* E4 : perimetro = Distancia (p1, p2) + Distancia (p2, p3) +
Distancia (p3, p4) + Distancia (p4, p1) *)

writeln@'El perimetro del cuadrilatero irregular es: 'D perimetroXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•PY
(*

ITES PARANINFO c 28


* Fecha: 1/9/2005
*)

uses ™rtY

type
€unto a record
x X goorden—d—Y
y X goorden—d—Y
endY
var
dID dPD dQD dR X realY
perimetro X realY

procedure hist—n™i—@poD pd X €untoY var dist X realAY
(* POST dist retorna la distancia entre los puntos po y pd *)

begin
dist Xa sqrt@sqr@pdFx E poFxA C sqr@pdFy E poFyAA
endY

begin
write@' Coordenada x del punto 'D nD':'AY
readln@xAY
write@' Coordenada y del punto 'D nD ':'AY
readln@yAY
writeln
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY

29 c ITES PARANINFO


writeln@'*****'AY
writelnY

writeln@'Introduzca los puntos del cuadrilatero:'AY
writelnY

hist—n™i—@pID pPD dIAY
hist—n™i—@pPD pQD dPAY
hist—n™i—@pQD pRD dQAY
hist—n™i—@pRD pID dRAY
perimetro Xa dI C dP C dQ C dRY

writeln@'El perimetro del cuadrilatero irregular es:'D perimetroXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•QY
(*
* Algoritmo 3.3. Accion para el intercambio de dos variables
* Fecha: 1/9/2005
*)

uses ™rtY

var
xD yX integerY

procedure snter™—m˜i—r@var —D ˜ X integerAY
(* PRE a, b : Entero, a = A, b = B *)
(* POST a = B, b = A *)
var
t X integerY
begin
t Xa —Y

ITES PARANINFO c 30


— Xa ˜Y
˜ Xa t
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.3. Accion para el intercambio de dos variables *****'AY
writeln@'*****'AY
writelnY
write@'Valor inicial de x: 'AY
readln@xAY
write@'Valor inicial de y: 'AY
readln@yAY
writelnY
snter™—m˜i—r@xD yAY
writeln@'Valor final de x: 'D xAY
writeln@'Valor final de y: 'D yAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•RY
(*
* Algoritmo 3.4. Desplazamiento circular de tres variables
* Fecha: 1/9/2005
*)

uses ™rtY

var
—D ˜D ™ X integerY

procedure snter™—m˜i—r@var xD y X integerAY
(* PRE x, y : Entero, x = X, y = Y *)
(* POST x = Y, y = X *)
var

31 c ITES PARANINFO


t X integerY
begin
t Xa xY
x Xa yY
y Xa t
endY
begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.4. Desplazamiento circular de tres variables *****'AY
writeln@'*****'AY
writelnY
(* PRE a, b, c : Entero, a = A, b = B, c = C *)
(* POST a, b, c : Entero, a = B, b = C, c = A *)
writeln@'Introduzca tres enteros separados por espacios'AY
write@'y termine pulsando enter: 'AY
readln@—D ˜D ™AY
writelnY
writeln@'Valor inicial de a, b y c: 'D —D ', 'D˜D ' y 'D ™AY
(* E0 : a = A, b = B, c = C *)
(* E0 = PRE *)

snter™—m˜i—r@—D ˜AY
(* E1 : a = B, b = A, c = C *)

snter™—m˜i—r@˜D ™AY
(* Ef : a = B, b = C, c = A = Post *)
writelnY
writeln@'Desplazamiento circular a la izquierda'AY
writelnY
writeln@'Valor final de a, b y c: 'D —D ', 'D˜D ' y 'D ™AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•SY
(*
* Algoritmo 3.5. Algoritmo para dibujar dos cuadrados encajados
* Fecha: 1/9/2005

ITES PARANINFO c 32


*)

uses ™rtD gr—phQY

type
goorden—d— a integerY (* En Pascal las coordenadas son valores enteros *)
€unto a record
x X goorden—d—Y
y X goorden—d—Y
endY
gu—dr—do a record
pos X €untoY
l—doD —ng X integer
endY
var
™e X gu—dr—doY

procedure hi˜uj—rgu—dr—do@™ X gu—dr—doAY
(* PRE Pantalla y pluma indiferentes *)
(* POST cuadrado c dibujado, PE = Baja, PP = c.pos, ORI = c.ang *)

var
i X integerY
begin
€en…pY
ƒet€osition@™FposFxD ™FposFyAY
ƒetre—ding@™F—ngAY
€enhownY
for i Xa I to R do begin
porwd@™Fl—doAY
„urn‚ight@WHAY
endY
endY

procedure veer@var ™ X gu—dr—doAY
begin
writeln@' CUADRADO'AY
write@' Coordenada x del punto origen: 'AY
readln@™FposFxAY
write@' Coordenada y del punto origen: 'AY
readln@™FposFyAY
write@' Lado del cuadrado: 'AY
readln@™Fl—doAY
write@' Angulo del cuadrado (grados): 'AY
readln@™F—ngAY
writelnY

33 c ITES PARANINFO


endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.5. Algoritmo para dibujar dos cuadrados encajados *****'
AY
writeln@'*****'AY
writelnY
veer@™eAY
qr—phwodeY (* 320 x 200 modo grafico blanco-negro *)
gle—rƒ™reenY
ƒhow„urtleY
hi˜uj—rgu—dr—do@™eAY
™eFl—do Xa ™eFl—do div PY
hi˜uj—rgu—dr—do@™eAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•TY
(*
* Fecha: 1/9/2005
*)

uses ™rtY

type
€unto a record
x X goorden—d—Y
y X goorden—d—Y
endY
var
perimetro X realY

ITES PARANINFO c 34


function hist—n™i—@poD pd X €untoA X realY
(* POST retorna la distancia entre los puntos po y pd *)
begin
hist—n™i— Xa sqrt@sqr@pdFx E poFxA C sqr@pdFy E poFyAA
endY
begin
write@' Coordenada x del punto 'D nD':'AY
readln@xAY
write@' Coordenada y del punto 'D nD ':'AY
readln@yAY
writelnY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'*****'AY
writelnY

writeln@'Introduzca los puntos del cuadrilatero:'AY
writelnY

perimetro Xa hist—n™i—@pID pPA C hist—n™i—@pPD pQA C hist—n™i—@pQD pRA C hist—n™i—@
pRD pIAY

writeln@'El perimetro del cuadrilatero irregular es:'D perimetroXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•UY
(*
* Algoritmo 3.7. Funcion que obtiene el mayor de tres numeros (version 1)

35 c ITES PARANINFO


* Fecha: 1/9/2005
*)

uses ™rtY

var
xD yD z X longintY

function w—xQ@—D ˜D ™ X longintA X longintY
begin
if @— ba ˜A and @— ba ™A then w—xQ Xa —
else if @˜ ba —A and @˜ ba ™A then w—xQ Xa ˜
else if @™ ba —A and @™ ba ˜A then w—xQ Xa ™
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.7. Funcion que obtiene el mayor de tres numeros (version
1) *****'AY
writeln@'*****'AY
writelnY

readln@xD yD zAY
writelnY
writeln@'El maximo de 'D xD ', 'D yD ' y 'D zD ' es: 'D w—xQ@xD yD zAAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•VY
(*
* Algoritmo 3.8. Funcion que obtiene el mayor de tres numeros (version 2)
* í Mara J. Majado Rosales
* Fecha: 1/9/2005

ITES PARANINFO c 36


*)
uses ™rtY

var
xD yD z X longintY

function w—xP @—D ˜ X longintA X longintY
begin
w—xP Xa @— C ˜ C —˜s @— E ˜AA div P
endY

function w—xQ @—D ˜D ™ X longintA X longintY
begin
w—xQ Xa w—xP@ —D w—xP @˜D ™AAY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.8. Funcion que obtiene el mayor de *****'AY
writeln@'***** tres numeros (version 2) *****'AY
writeln@'*****'AY
writelnY
readln @xD yD zAY
writelnY
writeln@'El maximo de 'D xD ', 'D yD ' y 'D zD ' es: 'D w—xQ @xD yD zAAY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•WY
(*
* Algoritmo 3.9. Calcular la suma de dos duraciones de tiempo (version 1)
* Fecha: 1/9/2005
*)

37 c ITES PARANINFO


uses ™rtY

(*$R+*) (* Habilita la comprobacion de intervalos *)
{(*$Q+*) Habilita la comprobacion de desbordamiento (solo en version 7.0)}

type
hur—™ion a record
hor— X longintY
minD seg X HFFSW
endY
var
tID tP X hur—™ionY (* entrada de datos *)
tQ X hur—™ionY (* salida de datos *)

procedure ƒum—rhur—™iones@dID dP X hur—™ionY var res X hur—™ionAY
(* La funcion SumarDuraciones mostrada en el libro se codifica
mediante un procedimiento con un parametro paso por referencia,
porque en Pascal una funcion no puede devolver un valor de un
tipo registro *)
var
xD y X HFFIY
begin
y Xa @dIFseg C dPFsegA div THY (* acarreo de segundos *)
x Xa @dIFmin C dPFmin C yA div THY (* acarreo de minutos *)
resFhor— Xa dIFhor— C dPFhor— C xY
resFmin Xa @dIFmin C dPFmin C yA mod THY
resFseg Xa @dIFseg C dPFsegA mod THY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.9. Calcular la suma de dos *****'AY
writeln@'***** duraciones de tiempo (version 1) *****'AY
writeln@'*****'AY
writelnY
writeln@'Introduzca dos duraciones:'AY
writelnY
write@' Horas de la duracion 1: 'AY
readln@tIFhor—AY
write@' Minutos de la duracion 1: 'AY
readln@tIFminAY
write@' Segundos de la duracion 1: 'AY
readln@tIFsegAY
writelnY

ITES PARANINFO c 38


readln@tPFhor—AY
readln@tPFminAY
readln@tPFsegAY

ƒum—rhur—™iones@tID tPD tQAY

writelnY
writeln@'La suma de las duraciones es: 'D
tQFhor—D '-'D tQFminD '-'D tQFsegAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•IHY
(*
* Algoritmo 3.10. Calcular la suma de dos duraciones de tiempo (version 2)
* Fecha: 1/9/2005
*)

uses ™rtY

(*$Q+*) (* Habilita la comprobacion de desbordamiento (solo en version 7.0) *)

type
hur—™ion a record
hor— X longintY
minD seg X HFFSW
endY
var
tID tP X hur—™ionY (* entrada de datos *)
tQ X hur—™ionY (* salida de datos *)

procedure ƒum—rhur—™iones@—D ˜ X hur—™ionY var res X hur—™ionAY
(* Las funciones SumarDuraciones y ConvertirSD del Algoritmo 3.10
se codifican mediante un procedimiento con un parametro paso por
referencia, porque en Pascal una funcion no puede devolver un

39 c ITES PARANINFO


valor de un tipo registro *)
function gonvertirhƒ@d X hur—™ionA X longintY
begin
gonvertirhƒ Xa QTHH B dFhor— C TH B dFmin C dFseg
endY
procedure gonvertirƒh@n X longintY var res X hur—™ionAY
var
d X hur—™ionY
rh X HFFQSWWY
begin
dFhor— Xa n div QTHHY
rh Xa n mod QTHHY
dFmin Xa rh div THY
dFseg Xa rh mod THY
res Xa d
endY

begin (* de SumarDuraciones *)
gonvertirƒh@gonvertirhƒ@—A C gonvertirhƒ@˜AD resAY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 3.10. Calcular la suma de dos *****'AY
writeln@'***** duraciones de tiempo (version 2) *****'AY
writeln@'*****'AY
writelnY

writeln@'Introduzca dos duraciones:'AY
writelnY
readln@tIFhor—AY
readln@tIFminAY
readln@tIFsegAY
writelnY
readln@tPFhor—AY
readln@tPFminAY
readln@tPFsegAY

ƒum—rhur—™iones@tID tPD tQAY

ITES PARANINFO c 40


writelnY
writeln@'La suma de las duraciones es: 'D
tQFhor—D '-'D tQFminD '-'D tQFsegAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoQ•IIY
(*
* Algoritmo 3.11. Comprobar si una fecha es valida (version 3)
* Fecha: 1/9/2005
*)

uses ™rtY

(* $Q+ Habilita la comprobacion de desbordamiento (solo en version 7.0) *)

const
di—swes X array ‘IFFIP“ of integer a
@QID PVD QID QHD QID QHD QID QID QHD QID QHD QIAY

type
pe™h— a record
di— X IFFQIY
mes X IFFIPY
—nyo X wordY
endY
var
f X pe™h—Y (* fecha dia/mes/anyo *)

function enyofisiesto@—nyo X integerA X booleanY
(* PRE anyo es un entero *)
(* POST AnyoBisiesto es verdad si anyo es bisiesto
y falso en caso contrario *)
begin
enyofisiesto Xa @—nyo mod R a HA and @—nyo mod IHH `b HA or
@—nyo mod RHH a HA and @—nyo `b QTHHAY

41 c ITES PARANINFO


endY

begin
™lrs™rY
writeln@'Introduzca una fecha'AY
writelnY
readln@fFdi—AY
readln@fFmesAY
readln@fF—nyoAY

if enyofisiesto@fF—nyoA then di—swes‘P“ Xa PWY
write@fFdi—D '/'D fFmesD '/'D fF—nyoD ' 'AY
if @fFdi— `a di—swes‘fFmes“A then writeln@'es una fecha valida'A
else writeln@'no es una fecha valida'AY
writelnY
readln
endF
¦
¥

ITES PARANINFO c 42


3.3. Capítulo 4

§ ¤
program elgoritmoR•IY
(*
* Algoritmo 4.1. Calcular el valor medio de las notas de una asignatura
* Fecha: 1/9/2005
* Capitulo 4. La iteracion
*)

uses ™rtY

var
v X realY (* nota leida *)
s X realY (* lleva cuenta de la suma total *)
n X integerY (* lleva cuenta del numero de notas *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.1. Calcular el valor medio de ******'AY
writeln@'***** las notas de una asignatura ******'AY
writeln@'*****'AY
writelnY
s Xa HY
n Xa HY
write@'Introduzca una nota (valor 0 para terminar): 'AY
readln@vAY
(* E0 : s = 0 y n = 0 *)
while v ba H do begin
s Xa s C vY
n Xa n C IY
write@'Introduzca una nota (valor 0 para terminar): 'AY
readln@vAY
(* Ei : s = suma de las n notas introducidas hasta este paso
y n = numero de notas introducidas hasta este paso *)
endY
(* Ef : s = suma de todas las notas y n = numero total de
notas introducidas *)
if n b H then writeln@'Valor medio de las notas = 'D sGnXIXPA
else writeln@'No hay valores'AY

43 c ITES PARANINFO


writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•PY
(*
* Algoritmo 4.2. Calcular el numero de ceros y unos en una secuencia
* de caracteres ceros y unos
* Fecha: 1/9/2005
* Fichero de entrada: datos4_2.TXT
*)

uses ™rtD unitms™IY

var
s X ms™IY (* secuencia de enteros *)
numgeros X integerY (* contador del numero de ceros *)
num…nos X integerY (* contador del numero de unos *)
™ X charY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.2. Calcular el numero de ceros *****'AY
writeln@'***** y unos en una secuencia de caracteres *****'AY
writeln@'*****'AY
writelnY
„r—t—mientosni™i—l•wƒgI@sAY
g—rg—r•pi™hero•wƒgI@sD'datos4_2.TXT'AY
numgeros Xa HY
num…nos Xa HY
write@'La secuencia de entrada es: 'AY
gomenz—r•wƒgI@sAY
while @ie•wƒgI@sA `b wƒgI•w—r™—pinA do begin
write@ie•wƒgI@sAD ' 'AY
if ie•wƒgI@sA a '0' then numgeros Xa numgeros C I
else num…nos Xa num…nos C IY
ev—nz—r•wƒgI@sAY

ITES PARANINFO c 44


endY
writelnY
writeln@' Numero de ceros = 'D numgerosAY
writeln@' Numero de unos = 'D num…nosAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•QY
(*
* Algoritmo 4.3. Crear una secuencia de caracteres a partir de otra existente
* Fecha: 1/9/2005
* Fichero de prueba: datos4_3.txt
*)


var
sD t X ms™IY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.3. Crear una secuencia de caracteres *****'AY
writeln@'***** a partir de otra existente *****'AY
writeln@'*****'AY
writelnY
„r—t—mientosni™i—l•wƒgI@tAY
g—rg—r•pi™hero•wƒgI@sD'datos4_3.TXT'AY
err—n™—r•wƒgI@tAY
while ie•wƒgI@sA `b wƒgI•w—r™—pin do begin
if ie•wƒgI@sA a '*' then ‚egistr—r•wƒgI@tD '+'A
else ‚egistr—r•wƒgI@tD ie•wƒgI@sAAY
write@ie•wƒgI@sAAY

45 c ITES PARANINFO


endY
w—r™—r•wƒgI@tAY
ƒ—lv—r•pi™hero•wƒgI@tD'sal4_3.TXT'AY
writelnY
write@'La secuencia de salida es: 'AY
gomenz—r•wƒgI@tAY
while ie•wƒgI@tA `b wƒgI•w—r™—pin do begin
write@ie•wƒgI@tAAY
ev—nz—r•wƒgI@tAY
endY
writelnY
writeln@'Grabado'AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•RY
(*
* Algoritmo 4.4. Calcular el valor medio de una secuencia con las notas de una
asignatura
* Fecha: 1/9/2005
* Fichero de entradas: datos4_4.txt
*)

uses ™rtD unitmsrIY

var
s X msrIY
sum— X realY (* lleva cuenta de la suma total de las notas *)
numilem X integerY (* lleva cuenta del numero de notas *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.4. Calcular el valor medio de una secuencia *****'AY
writeln@'***** con las notas de una asignatura *****'AY
writeln@'*****'AY
writelnY

ITES PARANINFO c 46


„r—t—mientosni™i—l•wƒ‚I@sAY
g—rg—r•pi™hero•wƒ‚I@sD'datos4_4.txt'AY
gomenz—r•wƒ‚I@sAY
sum— Xa HFHY
numilem Xa HY

(* Eini : suma = 0 y numElem = 0 y ea = Primero (S) y INV = Verdadero *)
while ie•wƒ‚I@sA `b wƒ‚I•w—r™—pin do begin
(* INV 1 = i = Long (Piz) y suma tiene el *)
(* sumatorio desde i=1 hasta Long(Piz) de Si *)
(* y numElem = Long (Piz) y (EA (S) MarcaFin) *)
sum— Xa sum— C ie•wƒ‚I@sAY
numilem Xa numilem C IY
write@ie•wƒ‚I@sAXIXPD ' 'AY
ev—nz—r•wƒ‚I@sAY
endY
(* Efin : INV y (EA (S) = MarcaFin) *)
writelnY
writelnY
if @numilem b HA then write@'Valor medio de las notas = 'D sum—GnumilemXIXPA
else write@'Secuencia vacia'AY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•SY
(*
* Algoritmo 4.5. Calcular el numero de pares ceros-unos en una secuencia de caracteres
* Fecha: 1/9/2005
* Fichero de entrada: datos4_5.txt
*)


var
s X wƒgIY
numgeros X integerY (* lleva cuenta del numero de '0' *)

47 c ITES PARANINFO


num€—res X integerY (* lleva cuenta del numero de pares *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.5. Calcular el numero de pares ceros-unos *****'AY
writeln@'***** en una secuencia de caracteres *****'AY
writeln@'*****'AY
writelnY
g—rg—r•pi™hero•wƒgI@sD'datos4_5.txt'AY
numgeros Xa HY
num€—res Xa HY
(* INV y (EA = Primero (S)) *)
while ie•wƒgI@sA `b wƒgI•w—r™—pin do begin
(* INV : numPares = NumPares (Piz), numCeros = NumCeros (Piz) *)
(* INV y (EA_MSC1 MarcaFin) *)
case ie•wƒgI@sA of
'0'X numgeros Xa numgeros C IY
'1'X num€—res Xa num€—res C numgeros
endY
write@ie•wƒgI@sAAY
ev—nz—r•wƒgI@sA
endY
writelnY
writelnY
(* INV y (EA = MarcaFin), numPares = NumPares (S) *)
writeln@'El numero de pares 0-1 es: 'D num€—resAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•TY
(*
* Algoritmo 4.6. Calculo del factorial (version 1)
* Fecha: 1/9/2005

ITES PARANINFO c 48


*)

uses ™rtY

var
nD i X integerY
f—™tori—l X longintY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.6. Calculo del factorial (version 1) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca un entero ( 17): 'A Y
readln@nAY
i Xa HY
f—™tori—l Xa IY
while i ` n do begin
(* INV: factorial = i! *)
i Xa i C IY
f—™tori—l Xa f—™tori—l B i
endY
writelnY
writeln@'El factorial de 'D nD ' es: 'D f—™tori—lAY
writelnY
readln
endF
¦
¥
§ ¤
program —lgoritmoR•UY
(*
* Algoritmo 4.7. Calculo del factorial (version 2)
* Fecha: 1/9/2005
*)

uses ™rtY

var

49 c ITES PARANINFO


nD i X integerY
f—™tori—l X longintY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.7. Calculo del factorial (version 2) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca un entero ( 17): 'AY
readln@nAY
f—™tori—l Xa IY
for iXa P to n do
f—™tori—l Xa f—™tori—l B iY
(* INV factorial = i! *)
writelnY
writeln@'El factorial de 'D nD ' es: 'D f—™tori—lAY
writelnY
readln
endF
¦
¥

§ ¤
program elgoritmoR•VY
(*
* Algoritmo 4.8. Calculo del producto mediante sumas sucesivas
* Fecha: 1/9/2005
*)

uses ™rtY

var
—D ˜D produ™to X longintY
i X longintY

begin
™lrs™rY
writelnY
writeln@'*****'AY

ITES PARANINFO c 50


writeln@'***** Algoritmo 4.8. Calculo del producto mediante sumas sucesivas *****'A
Y
writeln@'*****'AY
writelnY
write@'Introduzca dos numeros enteros separados por blancos: 'AY
readln @—D ˜AY
produ™to Xa HY
for i Xa I to ˜ do
produ™to Xa produ™to C —Y
(* INV producto = a * i y 1 = i = b *)
(* INV y (i = b), producto = a * b = POST *)
writelnY
writeln@' 'D —D '*'D ˜D '='D produ™toAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•WY
(*
* Algoritmo 4.9. Calculo del cociente y resto de una division entera
* Fecha: 1/9/2005
*)

uses ™rtY

var
pD ™D r X longintY
q X longintY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.9. Calculo del cociente y resto de una division entera
*****'AY
writeln@'*****'AY
writelnY
write@'Introduzca dividendo (= 0) y divisor ( 0) separados por blancos: 'AY
readln@pD qAY

51 c ITES PARANINFO


r Xa pY ™ Xa HY
while r ba q do begin
(* INV (p = q * c + r) y (r = 0) *)
r Xa r E qY
™ Xa ™ C IY
endY
(* INV y (r q) = POST *)
writelnY
writeln@'Cociente = 'D ™D ' Resto = 'D rAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IHY
(*
* Algoritmo 4.10. Calculo del maximo comun divisor
* Fecha: 1/9/2005
*)

uses ™rtY

var
—D ˜D uD v X wordY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.10. Calculo del maximo comun divisor *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca dos enteros ( 0) separados por blancos: 'AY
readln@—D ˜AY
u Xa —Y v Xa ˜Y
while u `b v do begin
(* INV (* mcd (a,b) = mcd (u,v) *)
if @u b vA then u Xa u E v
else v Xa v E uY
endY

ITES PARANINFO c 52


(* INV y (u = v) *)
writelnY
writeln@'Maximo comun divisor de 'D —D ' y 'D ˜D ' es: 'D uAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IIY
(*
* Algoritmo 4.11. Calculo de las potencias de 2 (version 1)
* Fecha: 1/9/2005
*)

uses ™rtY

var
x X integerY (* indice inferior del intervalo de potencias *)
y X integerY (* indice superior del intervalo *)
i X integerY

function €oten™i—P@n X integerAXlongintY
(* PRE: n : Entero = 0 *)
(* POST: Potencia2 = 2^n *)
var
p X longintY
j X integerY
begin
p Xa IY
for j Xa I to n do
p Xa p B PY
(* INV p = 2^j *)
€oten™i—P Xa p
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.11. Calculo de las potencias de 2 (version 1) *****'AY

53 c ITES PARANINFO


writeln@'*****'AY
writelnY
write@'Introduzca dos enteros (= 0) en orden creciente separados por blancos: 'AY
readln@xD yAY
writelnY
for i Xa x to y do
writeln@'La potencia 'D iD '-esima de 2 es 'D €oten™i—P@iAAY
(* INV se han calculado y mostrado las potencias de 2
en el intervalo [x,i] *)
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IPY
(*
* Algoritmo 4.12. Calculo de las potencias de 2 (version 2)
* Fecha: 1/9/2005
*)

uses ™rtY

var
x X integerY (* indice inferior *)
y X integerY (* indice superior *)
poten™i—P X longintY (* resultado *)
i X integerY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.12. Calculo de las potencias de 2 (version 2) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca dos enteros (= 0) en orden creciente separados por blancos: 'AY
readln@xD yAY
writelnY
poten™i—P Xa IY
for iXa I to x do

ITES PARANINFO c 54


poten™i—P Xa poten™i—P B PY
(* INV potencia2 = 2î *)
writeln@'La potencia 'D xD '-esima de 2 es 'D poten™i—PAY
for iXa xCI to y do begin
poten™i—P Xa poten™i—P B PY
writeln@'La potencia 'D iD '-esima de 2 es: 'D poten™i—PA
(* INV potencia2 = 2î y se han mostrado las potencias de 2
en el intervalo [x,i] *)
endY
writelnY
readln

endF
¦
¥
§ ¤
program elgoritmoR•IQY
(*
* Algoritmo 4.13. Calculo del termino enesimo de la sucesion de Fibonacci
* Fecha: 1/9/2005
*)

uses ™rtY

var
ultD penult X longintY (* ultimo y penultimo termino de Fibonacci *)
™opi—piõ X longintY (* valor Fibonacci en el paso i-1 *)
fiõ X longintY (* resultado *)
n X integerY (* dato *)
i XintegerY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.13. Calculo del termino enesimo *****'AY
writeln@'***** de la sucesion de Fibonacci *****'AY
writeln@'*****'AY
writelnY
readln@nAY

55 c ITES PARANINFO


writelnY
case n of
H X writeln@'El termino 'DnD'-esimo de la sucesion (posicion 'D nCID') es: 1'
AY
I X writeln@'El termino 'DnD'-esimo de la sucesion (posicion 'D nCID') es: 1'
AY
else penult Xa IY ult Xa IY fiõ Xa PY
for iXaQ to n do begin
™opi—piõ Xa fiõY
fiõ Xa fiõ C ultY
penult Xa ultY
ult Xa ™opi—piõ
(* INV (fibo = f(i)) y (ult = f(i-1)) y (penult = f(i-2)),
3 = i = n *)
endY
(* INV y (i = n) *)
writeln@'El termino 'DnD'-esimo de la sucesion (posicion 'D nCID') es: 'D
fiõA
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IRY
(*
* Algoritmo 4.14. Comprobar si un numero es primo (version 1)
* Fecha: 1/9/2005
*)

uses ™rtY

var
n X longintY (* dato *)
j X integerY

begin
™lrs™rY
writelnY
writeln@'*****'AY

ITES PARANINFO c 56


writeln@'***** Algoritmo 4.14. Comprobar si un numero es primo (version 1) *****'AY
writeln@'*****'AY
writelnY
readln@nAY
writelnY
if n a I then writeln @'1 es primo'A
else begin
j Xa PY
while @n mod jA `b H do
j Xa j C IY
(* INV ( i : 2 = i j : (n MOD i) 0) *)
(* INV y (n MOD j = 0) *)
if j a n then writeln @nD ' es primo'A
else writeln @nD ' no es primo'A
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•ISY
(*
* Algoritmo 4.15. Comprobar si un numero es primo (version 2)
* Fecha: 1/9/2005
*)

uses ™rtY

var
n X longintY
j X integerY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.15. Comprobar si un numero es primo (version 2) *****'AY
writeln@'*****'AY
writelnY

57 c ITES PARANINFO


readln@nAY
writelnY
if @n a IA or @n a PA or @n a QA then writeln@nD ' es primo'A
else if @n b QA and @@n mod PA a HA then writeln@nD' es par, no es primo'A
else if @n b QA and @@n mod PA `b HA then begin
j Xa QY
while @@n mod jA `b HA and @j ` @n div jAA do
j Xa j C PY
(* INV (i : 3 = i j : (n MOD i) 0) *)
(* INV y (n MOD j = 0) o (j = (n DIV j))*)
if @n mod jA `b H then writeln@nD ' es primo'A
else writeln@nD ' no es primo'AY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•ITY
(*
* Algoritmo 4.16. Calcular la parte entera de la raiz cuadrada de un entero (version
1)
* Fecha: 1/9/2005
*)

uses ™rtY

var
nD r™ X longintY (* n dato de entrada, rc parte entera de la raiz *)
i X longintY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.16. Calcular la parte entera de la raiz cuadrada *****'A
Y
writeln@'***** de un entero (version 1) *****'AY
writeln@'*****'AY

ITES PARANINFO c 58


writelnY
write@'Introduzca un entero: 'AY
readln @nAY
writelnY
i Xa IY
while @n ba i B iA do
(* INV ( j : 1 = j i : (j^2 = n)) *)
i Xa i C IY
(* INV y (n i^2) *)
r™ Xa i E IY
writeln@'La parte entera de la raiz cuadrada de 'D nD ' es: 'D r™AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IUY
(*
* Algoritmo 4.17. Calcular la parte entera de la raiz cuadrada de un entero (version
2)
* Fecha: 1/9/2005
*)

uses ™rtY

var
nD r™ X longintY (* n dato, rc resultado *)
impD iD ™ X longintY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.17. Calcular la parte entera de la raiz cuadrada *****'A
Y
writeln@'***** de un entero (version 2) *****'AY
writeln@'*****'AY
writelnY
readln @nAY

59 c ITES PARANINFO


writelnY
i Xa IY ™ Xa IY imp Xa IY
while ™ `a n do begin
(* INV (j : 1 = j i : (j^2 = n) 0) y (c = i^2) y
c es el i-esimo cuadrado, e imp es el i-esimo impar *)
imp Xa imp C PY
™ Xa ™ C impY
i Xa i C I
endY
(* INV y (n c) *)
r™ Xa i E IY
writeln@'La parte entera de la raiz cuadrada de 'DnD' es 'Dr™AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IVY
(*
* Algoritmo 4.18. Calcular 1/x a partir de una sucesion recurrente
* Fecha: 1/9/2005
*)

uses ™rtY

var
x X realY (* dato entre 0 y 1 *)
— X realY (* resultado *)
™ X realY (* para el calculo de la sucesion *)
eps X realY (* error *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.18. Calcular 1/x a partir de una sucesion recurrente
*****'AY
writeln@'*****'AY
writelnY
write@'Introduzca un valor real (= 1) y ( 0): 'AY

ITES PARANINFO c 60


readln @xAY
writelnY
write@'Introduzca el error permitido: 'AY
readln@epsAY
— Xa IY ™ Xa I E xY
while @™ b epsA do begin
— Xa — B @I C ™AY
™ Xa ™ B ™Y
endY
writelnY
writeln@'El resultado de evaluar la expresion 1/'DxD ' es: 'D—AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoR•IWY
(*
* Algoritmo 4.19. Aproxima e elevado a x a partir de su desarrollo en serie
* Fecha: 1/9/2005
*)

uses ™rtY

var
x X integerY (* dato *)
i X integerY (* numero de termino *)
tD s X realY (* termino y suma de la serie *)
eps X realY (* error *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 4.19. Aproxima e elevado a x a partir *****'AY
writeln@'***** de su desarrollo en serie *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca un entero: 'AY
readln@xAY

61 c ITES PARANINFO


writelnY
write@'Introduzca el error permitido: 'AY
readln@epsAY
t Xa IY s Xa tY i Xa HY
while t b eps do begin
i Xa i C IY
t Xa t B @x G iAY
s Xa s C tY
endY
writelnY
writeln@'e elevado a 'DxD' es: 'DsAY
writelnY
readln
endF
¦
¥

ITES PARANINFO c 62


3.4. Capítulo 5

§ ¤
program elgoritmoS•IY
(*
* Algoritmo 5.1. Calcular el numero de pares (primer modelo, tercer esquema)
* Fecha: 1/9/2005
* Capitulo 5. Tecnicas de disenyo de algoritmos
*)

uses ™rtD unitmseIY

var
—D ˜ X integerY
numeD numf X integerY
num€—res X integerY
ƒ X mseIY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.1. Calcular el numero de pares *****'AY
writeln@'***** (primer modelo, tercer esquema) *****'AY
writeln@'*****'AY
writelnY
writeln@'Introduzca un par de enteros distintos:'AY
write@' primer entero: 'AY
readln@—AY
write@' segundo entero: 'AY
readln@˜AY
writelnY
„r—t—mientosni™i—l•wƒiI@ƒAY
g—rg—r•fi™hero•wƒiI@ƒD'datos5_1.txt'AY
gomenz—r•wƒiI@ƒAY
if ie•wƒiI@ƒA a wƒiI•w—r™—pin then write @'Secuencia vacia'A
else begin
num€—res Xa HY
if ie•wƒiI@ƒA a — then begin nume Xa IY numf Xa H end
else if ie•wƒiI@ƒA a ˜ then begin nume Xa HY numf Xa I end

63 c ITES PARANINFO


else begin nume Xa HY numf Xa H endY
(* Se utiliza la equivalencia ITERAR-MIENTRAS *)
write@ie•wƒiI@ƒAD ' 'AY
ev—nz—r•wƒiI@ƒAY
while ie•wƒiI@ƒA `b wƒiI•w—r™—pin do begin
if ie•wƒiI@ƒA a — then begin
num€—res Xa num€—res C numfY
nume Xa nume C I
end
else if ie•wƒiI@ƒA a ˜ then begin
num€—res Xa num€—res C numeY
numf Xa numf C I
endY
ev—nz—r•wƒiI@ƒA
endY
writelnY
writelnY
writeln@'El numero de pares ('D —D', 'D ˜D '), ('D ˜D ', 'D —D ') es: 'D
num€—resAY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•PY
(*
* Algoritmo 5.2. Calcular el numero de pares (segundo modelo, tercer esquema)
* Fecha: 1/9/2005
*)

uses ™rtD unitmsePY

var
—D ˜ X integerY
ƒ X msePY

ITES PARANINFO c 64


begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** (segundo modelo, tercer esquema) *****'AY
writeln@'*****'AY
writelnY
readln @—AY
readln@˜AY
writelnY
„r—t—mientosni™i—l•wƒiP@sAY
g—rg—r•fi™hero•wƒiP@ƒD'datos5_2.txt'AY
sni™e™™eso•wƒiP@ƒAY
if is†—™i—•wƒiP@ƒA then write@'Secuencia vacia'A
else begin
ev—nz—r•wƒiP@ƒAY
write@ie•wƒiP@ƒAD ' 'AY
num€—res Xa HY
if ie•wƒiP@ƒA a — then begin nume Xa IY numf Xa H end
else if ie•wƒiP@ƒA a ˜ then begin nume Xa HY numf Xa I end
else begin nume Xa HY numf Xa H endY
while not is…ltimo•wƒiP@ƒA do begin
ev—nz—r•wƒiP@ƒAY
write@ie•wƒiP@ƒAD ' 'AY
if ie•wƒiP@ƒA a — then begin
nume Xa nume C I
end
else if ie•wƒiP@ƒA a ˜ then begin
numf Xa numf C I
end
endY
writelnY
writelnY
num€—resAY
endY
writelnY
readln

65 c ITES PARANINFO


endF
¦
¥
§ ¤
program elgoritmoS•QY
(*
* Algoritmo 5.3. Calcular el numero de pares (tercer modelo, segundo esquema)
* Fecha: 1/9/2005
*)


var
—D ˜ X integerY
ƒ X mseIY

(*
* Maquina abstracta del tercer modelo a partir de
* una maquina secuencial del primer modelo
*)
—ux X integerY
procedure „r—t—mientosni™i—l•wƒiQ@VAR ƒ X mseIAY
begin
endY

procedure gomenz—r•wƒiQ@VAR ƒ X mseIAY
begin
—ux Xa ie•wƒiI @ƒAY
endY

procedure ev—nz—r•wƒiQ@VAR ƒ X mseIAY
begin
—ux Xa ie•wƒiI @ƒAY
endY

ITES PARANINFO c 66


function ie•wƒiQ@VAR ƒ X mseIA X integerY
begin
ie•wƒiQ Xa —uxY
endY

procedure g—rg—r•pi™hero•wƒiQ@var ƒ X mseIY nom˜re X stringAY
begin
g—rg—r•pi™hero•wƒiI@ƒD nom˜reAY
endY

function is†—™i—•wƒiQ@ƒ X mseIA X booleanY
begin
is†—™i—•wƒiQ Xa ie•wƒiI@ƒA a wƒiI•w—r™—pinY
endY

function is…ltimo•wƒiQ@ƒ X mseIA X booleanY
begin
is…ltimo•wƒiQ Xa ie•wƒiI@ƒA a wƒiI•w—r™—pin
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** (tercer modelo, segundo esquema) *****'AY
writeln@'*****'AY
writelnY
readln@—AY
readln@˜AY
writelnY
„r—t—mientosni™i—l•wƒiQ@sAY
g—rg—r•fi™hero•wƒiQ@ƒD'datos5_3.txt'AY
gomenz—r•wƒiQ@ƒAY
if is†—™i—•wƒiQ@ƒA then write@'Secuencia vacia'A
else begin
num€—res Xa HY
nume Xa HY
numf Xa HY
if ie•wƒiQ@ƒA a — then begin
nume Xa nume C I

67 c ITES PARANINFO


end
else if ie•wƒiQ@ƒA a ˜ then begin
numf Xa numf C I
endY
write@ie•wƒiQ@ƒAD ' 'AY
while not is…ltimo•wƒiQ@ƒA do begin
ev—nz—r•wƒiQ@ƒAY
write@ie•wƒiQ@ƒAD ' 'AY
if ie•wƒiQ@ƒA a — then begin
nume Xa nume C I
end
else if ie•wƒiQ@ƒA a ˜ then begin
numf Xa numf C I
endY
endY
writelnY
writelnY
num€—resAY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•RY
(*
* Algoritmo 5.4. Calcular el numero de pares (cuarto modelo, segundo esquema)
* Fecha: 1/9/2005
*)


const
wƒiR•w—r™—pin a wƒiI•w—r™—pinY
var

ITES PARANINFO c 68


—D ˜ X integerY
ƒ X mseIY

(*
* Maquina abstracta del cuarto modelo a partir de
* una maquina secuencial del primer modelo
*)
™omenz—r X booleanY
procedure „r—t—mientosni™i—l•wƒiR@VAR ƒ X mseIAY
begin
endY

procedure sni™i—r•wƒiR@VAR ƒ X mseIAY
begin
™omenz—r Xa falseY
endY

procedure ev—nz—r•wƒiR@VAR ƒ X mseIAY
begin
if not ™omenz—r then ™omenz—r Xa true
else ev—nz—r•wƒiI@ƒAY
endY

function ie•wƒiR@VAR ƒ X mseIA X integerY
begin
ie•wƒiR Xa ie•wƒiI @ƒAY
endY

procedure g—rg—r•pi™hero•wƒiR@var ƒ X mseIY nom˜re X stringAY
begin
g—rg—r•pi™hero•wƒiI@ƒD nom˜reAY
endY

function is†—™i—•wƒiR@ƒ X mseIA X booleanY
begin
is†—™i—•wƒiR Xa ie•wƒiI@ƒA a wƒiI•w—r™—pinY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY

69 c ITES PARANINFO


writeln@'***** (cuarto modelo, segundo esquema) *****'AY
writeln@'*****'AY
writelnY
readln@—AY
readln@˜AY
writelnY
„r—t—mientosni™i—l•wƒiR@sAY
g—rg—r•fi™hero•wƒiR@ƒD'datos5_4.txt'AY
sni™i—r•wƒiR@ƒAY
if is†—™i—•wƒiR@ƒA then write@'Secuencia vacia'A
else begin
num€—res Xa HY
nume Xa HY
numf Xa HY
ev—nz—r•wƒiR@ƒAY
REPEAT
if ie•wƒiR@ƒA a — then begin
nume Xa nume C I
end
else if ie•wƒiR@ƒA a ˜ then begin
numf Xa numf C I
endY
write@ie•wƒiR@ƒAD ' 'AY
ev—nz—r•wƒiR @ƒAY
UNTIL ie•wƒiR@ƒA a wƒiR•w—r™—pinY
writelnY
writelnY
num€—resAY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•SY
(*
* Algoritmo 5.5. Comprobar si hay una nota mayor o igual que 9 (primer modelo)

ITES PARANINFO c 70


* Fecha: 1/9/2005
*)

uses ™rtD unitmsrIY
var
ƒ X msrIY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.5. Comprobar si hay una nota mayor o igual que 9 *****'A
Y
writeln@'***** (primer modelo) *****'AY
writeln@'*****'AY
writelnY
„r—t—mientosni™i—l•wƒ‚I@ƒAY
g—rg—r•fi™hero•wƒ‚I@ƒD'datos5_5.txt'AY
gomenz—r•wƒ‚I@ƒAY
while @ie•wƒ‚I@ƒA `b wƒ‚I•w—r™—pinA do begin
write@ie•wƒ‚I@ƒAXIXPD' 'AY
ev—nz—r•wƒ‚I@ƒAY
endY
gomenz—r•wƒ‚I@ƒAY
while @ie•wƒ‚I@ƒA `b wƒ‚I•w—r™—pinA and not @ie•wƒ‚I@ƒA ba WA do begin
ev—nz—r•wƒ‚I@ƒAY
endY
(* INV No existe en Piz una nota superior o igual a 9 *)
(* fin while *)
writelnY
writelnY
if ie•wƒ‚I@ƒA a wƒ‚I•w—r™—pin then
write@'No existe ninguna nota superior o igual a 9'A
else
write@'Al menos existe una nota superior o igual a 9'AY
writelnY
writelnY
readln
endF
¦
¥

71 c ITES PARANINFO


§ ¤
program elgoritmoS•TY
(*
* Algoritmo 5.6. Comprobar si hay una nota mayor o igual que 9 (segundo modelo)
* Fecha: 1/9/2005
*)

uses ™rtD unitmsrPY

var
ƒ X msrPY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.6. Comprobar si hay una nota mayor o igual que 9 *****'A
Y
writeln@'***** (segundo modelo) *****'AY
writeln@'*****'AY
writelnY
„r—t—mientosni™i—l•wƒ‚P@ƒAY
g—rg—r•fi™hero•wƒ‚P@ƒD'datos5_6.txt'AY
sni™e™™eso•wƒ‚P@ƒAY
if not is†—™i—•wƒ‚P@ƒA then
REPEAT
ev—nz—r•wƒ‚P@ƒAY
write@ie•wƒ‚P@ƒAXIXPD ' 'A
UNTIL @is…ltimo•wƒ‚P@ƒAAY
sni™e™™eso•wƒ‚P@ƒAY
if is†—™i—•wƒ‚P@ƒA then write@'Nadie se ha presentado al examen'A
else begin
REPEAT
ev—nz—r•wƒ‚P@ƒAY
UNTIL is…ltimo•wƒ‚P@ƒA or @ie•wƒ‚P@ƒA ba WAY
writelnY
writelnY

ITES PARANINFO c 72


if ie•wƒ‚P@ƒA ba W then
write@'Al menos existe una nota superior o igual a 9'A
else
write@'No existe ninguna nota superior o igual a 9'A
endY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•UY
(*
* Algoritmo 5.7. Calculo posicion de la primera palabra que comienza por 'a'
* (primer modelo, primer esquema)
* Fecha: 1/9/2005
*)


const
iƒ€egsy a ' 'Y
var
posi™ion X integerY
—nterior X charY
ƒ X ms™IY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.7. Calculo posicion de la primera palabra *****'AY
writeln@'***** que comienza por a (primer modelo, primer esquema)
*****'AY
writeln@'*****'AY
writelnY
„r—t—mientosni™i—l•wƒgI@ƒAY
g—rg—r•fi™hero•wƒgI@ƒD'datos5_7.txt'AY

73 c ITES PARANINFO


gomenz—r•wƒgI @ƒAY
while @ie•wƒgI @ƒA `b wƒgI•w—r™—pinA do begin
write@ie•wƒgI@ƒAAY
ev—nz—r•wƒgI @ƒA
endY
writelnY
posi™ion Xa HY
—nterior Xa iƒ€egsyY
while @ie•wƒgI @ƒA `b wƒgI•w—r™—pinA and
not @@ie•wƒgI @ƒA a 'a'A and @—nterior a iƒ€egsyAA do begin
posi™ion Xa posi™ion C IY
—nterior Xa ie•wƒgI @ƒAY
(* INV En Piz ninguna palabra empieza por 'a' y posicion = Long (Piz) *)
endY
if ie•wƒgI @ƒA a wƒgI•w—r™—pin then
write@'El texto no contiene ninguna palabra que comience por la letra a'A
else
write@'Posicion de la primera palabra que comienza por a es: 'D posi™ionCIAY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•VY
(*
* Algoritmo 5.8. Calculo posicion de la primera palabra que comienza por 'a'
* (primer modelo, tercer esquema)
* Fecha: 1/9/2005
*)


const
iƒ€egsy a ' 'Y

var

ITES PARANINFO c 74


posi™ion X integerY
—nterior X charY
ƒ X ms™IY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.8. Calculo posicion de la primera palabra *****'AY
writeln@'***** que comienza por a (primer modelo, tercer esquema)
*****'AY
writeln@'*****'AY
writelnY
endY
writelnY
if ie•wƒgI@ƒA a wƒgI•w—r™—pin then write@'La secuencia esta vacia'A
else if ie•wƒgI @ƒA a 'a' then
write@'Posicion de la primera palabra que comienza por a es: 'D IA
else begin
posi™ion Xa IY
—nterior Xa ie•wƒgI @ƒAY
(* INV En Piz ninguna palabra empieza por 'a' y posicion = Long (Piz) *)
ev—nz—r•wƒgI @ƒAY
while not @@ie•wƒgI@ƒA a wƒgI•w—r™—pinA or
@@ie•wƒgI@ƒA a 'a'A and
@—nterior a iƒ€egsyAAA do begin
posi™ion Xa posi™ion C IY
—nterior Xa ie•wƒgI@ƒAY
endY
writelnY
if ie•wƒgI@ƒA a wƒgI•w—r™—pin then
write@'El texto no contiene ninguna palabra que comience por la letra
a'A
else
write@'Posicion de la primera palabra que comienza por a es: 'D
posi™ionCIA
endY

75 c ITES PARANINFO


writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•WY
(*
* Algoritmo 5.9. Comprobar si todas las palabras acaban con la misma letra
* (primer modelo, sin secuencia intermedia)
* Fecha: 1/9/2005
*)


const
iƒ€egsy a ' 'Y
var
ultvetr—€rim€—lD —nterior X charY
ƒ X ms™IY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.9. Comprobar si todas las palabras acaban con la misma
*****'AY
writeln@'***** letra (primer modelo, sin secuencia intermedia) *****'A
Y
writeln@'*****'AY
writelnY

(* Esquema de recorrido y busqueda.
Encontrar letra final de la primera palabra *)

ITES PARANINFO c 76


endY
writelnY
gomenz—r•wƒgI@ƒAY
—nterior Xa iƒ€egsyY
while @ie•wƒgI@ƒA `b wƒgI•w—r™—pinA and
not @@ie•wƒgI@ƒA a iƒ€egsyA and @—nterior `b iƒ€egsyAA do begin
ev—nz—r•wƒgI@ƒA
(* INV anterior = ultimo elemento de Piz y
no hay ningun par (letra, espacio) en Piz *)
endY
writelnY
if @ie•wƒgI@ƒA a wƒgI•w—r™—pinA and @—nterior a iƒ€egsyA then
write@'No hay palabras en la secuencia'A
else if @ie•wƒgI@ƒA a wƒgI•w—r™—pinA then
(* (* óSlo hay una palabra y anterior ESPACIO *)
write@'Todas las palabras terminan en la misma letra'A
else begin
(* EA (S) es un espacio en blanco
Esquema de recorrido y busqueda.
Comprobar en el resto de la secuencia *)
ultvetr—€rim€—l Xa —nteriorY
ev—nz—r•wƒgI@ƒAY
not @@ie•wƒgI@ƒA a iƒ€egsyA and @—nterior `b iƒ€egsyA and
@—nterior `b ultvetr—€rim€—lAA do begin
(* INV anterior = ultimo elemento de Piz y
no hay ningun par (letra, espacio) en Piz
tal que letra ultLetraPrimPal *)
endY
if @ie•wƒgI@ƒA a wƒgI•w—r™—pinA and @@—nterior a ultvetr—€rim€—lA
or @—nterior a iƒ€egsyAA then
else
write@'Todas las palabras no terminan en la misma letra'A
endY
writelnY
writelnY
readln
endF
¦
¥
§ ¤

77 c ITES PARANINFO


program elgoritmoS•IHY
(*
* Algoritmo 5.10. Comprobar si todas las palabras acaban con la misma letra
* (primer modelo, con secuencia intermedia formada por las
* ultimas letras de cada palabra)
* Fecha: 1/9/2005
* Fichero de entrada: dat5_10.txt
*)


const
iƒ€egsy a ' 'Y
var
ultvetr— X charY
pinheƒe™uen™i—…ltvetr— X booleanY
ultvetr—€rim€—l X charY
ƒ X ms™IY

procedure y˜tener…ltimoY
(* POST ultLetra es la ¿ltima letra de la siguiente palabra,
si la hay, y se actualiza FinDeSecuenciaUltLetra *)
procedure sgnor—risp—™iosY
(* POST EA es la siguiente letra, si la hay *)
begin
while @ie•wƒgI@ƒA `b wƒgI•w—r™—pinA and @ie•wƒgI@ƒA a iƒ€egsyA do
endY
begin
sgnor—risp—™iosY
if @ie•wƒgI@ƒA a wƒgI•w—r™—pinA then pinheƒe™uen™i—…ltvetr— Xa true
else begin
pinheƒe™uen™i—…ltvetr— Xa FalseY
REPEAT
ultvetr— Xa ie•wƒgI@ƒAY
UNTIL @ie•wƒgI@ƒA a wƒgI•w—r™—pinA or @ie•wƒgI@ƒA a iƒ€egsyAY
endY
endY

ITES PARANINFO c 78


procedure gomenz—r…ltvetr—Y
(* POST ultLetra es la ultima letra de la primera palabra,
begin
y˜tener…ltimo
endY
procedure ev—nz—r…ltvetr—Y
(* POST ultLetra es la última letra de la siguiente palabra,
begin
y˜tener…ltimo
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 5.10. Comprobar si todas las palabras acaban con *****'AY
writeln@'***** la misma letra (primer modelo, con secuencia *****'AY
writeln@'***** intermedia formada por las ultimas letras *****'AY
writeln@'***** de cada palabra) *****'AY
writeln@'*****'AY
writelnY
g—rg—r•fi™hero•wƒgI@ƒD'dat5_10.txt'AY
endY
writelnY

gomenz—r…ltvetr—Y
if pinheƒe™uen™i—…ltvetr— then write@'No hay palabras'A
else begin
ultvetr—€rim€—l Xa ultvetr—Y
repeat
ev—nz—r…ltvetr—
(* INV Todas las letras de Piz son iguales a ultLetraPrimPal *)
until pinheƒe™uen™i—…ltvetr— or @ultvetr— `b ultvetr—€rim€—lAY
writelnY
if pinheƒe™uen™i—…ltvetr— then
else
write@'Todas las palabras no terminan en la misma letra'A

79 c ITES PARANINFO


endY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•IIY
(*
* Algoritmo 5.11. Obtener el k-abecedario de mayor longitud
* Fecha: 1/9/2005
*)

(* El codigo ASCII de la enye no se encuentra entre el codigo ASCII *)
(* de la letra 'n' y la letra 'o' *)


type
„ue˜e™ed—rio a record
long X integerY
primer—vetr— X char
endY

var
kefg X „ue˜e™ed—rioY
is…ltimokefgD is†—™i—kefg X booleanY
—nterior X charY
m—yorkefg X „ue˜e™ed—rioY
i X integerY
ƒ X ms™IY

procedure in™ontr—rsnikefgY
(* PRE EA es el primer caracter de la secuencia o
el siguiente despues del ultimo
k-abecedario en Piz, si lo hay *)
(* POST EA es la segunda letra del siguiente k-abecedario,
si lo hay *)
begin

ITES PARANINFO c 80


repeat
(* INV No hay ningun k-abecedario entre EA y
el ultimo k-abecedario en Piz, si lo hay *)
until @ie•wƒgI@ƒA a wƒgI•w—r™—pinA or @ie•wƒgI@ƒA a ƒu™™@—nteriorAAY
is…ltimokefg Xa ie•wƒgI@ƒA a wƒgI•w—r™—pin
endY

procedure sni™i—rkefgY
(* POST Se actualizan EsVaciakABC y EsUltimokABC,
y anterior y EA contienen el primer y el segundo caracter,
respectivamente del primer k-abecedario, si lo hay *)
begin
if ie•wƒgI@ƒA a wƒgI•w—r™—pin then begin
is…ltimokefg Xa trueY
is†—™i—kefg Xa trueY
end
else begin
in™ontr—rsnikefgY
is†—™i—kefg Xa ie•wƒgI@ƒA a wƒgI•w—r™—pinY
endY
endY

procedure ev—nz—rkefgY
(* PRE EsUltimokABC = Falso y EA es el segundo caracter
del actual k-abecedario *)
(* POST kABC contiene la longitud y el primer caracter del actual
k-abecedario, EA es el segundo caracter del siguiente
k-abecedario, si lo hay, y se actualiza EsUltimokABC *)
begin
kefgFlong Xa IY
kefgFprimer—vetr— Xa —nteriorY
REPEAT
kefgFlong Xa kefgFlong C IY
(* INV kABC.long mantiene la longitud del k-abecedario actual *)
until @ie•wƒgI@ƒA a wƒgI•w—r™—pinA or @ie•wƒgI@ƒA `b ƒu™™@—nteriorAAY
if @ie•wƒgI@ƒA a wƒgI•w—r™—pinA then is…ltimokefg Xa true
else in™ontr—rsnikefg
endY

begin

81 c ITES PARANINFO


™lrs™rY
writelnY
writeln @'*****'AY
writeln @'***** Algoritmo 5.11 Obtener el k-abecedario de mayor longitud'AY
writeln @'*****'AY
writelnY
endY
writelnY
sni™i—rkefgY
if is†—™i—kefg then write@'No hay k-abecedarios'A
else begin
ev—nz—rkefgY
m—yorkefg Xa kefgY
while not is…ltimokefg do begin
ev—nz—rkefgY
if m—yorkefgFlong ` kefgFlong then m—yorkefg Xa kefg
(* INV mayorkABC.long mantiene la longitud del maximo
k-abecedario de Piz *)
endY
writelnY
writeln@'El k-abecedario de mayor longitud es: 'AY
writelnY
writeln@' longitud: 'D m—yorkefgFlongAY
writelnY
write@' k-abecedario: 'AY
for i Xa I to m—yorkefgFlong do
write@™hr@ord@m—yorkefgFprimer—letr—ACiEIAAY
endY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoS•IPY
(*
* Algoritmo 5.12. Control de trafico en una autopista

ITES PARANINFO c 82


* Fecha: 1/9/2005
*)


var
numƒeg„ot—l X integerY
(* Numero de segundos transcurridos durante el control *)
num†ehint X integerY
(* Numero de vehiculos que han entrado en la autopista *)
numƒegsnterw—sv—rgo X integerY
(* Intervalo de tiempo mas largo sin entrar vehiculos *)
numƒegsntere™tu—l X integerY
(* Contador del numero de segundos del intervalo actual *)
ƒ X mseIY

begin
™lrs™rY
writelnY
writeln @'*****'AY
writeln @'***** Algoritmo 5.12 Control de trafico en una autopista *****'AY
writeln @'*****'AY
writelnY
g—rg—r•fi™hero•wƒiI@ƒD'dat5_12.txt'AY
numƒeg„ot—l Xa HY
num†ehint Xa HY
numƒegsnterw—sv—rgo Xa HY
write @'La secuencia de entrada es: 'AY
while ie•wƒiI@ƒA `b H do begin
case ie•wƒiI@ƒA of
P X begin
num†ehint Xa num†ehint C IY
ev—nz—r•wƒiI@ƒA
endY
I X begin
numƒegsntere™tu—l Xa IY
while not @@ie•wƒiI@ƒA a HA or
@ie•wƒiI@ƒA a PAA do begin
if ie•wƒiI@ƒA a I then

83 c ITES PARANINFO


numƒegsntere™tu—l Xa numƒegsntere™tu—l C IY
endY
if numƒegsntere™tu—l b numƒegsnterw—sv—rgo then
numƒegsnterw—sv—rgo Xa numƒegsntere™tu—lY
numƒeg„ot—l Xa numƒeg„ot—l C numƒegsntere™tu—l
endY
else ev—nz—r•wƒiI@ƒAY
endY
endY
writelnY
writelnY
writeln@'El tiempo total transcurrido es: 'D numƒeg„ot—lAY
writelnY
writeln@'El numero de vehiculos que han circulado por la autopista es: 'D
num†ehintAY
writelnY
writeln@'El intervalo de tiempo mas largo sin entrar un vehiculo es: 'D
numƒegsnterw—sv—rgoAY
writelnY
readln
endF
¦
¥

ITES PARANINFO c 84


3.5. Capítulo 6

§ ¤
program elgoritmoT•IY
(*
* Algoritmo 6.1. Mostrar la nota de un alumno (version 1)
* Fecha: 1/9/2005
* Capitulo 6. Tablas
* Fichero de entrada: datos6_1.dat
*)

(* Para generar el fichero datos6_1.dat emplear el programa genf6_1.pas *)
(* Para consultar el fichero datos6_1.dat emplear el programa verf6_1.pas *)
(* En este algoritmo se ha sustituido la secuencia de NotaAlumno
por un fichero secuencial, 'datos6_1.dat' *)

uses ™rtY

const
weˆ•ev…wxyƒ a PHHY

type
xot—elumno a record
™odigo X IFFweˆ•ev…wxyƒY
not— X realY
endY
var
f X file of xot—elumnoY
—lum X xot—elumnoY
™od X IFFweˆ•ev…wxyƒY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.1. Mostrar la nota de un alumno (version 1) *****'AY
writeln@'*****'AY
writelnY
—ssign@fD'datos6_1.dat'AY
reset@fAY
write@'Introduzca el codigo del alumno (= 1) (= 'D weˆ•ev…wxyƒD '): 'AY
readln@™odAY

85 c ITES PARANINFO


if eof@fA then writeln@'El fichero esta vacio'A
else begin
repeat
read@fD—lumAY
until @eof@fAA or @—lumF™odigo a ™odAY
(* Si el codigo es el ultimo, eof sera TRUE,
por ello debemos preguntar por alum.codigo
para determinar su presencia *)
writelnY
if @—lumF™odigo `b ™odA then writeln@'No existe ese codigo'A
else writeLn@'La nota de este alumno es: 'D—lumFnot—XIXPAY
endY
writelnY
readln

endF
¦
¥
§ ¤
program elgoritmoT•PY
(*
* Algoritmo 6.2. Mostrar la nota de un alumno (version 2)
* Fecha: 1/9/2005
*)

(* En lugar de solicitar las notas, se ha declarado la tabla constante *)

uses ™rtY

const
weˆ•ev…wxyƒ a IHH Y

not—s X array ‘IFFweˆ•ev…wxyƒ“ of real a
@IFHD QFSD SFPD IFPD PFUD SFQD TFPD PFPD IFPD VFPD
QFSD SFPD IFPD PFUD QFUD PFPD IFPD VFPD SFRD QFPD
SFQD TFUD PFPD IFPD VFPD QFSD SFPD IFPD PFUD QFRD
PFPD IFWD VFPD SFRD QFPD SFQD TFPD PFPD IFPD VFPD
SFSD SFPD IFPD PFUD QFRD PFPD IFPD VFPD SFRD QFPD
SFQD TFWD PFPD IFPD VFPD QFSD SFPD WFPD PFUD QFRD
PFTD IFPD VFPD SFRD QFPD SFQD TFPD PFPD IFPD VFPD
QFRD SFPD WFPD PFUD QFRD PFPD IFWD VFPD SFRD QFPD

ITES PARANINFO c 86


WFHD TFPD UFPD IFPD VFPD QFWD SFPD IFPD PFUD QFRD
PFRD IFPD UFPD SFRD QFWD SFQD TFPD PFPD IFPD VFPAY

var
™od X IFFweˆ•ev…wxyƒY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.2. Mostrar la nota de un alumno (version 2) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el codigo del alumno (= 1) y (= 'D weˆ•ev…wxyƒD '): 'AY
readln@™odAY
writelnY
if @not—s‘™od“ `b EIFHA then
writeln@'La nota del alumno 'D™odD' es: 'D not—s‘™od“XIXPA
else writeln@'No existe una calificacion para ese alumno'AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•QY
(*
* Algoritmo 6.3. Calculo de la frecuencia de aparicion de las letras mayusculas en un
texto
* Fecha: 1/9/2005
*)


type
pre™uen™i—vetr—s a array ‘'A'FF'Z'“ of integerY
var
tf X pre™uen™i—vetr—sY
s X ms™IY

87 c ITES PARANINFO


procedure sni™i—liz—r„—˜l—pre™uen™i—s @var t X pre™uen™i—vetr—sAY
(* Inicializacion de la tabla con ceros *)
(* POST: t[c] = 0, c: 'A' = c = 'Z' *)

var
™ X 'A'FF'Z'Y

begin
for ™ Xa 'A' to 'Z' do
t‘™“ Xa HY
endY

procedure is™ri˜ir„—˜l—pre™uen™i—s @t X pre™uen™i—vetr—sAY
(* POST: Se escriben los valores de la tabla t *)
var
™ X 'A'FF'Z'Y

begin
writelnY
for ™ Xa 'A' to 'Z' do begin
write@' *|* 'D ™D ' : 'D t‘™“AY
if @@ord@™AEord@'A'ACIA mod T a HA then writelnY
endY
writeln
endY

function isw—yus™ul— @™—r X charA X BooleanY
(* POST: Retorna Verdadero si y solo si car es una letra mayuscula *)

begin
isw—yus™ul— Xa @™—r ba 'A'A and @™—r `a 'Z'AY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.3. Calculo de la frecuencia de aparicion de las *****'AY
writeln@'***** letras mayusculas en un texto *****'AY
writeln@'*****'AY
writelnY
g—rg—r•fi™hero•wƒgI@sD'datos6_3.txt'AY
if ie•wƒgI@sA a wƒgI•w—r™—pin then
writeln@'Secuencia vacia'A
else begin

ITES PARANINFO c 88


sni™i—liz—r„—˜l—pre™uen™i—s@tfAY
repeat
if ie•wƒgI@sA a wƒgI•w—r™—pinvine— then writeln
else write@ie•wƒgI@sAAY
if isw—yus™ul—@ie•wƒgI@sAA then
tf‘ie•wƒgI@sA“ Xa tf‘ie•wƒgI@sA“ C IY
(* INV: tf almacena la frecuencia de aparicion de cada
letra mayuscula en Piz *)
until ie•wƒgI@sA a wƒgI•w—r™—pinY
writelnY
is™ri˜ir„—˜l—pre™uen™i—s@tfAY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•RY
(*
* Algoritmo 6.4. Calcular distribucion de las notas
* Fecha: 1/9/2005
*)


uses ™rtY

const
x…w•xy„eƒ a SY
weˆ•iƒ„…hsex„iƒ a IHHY
type
istudi—nte a record
nom˜re X stringY
ed—d X integerY
sexo X booleanY
not— X realY

89 c ITES PARANINFO


endY
pestudi—ntes a file of istudi—nteY
gurso a array ‘IFFweˆ•iƒ„…hsex„iƒ“ of istudi—nteY
var
f X pestudi—ntesY
™ X gursoY
fxot—s X array ‘IFFx…w•xy„eƒ“ of integerY
iD k X IFFweˆ•iƒ„…hsex„iƒY
j X IFFx…w•xy„eƒY

procedure is™ri˜e@i X integerAY
begin
case i of
I X write@'Numero de suspensos: 'AY
P X write@'Numero de aprobados: 'AY
Q X write@'Numero de notables: 'AY
R X write@'Numero de sobresalientes: 'AY
S X write@'Numero de matriculas de honor: 'AY
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.4. Calcular distribucion de las notas *****'AY
writeln@'*****'AY
writelnY
reset@fAY
k Xa IY
while @not eof@fAA and @k `a weˆ•iƒ„…hsex„iƒA do begin
read@fD™‘k“AY
k Xa k C IY
endY
™lose@fAY
(* Comenzar *)
i Xa IY

(* Tratamiento inicial *)
for j Xa I to x…w•xy„eƒ do
fxot—s‘j“ Xa HY

(* Tratamiento de cada elemento de la tabla *)
while i `b k do begin
if @™‘i“Fnot—A ` S then fxot—s‘I“ Xa fxot—s‘I“ C I
else if @™‘i“Fnot— ba SA and @™‘i“Fnot— ` UA then fxot—s‘P“ Xa fxot—s‘P“ C I

ITES PARANINFO c 90


else if @™‘i“Fnot— ba UA and @™‘i“Fnot— ` WA then fxot—s‘Q“ Xa fxot—s‘Q“ C I
else if ™‘i“Fnot— a W then fxot—s‘R“ Xa fxot—s‘R“ C I
else fxot—s‘S“ Xa fxot—s‘S“ C IY
(* Avanzar *)
i Xa iCIY
endY

(* Tratamiento final *)
for j Xa I to x…w•xy„eƒ do begin
is™ri˜e@jAY
writeln@fxot—s‘j“AY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•SY
(*
* Algoritmo 6.5. Porcentaje de mujeres y hombres, y nota media de cada sexo
* Fecha: 1/9/2005
*)


uses ™rtY
const
weˆ•iƒ„…hsex„iƒ a IHHY
type
nom˜reX stringY
ed—d X integerY
sexo X BooleanY (* verdadero si es mujer, falso si es hombre
*)
not— X RealY
endY
xumistudi—ntes a HFFweˆ•iƒ„…hsex„iƒY

91 c ITES PARANINFO


gurso a array ‘IFF weˆ•iƒ„…hsex„iƒ“ of istudi—nteY
var
™ X gursoY
™ont—wD ™ont—r X HFFweˆ•iƒ„…hsex„iƒY (* contadores numero de mujeres y hombres *)
sum—wD sum—r X RealY (* contadores notas de mujeres y hombres *)
mujeresD hom˜res X RealY (* porcentajes de mujeres y hombres *)
long X xumistudi—ntesY (* longitud de la secuencia almacenada *)
i X IFFweˆ•iƒ„…hsex„iƒY (* indice para la tabla *)

procedure veer@var ™ X gursoY var l X xumistudi—ntesAY
var
f X pestudi—ntesY
begin
reset@fAY
l Xa HY
while @not eof@fAA and @l ` weˆ•iƒ„…hsex„iƒA do begin
l Xa l C IY
read@fD ™‘l“AY
endY
™lose@fAY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.5. Porcentaje de mujeres y hombres, *****'AY
writeln@'***** y nota media de cada sexo *****'AY
writeln@'*****'AY
writelnY
(* Se introducen los datos de long estudiantes en la tabla c *)
veer @™D longAY
case long of
H X writeln@'No hay alumnos'AY
else begin
sum—w Xa HY sum—r Xa HY
™ont—w Xa HY ™ont—r Xa HY
for i Xa I to long do
if ™‘i“Fsexo then begin
sum—w Xa sum—w C ™‘i“Fnot—Y
™ont—w Xa ™ont—w C IY
end
else begin
sum—r Xa sum—r C ™‘i“Fnot—Y
™ont—r Xa ™ont—r C I
endY

ITES PARANINFO c 92


mujeres Xa ™ont—w G long B IHHY
hom˜res Xa ™ont—r G long B IHHY
writeln@'Porcentaje de mujeres: 'D mujeresXIXPD ' %'AY
writelnY
writeln@'Porcentaje de hombres: 'D hom˜resXIXPD ' %'AY
if ™ont—w `b H then begin
writelnY
writeln@'Nota media de las mujeres: 'D sum—wG™ont—wXIXPAY
endY
if ™ont—r `b H then begin
writelnY
writeln@'Nota media de los hombres: 'D sum—rG™ont—rXIXPAY
endY
endY
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•TY
(*
* Algoritmo 6.6. Producto escalar de dos vectores
* Fecha: 1/9/2005
*)

uses ™rtY

const
vweˆ a IHHY
type
‚—ngo a IFFvweˆY
†e™tor a array ‘‚—ngo“ of RealY
var
—D ˜ X †e™torY
produ™to X RealY
long X ‚—ngoY
i X ‚—ngoY

procedure veer@VAR —X†e™torY nX‚—ngoAY

93 c ITES PARANINFO


var
iX‚—ngoY
begin
for iXaI to n do begin
write@'Introduzca el componente 'DiD': 'AY
readln@—‘i“AY
end
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.6. Producto escalar de dos vectores *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la longitud de los vectores: 'AY
readln@longAY
writelnY
writeln@'Vector 1: 'AY
veer@—D longAY
writelnY
writeln@'Vector 2: 'AY
veer@˜D longAY

produ™to Xa HY
produ™to Xa produ™to C —‘i“ B ˜‘i“Y
(* INV producto = a[1]* b[1] + a[2]* b[2] + .. a[i] * b[i] *)

writelnY
writeln@'El producto escalar es: 'D produ™toXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•UY
(*
* Algoritmo 6.7. Obtener el mayor, su numero de ocurrencias y su primera y ultima
posicion

ITES PARANINFO c 94


* Fecha: 1/9/2005
*)

uses ™rtY

const
vweˆ a IHHY
type
†e™tor a array ‘‚—ngo“ of integerY
var
long X ‚—ngoY
t X †e™torY
m—yor X integerY
numep— X ‚—ngoY
priD ult X ‚—ngoY
i X ‚—ngoY

var
iX‚—ngoY
begin
write@'Introduzca el componente 'DiD': 'AY
readln@—‘i“AY
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.7. Obtener el mayor, su numero de ocurrencias y *****'AY
writeln@'***** su primera y ultima posicion *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el numero de elementos ( 0): 'AY
readln@longAY
veer@tD longAY
m—yor Xa t‘I“Y numep— Xa IY pri Xa IY ult Xa IY
for i Xa P to long do begin
(* Se cumple INV definido en la descripcion del algoritmo *)
if t‘i“ b m—yor then begin
m—yor Xa t‘i“Y
numep— Xa IY
pri Xa iY

95 c ITES PARANINFO


ult Xa iY
end
else if t‘i“ a m—yor then begin
numep— Xa numep— C IY
ult Xa iY
end
endY
writelnY
writeln@'El mayor es: 'Dm—yorAY
writeln@'El numero de apariciones es: 'D numep—AY
writeln@'La primera aparicion y la ultima son: 'D priD' y 'D ultAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•VY
(*
* Algoritmo 6.8. Calcular la fecha a partir de la posicion del dia en el anyo (version
1)
* Fecha: 1/9/2005
*)

uses ™rtY

type
wesenyo a IFFIPY
hi—enyo a IFFQTSY
hi—mes a IFFQIY
const
tp X array ‘wesenyo“ of integer a @ ID QPD THD WID IPID ISPD IVPD PIQD PRRD PURD
QHSD QQS AY
var
p X hi—enyoY
i X wesenyoY
mes X wesenyoY
di— X hi—mesY

begin
™lrs™rY

ITES PARANINFO c 96


writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.8. Calcular la fecha a partir de la posicion *****'AY
writeln@'***** del dia en el anyo (version 1) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la posicion del dia en el anyo: 'AY
readln @pAY
i Xa PY
while @i `b IPA and @tp ‘i“ `a pA do
(* INV (j: 1 = j i : p = tp[j]) *)
i Xa i C IY

if tp‘i“ b p then mes Xa i E I
else mes Xa IPY
di— Xa p E tp‘mes“ C IY
writelnY
writeln@'Dia 'Ddi—D' del mes 'D mesAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•WY
(*
* Algoritmo 6.9. Calcular la fecha a partir de la posicion del dia en el anyo (version
2)
* Fecha: 1/9/2005
*)

uses ™rtY

type
weseyo a IFFIPY
hi—eyo a IFFQTSY
hi—mes a IFFQIY

const
tp X array ‘weseyo“ of integer a @ID QPD THD WID IPID ISPD IVPD PIQD PRRD PURD QHSD
QQSAY

97 c ITES PARANINFO


var
p X hi—eyoY
i X weseyoY
mes X weseyoY
di— X hi—mesY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.9. Calcular la fecha a partir de la posicion *****'AY
writeln@'***** del dia en el anyo (version 2) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la posicion del dia en el anyo: 'AY
readln@pAY
if p ba tp‘IP“ then mes Xa IP
else begin
i Xa PY
while tp‘i“ `a p do
(* INV: j: 1 = j i : p = tp[j] *)
i Xa i C IY
mes Xa i E IY
endY
di— Xa p E tp‘mes“ C IY
writelnY
writeln@'Dia 'Ddi—D' del mes 'D mesAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•IHY
(*
* Algoritmo 6.10. Calculo del peso del segmento de mayor peso
* Fecha: 1/9/2005
*)

uses ™rtY

ITES PARANINFO c 98


const
vweˆ a IHHY
type
var
t X †e™torY
pesow—ximo X integerY (* peso mayor de los segmentos de la secuencia *)
pesow—ximoƒege™t X integerY (* peso mayor de los segmentos actuales *)
iD long X ‚—ngoY

procedure veer@VAR — X †e™torY n X ‚—ngoAY
var
i X ‚—ngoY
begin
for i Xa I to n do begin
write@' Introduzca componente 'DiD': 'AY
readln@—‘i“AY
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.10. Calculo del peso del segmento de mayor peso *****'AY
writeln@'*****'AY
writelnY
write@'Introduce el numero de elementos: 'AY
readln@longAY
veer@tD longAY
if long a H then writeln@'Secuencia vacia'A
else begin
pesow—ximo Xa t‘I“Y
pesow—ximoƒege™t Xa t‘I“Y
for iXa P to long do begin
if t‘i“ b t‘i“ C pesow—ximoƒege™t
then pesow—ximoƒege™t Xa t‘i“
else pesow—ximoƒege™t Xa pesow—ximoƒege™t C t‘i“Y
if pesow—ximo ` pesow—ximoƒege™t
then pesow—ximo Xa pesow—ximoƒege™tY
endY
writelnY
writeln@'El peso del segmento de mayor peso es: 'D pesow—ximoAY
endY
writelnY

99 c ITES PARANINFO


readln
endF
¦
¥
§ ¤
program elgoritmoT•IIY
(*
* Algoritmo 6.11. Suma de enteros distintos de cero en segmentos con cero en los
extremos
* Fecha: 1/9/2005
*)

uses ™rtY

const
vweˆ a IHHY
type
var
t X †e™torY
long X ‚—ngoY
i X ‚—ngoY
nogerosƒvg X integerY
pesoxogeros X integerY
™eros X integerY

var
iX‚—ngoY
begin
write@' Introduzca el elemento 'DiD': 'AY
readln@—‘i“AY
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY

ITES PARANINFO c 100


writeln@'***** Algoritmo 6.11. Suma de enteros distintos de cero en *****'AY
writeln@'***** segmentos con cero en los extremos *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la longitud de la secuencia: 'AY
readln@longAY
veer@tD longAY
nogerosƒvg Xa HY
pesoxogeros Xa HY
™eros Xa HY
if t‘i“ a H then begin
nogerosƒvg Xa nogerosƒvg C pesoxogerosY
™eros Xa ™eros C IY
end
else pesoxogeros Xa pesoxogeros C ™erosY
writelnY
writeln@'La suma de los elementos distintos de cero en'AY
writeln@'segmentos con cero en los extremos es: 'DnogerosƒvgAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•IPY
(*
* Algoritmo 6.12. Calcular numero de pares cero-uno (version fuerza bruta)
* Fecha: 1/9/2005
*)

uses ™rtY

const
vweˆ a IHHY
type
†e™tor a array ‘‚—ngo“ of HFFIY
var
t X †e™torY

101 c ITES PARANINFO


iD jD long X ‚—ngoY

var
i X ‚—ngoY
begin
write@' Introduzca elemento 'DiD': 'AY
readln@—‘i“AY
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.12. Calcular numero de pares cero-uno *****'AY
writeln@'***** (version fuerza bruta) *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca la longitud de la secuencia: 'AY
readln@longAY
veer@tD longAY
num€—res Xa HY
if t‘i“ a H then
for j Xa i C I to long do
if t‘j“ a I then num€—res Xa num€—res C IY
writelnY
writeln@'El numero de pares 0-1 es: 'Dnum€—resAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•IQY
(*
* Algoritmo 6.13. Metodo de ordenacion de insercion directa
* Fecha: 1/9/2005
*)



(* Metodo de ordenacion de insercion directa *)

uses ™rtY

const
vweˆ a IHHY

type
‚—ngo a HFFvweˆY

var
tX †e™torY
qD j X ‚—ngoY
n X ‚—ngoY
x X integerY

var
i X ‚—ngoY
begin
readln@—‘i“AY
end
endY

procedure is™ri˜ir@— X †e™torY n X ‚—ngoAY
var
i X ‚—ngoY
begin
for i Xa I to n do
write@—‘i“D' 'AY
writeln
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.13. Metodo de ordenacion de insercion directa *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el numero de elementos: 'AY
readln@nAY
veer@tD nAY



writelnY
write@'Los elementos iniciales son: 'AY
is™ri˜ir@tDnAY

for q Xa P to n do begin
t‘H“ Xa t‘q“Y (* centinela *)
x Xa t‘q“Y
j Xa q E IY
while x ` t‘j“ do begin
t‘jCI“ Xa t‘j“Y (* desplazamiento *)
j Xa j E I
endY
t‘jCI“ Xa xY
endY

writelnY
write@'Los elementos ordenados son: 'AY
is™ri˜ir@tDnAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•IRY
(*
* Algoritmo 6.14. Metodo de ordenacion de seleccion directa
* Fecha: 1/9/2005
*)

(* Metodo de ordenacion de seleccion directa *)

uses ™rtY

const
vweˆ a IHHY
type
var



t X †e™torY
posD qD j X ‚—ngoY
n X ‚—ngoY
min X integerY

var
iX‚—ngoY
begin
readln@—‘i“AY
endY
endY

procedure is™ri˜ir@—X†e™torY nX‚—ngoAY
var
iX‚—ngoY
begin
for iXaI to n do
write@—‘i“D' 'AY
writelnY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.14. Metodo de ordenacion de seleccion directa *****'AY
writeln@'*****'AY
writelnY

write@'Introduzca el numero de elementos: 'AY
readln@nAY
veer@tD nAY

writelnY
write@'Los elementos iniciales son: 'AY
is™ri˜ir@tDnAY

for q Xa I to n E I do begin
pos Xa qY
min Xa t‘q“Y
for j Xa qCI to n do
if min b t‘j“ then begin
pos Xa jY
min Xa t‘j“Y



endY
t‘pos“ Xa t‘q“Y
t‘q“ Xa minY
endY

writelnY
write@'Los elementos ordenados son: 'AY
is™ri˜ir@tDnAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•ISY
(*
* Algoritmo 6.15. Busqueda binaria en un tabla ordenada
* Fecha: 1/9/2005
*)

(* Busqueda binaria en un tabla ordenada *)

uses ™rtY

const
vweˆ a IHHY
type
var
n X ‚—ngoY
t X †e™torY
i X HFFvweˆY
j X IFFvweˆCIY
h X ‚—ngoY
xX integerY

var
iX‚—ngoY



begin
readln@—‘i“AY
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.15. Busqueda binaria en un tabla ordenada *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el numero de elementos (maximo 'D vweˆD '): 'AY
readln@nAY
veer@tD nAY
writelnY
write@'Introduzca el elemento a buscar: 'AY
readln@xAY
i Xa HY
j Xa n C IY
while @i C IA `b j do begin
h Xa @i C jA div PY
if t‘h“ `a x then i Xa h
else j Xa hY
endY
writelnY
for h Xa I to n do begin
write @t‘h“D ' 'AY
endY
writelnY
writelnY
if @i b HA and @x a t‘i“A then
writeln@'Valor encontrado en la posicion: 'D i A
else
writeln@'Valor no encontrado'AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•ITY
(*
* Algoritmo 6.16. Suma de los valores mayores de cada fila de una matriz de enteros



* Fecha: 1/9/2005
*)

uses ™rtY

const
n a PHY
xpil—s a nY (* constante con el numero de filas *)
xgolumn—s a nY (* constante con el numero de columnas *)

type
‚—ngopil—s a IFFxpil—sY
‚—ngogolumn—s a IFFxgolumn—sY
†e™tor a array ‘‚—ngopil—sD ‚—ngogolumn—s“ of integerY
var
t X †e™torY
nfD i X ‚—ngopil—sY
n™D j X ‚—ngogolumn—sY
smD m—yorX integerY

procedure veer@VAR — X †e™torY nf X ‚—ngopil—sY n™ X ‚—ngogolumn—sAY
var
i X ‚—ngopil—sY
j X ‚—ngogolumn—sY

begin
for iXaI to nf do begin
writelnY
writeln@'Fila: 'DiAY
for jXaI to n™ do begin
write@'Introduzca elemento ('DiD', 'D jD'): 'AY
readln@—‘iD j“AY
endY

endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY



writeln@'***** Algoritmo 6.16. Suma de los valores mayores de cada fila *****'AY
writeln@'***** de una matriz de enteros *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el numero de filas (= 'DnD'): 'AY
readln@nfAY
writelnY
write@'Introduzca el numero de columnas (= 'DnD'): 'AY
readln@n™AY
veer@tD nfD n™AY
sm Xa HY
for i Xa I to nf do begin
m—yor Xa t‘iDI“Y
for j Xa P to n™ do begin
if m—yor ` t‘iDj“ then m—yor Xa t‘iDj“
(* INVint mayor = mayor de los j elementos ya recorridos
de la fila i, 1 = j = nc *)
endY
sm Xa sm C m—yor
(* INVext sm = suma de los mayores de las primeras
i filas de T, 1 = i = nf *)
endY
(* INVext y (i = nf) = POST *)
writelnY
writeln@'La suma de los valores mayores de cada fila de'AY
writeln@'la matriz de enteros es: 'D smAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•IUY
(*
* Algoritmo 6.17. Cifrado PlayFair
* Fecha: 1/9/2005
*)

const



x a SY
iƒ€egsy a ' 'Y
type
€—l—˜r— a stringY
w—trizg—r a array ‘IFFxDIFFx“ of charY
€—rvetr—s a record
pD s X CharY
endY
€osi™ion a record
fD ™ X integerY
endY
var
™l—ve X €—l—˜r—Y (* palabra clave *)
p—rgifr—do X €—rvetr—sY (* par codificado *)
m™ X w—trizg—rY (* matriz de codificacion *)
ƒ X ms™IY (* texto original *)
‚ X ms™IY (* texto cifrado *)
(* lexico de una secuencia intermedia de pares de caracteres *)
p—re™tu—l X €—rvetr—sY
ultimo€—r X booleanY

function pin€—res X BooleanY
begin
pin€—res Xa @ie•wƒgI@ƒA a wƒgI•w—r™—pinA and not ultimo€—r
endY

procedure sgnor—rfl—n™osY
(* Salta blancos del texto original *)
begin
while ie•wƒgI@ƒA a iƒ€egsy do
endY

procedure sustituir@var l X charAY
begin
case l of
'j'X lXa'i'Y
'i'X lXa'n'Y
endY
endY

procedure ƒig€—rY
begin
sgnor—rfl—n™osY
if ie•wƒgI@ƒA `b wƒgI•w—r™—pin then begin
p—re™tu—lFp Xa ie•wƒgI@ƒAY
sustituir@p—re™tu—lFpAY



sgnor—rfl—n™osY
if ie•wƒgI@ƒA a wƒgI•w—r™—pin then begin
ultimo€—r Xa trueY
p—re™tu—lFsXa'x'Y
end
else begin
p—re™tu—lFs Xa ie•wƒgI@ƒAY
sustituir@p—re™tu—lFsAY
if p—re™tu—lFsap—re™tu—lFp then
p—re™tu—lFsXa'x'
endY
endY
endY

procedure gomenz—r€—rY

begin
ultimo€—r Xa falseY
ƒigp—rY
endY

procedure ev—nz—r€—rY
begin
if ultimo€—r then ultimo€—r Xa false
else begin
ƒig€—rY
endY
endY

function g—rin€—l—˜r—@p X €—l—˜r—Y long X integerY ™ X CharA X BooleanY
(* PRE: long 0 *)
(* POST retorna Verdadero si el caracter c se encuentra en la tabla p,
Falso en otro caso *)
var
i X IFFxCIY (* En el rango [1, long] *)

begin
i Xa IY
while @i `b longCIA and not @p‘i“ a ™A do
i Xa i C IY
g—rin€—l—˜r— Xa i `b longCIY
endY

procedure gre—rw—trizgodifi™—™ionY



var
letr— X charY (* letra actual *)
iD j X IFFxY

begin
(* rellenar la primera fila con la clave *)
for i Xa I to x do
m™‘IDi“ Xa ™l—ve‘i“Y
(* rellenar resto de filas *)
(* inicializar recorrido intervalo de letras *)
letr— Xa 'a'Y
for i Xa P to x do
for j Xa I to x do begin
while g—rin€—l—˜r—@™l—veD xD letr—A or
@letr— a 'j'A or @letr— a 'i'A do
letr— Xa ƒu™™@letr—AY
m™‘iDj“ Xa letr—Y
letr— Xa ƒu™™@letr—AY
endY
endY

procedure €osin„—˜l—@m X w—trizg—rY ™—r X charY var pos X €osi™ionAY
(* PRE: car es una letra y se encuentra en la tabla *)
var
iD j X IFFxY
begin
i Xa IY
j Xa IY
while @m‘iDj“ `b ™—rA do
if j ` x then j Xa j C I
else begin
i Xa i C IY
j Xa I
endY
posFf Xa iY
posF™Xa jY
endY

procedure godifi™—™ion@p—r X €—rvetr—sY var nuevo€—r X €—rvetr—sAY
var
pID pP X €osi™ionY
fil—D ™ol X IFFxY

begin
€osin„—˜l—@m™D p—rFpD pIAY
€osin„—˜l—@m™D p—rFsD pPAY
if pIFf a pPFf then begin



pIF™ Xa pIF™ mod x C IY
pPF™ Xa pPF™ mod x C IY
nuevo€—rFp Xa m™‘pIFfD pIF™“Y
nuevo€—rFs Xa m™‘pPFfD pPF™“
end
else if pIF™ a pPF™ then begin
pIFf Xa pIFf mod x C IY
pPFf Xa pPFf mod x C IY
nuevo€—rFp Xa m™‘pIFfD pIF™“ Y
nuevo€—rFs Xa m™‘pPFfD pPF™“
end
else begin
nuevo€—rFp Xa m™‘pIFfD pPF™“Y
nuevo€—rFs Xa m™‘pPFfD pIF™“
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.17. Cifrado PlayFair *****'AY
writeln@'*****'AY
writelnY

write@'Introduzca la palabra clave de 5 letras: 'AY
readln@™l—veAY
writelnY
write@'El texto original es: 'AY
while ie•wƒgI@ƒA `b wƒgI•w—r™—pin do begin
endY
gre—rw—trizgodifi™—™ionY
gomenz—r€—rY
„r—t—mientosni™i—l•wƒgI@‚AY
err—n™—r•wƒgI@‚AY
while not pin€—res do begin
godifi™—™ion@p—re™tu—lD p—rgifr—doAY
‚egistr—r•wƒgI@‚D p—rgifr—doFpAY
‚egistr—r•wƒgI@‚D p—rgifr—doFsAY
ev—nz—r€—rY
endY
w—r™—r•wƒgI@‚AY



writelnY
writelnY
write@'El texto cifrado es: 'AY
gomenz—r•wƒgI@‚AY
while @ie•wƒgI@‚A `b wƒgI•w—r™—pinA do begin
write@ie•wƒgI@‚AAY
ev—nz—r•wƒgI@‚A Y
endY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoT•IVY
(*
* Algoritmo 6.18. Justificacion de un texto
* Fecha: 1/9/2005
*)


const
isp—™io a ' 'Y
ƒ—ngr—dow—ximo a ISY
vongw—x€—l a PHY
en™howinvine— a vongw—x€—l C ƒ—ngr—dow—ximoY
en™how—xvine— a VHY

type
vongitud€—l—˜r— a IFFvongw—x€—lY
€—l—˜r— a record
™ontenido X array ‘vongitud€—l—˜r—“ of charY
longitud X vongitud€—l—˜r—
endY
€osinvine— a IFFen™how—xvine—Y
vongitudvine— a HFFen™how—xvine—Y
vine— a record
longitud X vongitudvine—Y



™ontenido X array ‘€osinvine—“ of charY
endY
vongƒ—ngr—do a HFFƒ—ngr—dow—ximoY
vimen™hovine— a en™howinvine—FFen™how—xvine—Y
var
s—ngr—do X vongƒ—ngr—doY
—n™hovine— X vimen™hovine—Y
p—l—˜r—e™tu—l X €—l—˜r—Y
line—e™tu—l X vine—Y
pinheƒe™uen™i—€—l—˜r— X booleanY
ƒ X wƒgIY
w—r™—€—rr—fo X €—l—˜r—Y

(* ************** ********************
* Operaciones secuencia intermedia de palabras
* ************** ********************)

procedure y˜tener€—l—˜r—Y
var
i X integerY
begin
(* Ignora los espacios en blanco *)
@@ie•wƒgI@ƒA a isp—™ioA or @ie•wƒgI@ƒA a wƒgI•w—r™—pinvine—AA do
pinheƒe™uen™i—€—l—˜r— Xa ie•wƒgI@ƒA a wƒgI•w—r™—pinY
if not @ie•wƒgI@ƒA a wƒgI•w—r™—pinA then begin
(* Almacena en el campo palabraActual.contenido la siguiente palabra *)
i Xa HY
repeat
i Xa i C IY
p—l—˜r—e™tu—lF™ontenido‘i“ Xa ie•wƒgI @ƒAY
until @ie•wƒgI@ƒA a wƒgI•w—r™—pinA or @@ie•wƒgI@ƒA a isp—™ioA or
@@ie•wƒgI@ƒA a wƒgI•w—r™—pinvine—AAAY
p—l—˜r—e™tu—lFlongitud Xa iY
end
endY

(* ********************* *************)
procedure gomenz—r€—l—˜r—Y
begin
y˜tener€—l—˜r—Y
endY



(* ********************* *************)
procedure ev—nz—r€—l—˜r—Y
begin
y˜tener€—l—˜r—Y
endY

(* ************** ********************
* Operaciones relacionadas con el tratamiento de palabras
* ************** ********************)
function vongitud @p—lX €—l—˜r—A X vongitud€—l—˜r—Y
begin
vongitud Xa p—lFlongitudY
endY
(* ********************* *************)
function sgu—l @pID pP X €—l—˜r—A X booleanY
var
longD i X vongitud€—l—˜r—Y
igu—lvong X booleanY
begin
igu—lvong Xa pIFlongitud a pPFlongitudY
if igu—lvong then begin
long Xa pIFlongitudY
i Xa IY
while @i `b longA and @pIF™ontenido‘i“ a pPF™ontenido‘i“A do
i Xa i C IY
igu—lvong Xa @pIF™ontenido‘i“ a pPF™ontenido‘i“AY
endY
sgu—l Xa igu—lvong
endY

(* ************** ********************
* Grupo de operaciones de tratamiento de lineas
* ************** ********************)
procedure eny—dirg—r—™terevine— @™—r X charAY
begin
line—e™tu—lFlongitud Xa line—e™tu—lFlongitud C IY
line—e™tu—lF™ontenido‘line—e™tu—lFlongitud“ Xa ™—r
endY

(* ********************* *************)
procedure eny—dir€—l—˜r—evine—Y
var
i X vongitud€—l—˜r—Y
begin
for i Xa I to p—l—˜r—e™tu—lFlongitud do



eny—dirg—r—™terevine— @p—l—˜r—e™tu—lF™ontenido‘i“A
endY

(* ********************* *************)
procedure sni™i—liz—r€ropvine— @var longƒ—ngr—doX vongƒ—ngr—doY
var longvine— X vimen™hovine—AY
var
s—ngr—dovine—D —n™hovine— X integerY
begin
write@'Introduzca el ancho de la linea (entre 'D en™howinvine—D
' y 'D en™how—xvine—D '): 'AY
readln@—n™hovine—AY
if —n™hovine— ` en™howinvine— then longvine— Xa en™howinvine—
else if —n™hovine— b en™how—xvine— then longvine— Xa en™how—xvine—
else longvine— Xa —n™hovine—Y
writelnY
write@'Introduzca el sangrado de la primera linea (entre 0'D
' y 'D ƒ—ngr—dow—ximoD '): 'AY
readln@s—ngr—dovine—AY
if s—ngr—dovine— ` H then longƒ—ngr—do Xa H
else if s—ngr—dovine— b ƒ—ngr—dow—ximo then longƒ—ngr—do Xa ƒ—ngr—dow—ximo
else longƒ—ngr—do Xa s—ngr—dovine—Y

w—r™—€—rr—foFlongitud Xa SY
w—r™—€—rr—foF™ontenido‘I“ Xa '/'Y
w—r™—€—rr—foF™ontenido‘P“ Xa 'P'Y
w—r™—€—rr—foF™ontenido‘Q“ Xa 'A'Y
w—r™—€—rr—foF™ontenido‘R“ Xa 'R'Y
w—r™—€—rr—foF™ontenido‘S“ Xa '/'Y

endY

(* ********************* *************)
procedure ƒ—ngr—rvine— @longƒ—ngr—do X integerAY
var
i X IFFƒ—ngr—dow—ximoY
begin
for i Xa I to longƒ—ngr—do do
eny—dirg—r—™terevine—@isp—™ioA
endY

(* ********************* *************)
procedure sni™i—liz—rvine— @longƒ—ngr—do X integerAY
begin
line—e™tu—lFlongitud Xa HY
if longƒ—ngr—do b H then ƒ—ngr—rvine—@longƒ—ngr—doA
endY



(* ********************* *************)
function g—˜einvine— @esp—™ioƒoli™it—doX vongitud€—l—˜r—Y
longvine— X integerA X booleanY
begin
g—˜einvine— Xa esp—™ioƒoli™it—do `a @longvine— E line—e™tu—lFlongitudA
endY

(* ********************* *************)
procedure is™ri˜irvine— @justifi™—™ion X booleanY
longvine—D longƒ—ngr—do X integerAY
(* ********************* ********)
procedure is™ri˜irvine—tustifi™—d— @longvine—D longƒ—ngr—do X integerAY
var
numrue™osD ˜l—n™osixtr—win X vongitudvine—Y
numrue™ose™tD numrue™oswin X vongitudvine—Y
limsnfD limƒupD pos X €osinvine—Y
(* ********************* *****)
procedure is™ri˜irisp—™ios @numisp—™ios X €osinvine—AY
var
i X €osinvine—Y
begin (* EscribirEspacios *)
for i Xa I to numisp—™ios do
write@isp—™ioAY
endY (* EscribirEspacios *)

begin (* EscribirLineaJustificada
* Calcular limite inferior y superior *)
if line—e™tu—lF™ontenido‘I“ a isp—™io
(* Si es primera linea de un parrafo *)
then limsnf Xa longƒ—ngr—do C I
else limsnf Xa IY
if line—e™tu—lF™ontenido‘line—e™tu—lFlongitud“ a isp—™io
then limƒup Xa line—e™tu—lFlongitud E I
else limƒup Xa line—e™tu—lFlongitudY
is™ri˜irisp—™ios@limsnf E IAY

(* Calcular únmero de huecos *)
numrue™os Xa HY
for pos Xa limsnf to limƒup do
if line—e™tu—lF™ontenido‘pos“ a isp—™io then
numrue™os Xa numrue™os C IY

(* Calcular numero de espacios a insertar y numero de huecos
* en los que se inserta ese numero de espacios, en el resto
* se inserta uno mas *)
if @numrue™os `b HA then begin



˜l—n™osixtr—win Xa @longvine— E limƒupA div numrue™osY
numrue™oswin Xa numrue™os E
@longvine— E limƒupA mod numrue™os
endY

(* Recorrido para insertar espacios en los huecos *)
numrue™ose™t Xa HY
for pos Xa limsnf to limƒup do
if @line—e™tu—lF™ontenido‘pos“ a isp—™ioA and
@numrue™ose™t ` numrue™oswinA then begin
is™ri˜irisp—™ios @˜l—n™osixtr—win C IAY
numrue™ose™t Xa numrue™ose™t C IY
end
else if @line—e™tu—lF™ontenido‘pos“ a isp—™ioA and
@numrue™ose™t ba numrue™oswinA
then is™ri˜irisp—™ios@˜l—n™osixtr—winCPA
else if @line—e™tu—lF™ontenido‘pos“ `b isp—™ioA
then write@line—e™tu—lF™ontenido‘pos“A
endY (* EscribirLineaJustificada *)

(* ********************* ********)
procedure is™ri˜irvine—ƒintustifi™—rY
var
i X €osinvine—Y
begin (* EscribirLineaSinJustificar *)
for i Xa I to line—e™tu—lFlongitud E I do
write@line—e™tu—lF™ontenido‘i“AY
if line—e™tu—lF™ontenido‘line—e™tu—lFlongitud“ `b isp—™io then
write@line—e™tu—lF™ontenido‘line—e™tu—lFlongitud“A
endY (* EscribirLineaSinJustificar *)

begin (* EscribirLinea *)
if justifi™—™ion then is™ri˜irvine—tustifi™—d—@longvine—D longƒ—ngr—doA
else is™ri˜irvine—ƒintustifi™—rY
writeln
endY (* EscribirLinea *)

begin (* Principal *)
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 6.18. Justificacion de un texto *****'AY
writeln@'*****'AY
writelnY
sni™i—liz—r€ropvine—@s—ngr—doD —n™hovine—AY
sni™i—liz—rvine—@s—ngr—doAY
writelnY



write@'El texto justificado es:'AY
writelnY
writelnY
gomenz—r€—l—˜r—Y
while not pinheƒe™uen™i—€—l—˜r— do begin
if sgu—l@p—l—˜r—e™tu—lD w—r™—€—rr—foA then begin
is™ri˜irvine—@falseD —n™hovine—D s—ngr—doAY
writelnY
sni™i—liz—rvine—@s—ngr—doA
end
else begin
if not g—˜einvine—@vongitud@p—l—˜r—e™tu—lAD —n™hovine—A then begin
is™ri˜irvine—@trueD —n™hovine—D s—ngr—doAY
sni™i—liz—rvine— @HAY
endY
eny—dir€—l—˜r—evine—Y
if g—˜einvine—@ID —n™hovine—A then
eny—dirg—r—™terevine—@isp—™ioA
endY
ev—nz—r€—l—˜r—
endY
is™ri˜irvine—@falseD —n™hovine— D s—ngr—doAY
writelnY
readln

endF
¦
¥
§ ¤
program qenpT•IY
(*
* Algoritmo GenF6_1. Genera el fichero datos6_1.dat
* Fecha: 1/9/2005
*)

(* En este algoritmo se ha sustituido la secuencia de NotaAlumno
por un fichero secuencial, 'datos6_1.dat' *)

uses ™rtY

const




type
not— X RealY
endY
var
xX charY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo GenF6_1. Genera el fichero datos6_1.dat *****'AY
writeln@'*****'AY
writelnY
rewrite@fAY
repeat
writelnY
write@'Introduzca el codigo del alumno (= 1) (= 'D weˆ•ev…wxyƒD '): 'AY
readln@—lumF™odigoAY
write@'Introduzca la nota del alumno: 'AY
readln@—lumFnot—AY
write@fD —lumAY
write@'¤Desea introducir mas notas s/S (si),n/N (no)?: 'AY
readln@xAY
until x in ‘'n'D'N'“Y
™lose@fAY
writelnY
readln

endF
¦
¥
§ ¤
program †erpT•IY
(*
* Algoritmo VerF6_1. Consulta todo el fichero datos6_1.dat



* Fecha: 1/9/2005
*)

uses ™rtY

const
type
not— X realY
endY
var

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo VerF6_1. Consulta todo el fichero datos6_1.dat *****'AY
writeln@'*****'AY
writelnY
—ssign @fD'datos6_1.dat'AY
reset@fAY
writeln@'** Notas de los alumnos (pulsa enter para ver siguiente) **'AY
writelnY
while not eof@fA do begin
read@fD—lumAY
write@' codigo: 'AY writeln@—lumF™odigoAY
write@' nota: 'AY writeln @—lumFnot—XIXPAY
readlnY
endY
™lose@fAY
writelnY
readln

endF
¦
¥
§ ¤
program qenpT•RY
(*
* Algoritmo GenF6_4. Genera el fichero datos6_4.dat



* Fecha: 1/9/2005
* Fichero de salida: datos6_4.dat
*)

uses ™rtY

const
w—r™—pinxot—s a EIY
type
nom˜re X stringY
ed—d X integerY
sexo X booleanY
not— X realY
endY

var
f X pestudi—ntesY
est X istudi—nteY
xX charY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo GenF6_4. Genera el fichero datos6_4.dat *****'AY
writeln@'*****'AY
writelnY
rewrite@fAY
(* Se introducen los datos de los estudiantes en la tabla *)
writeln@'Introduzca los datos de los estudiantes (nota=-1 para terminar)'AY
writelnY
write@' Introduzca nota: 'AY readln@estFnot—AY
while estFnot— `b w—r™—pinxot—s do begin
write@' Introduzca el nombre: 'AY readln@estFnom˜reAY
write@' Introduzca la edad: 'AY readln@estFed—dAY
repeat
write@' M/m mujer, H/h hombre: 'AY
readln@xAY
until x in ‘'m'D'M'D'h'D'H'“Y
estFsexo Xa @xa'M'A or @xa'm'AY



write@fDestAY
writelnY
write@' Introduzca nota: 'AY readln@estFnot—AY
endY
™lose@fAY
writelnY
readln

endF
¦
¥
§ ¤
program †erpT•RY
(*
* Algoritmo VerF6_4. Consulta todo el fichero datos6_4.dat
* Fecha: 1/9/2005
*)

uses ™rtY
type
nom˜re X stringY
ed—d X integerY
sexo X booleanY
not— X realY
endY

var
f X pestudi—ntesY
est X istudi—nteY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo VerF6_4. Consulta todo el fichero datos6_4.dat *****'AY
writeln@'*****'AY
writelnY



reset@fAY
writeln@'** Datos de los estudiantes (pulse enter para ver siguiente) **'AY
writelnY
while not eof@fA do begin
read@fDestAY
writeln@' nombre: 'D estFnom˜reAY
writeln@' edad: 'D estFed—dAY
write@' sexo: 'AY
case estFsexo of
TRUEX writeln@'mujer'AY
FALSEX writeln@'hombre'AY
endY
writeln@' nota: 'D estFnot—XIXPAY
readln
endY
™lose@fAY
writelnY
readln
endF
¦
¥



3.6. Capítulo 7
§ ¤
program elgoritmoU•IY
(*
* Algoritmo 7.1. Funcion factorial recursiva
* Fecha: 1/9/2005
* Capitulo 7. Disenyo recursivo
*)

uses ™rtY

var
n X integerY

function p—™tori—l @n X integerAX longintY
(* PRE: n = 0 *)
(* POST: Factorial (n) = n! *)
var
result—do X longintY
begin
if n a H then result—do Xa I
else if n b H then result—do Xa n B p—™tori—l @nEIAY
p—™tori—l Xa result—doY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.1. Funcion factorial recursiva *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca un entero (= 0) y (= 16): 'AY
readln@nAY
writelnY
writeln@'El factorial de 'D nD ' es: 'D p—™tori—l @nAAY
writelnY
readlnY
endF
¦
¥
§ ¤



program elgoritmoU•PY
(*
* Algoritmo 7.2. Funcion division natural recursiva
* Fecha: 1/9/2005
*)

uses ™rtY

var
dividendoD divisorD ™o™ienteD resto X integerY

(*
* Pascal no admite que una funcion devuelve un valor de un tipo registro,
* Por este motivo la funcion DivisionNatural se ha convertido en un procedimiento
* con dos parametros paso por variable
*)
procedure hivisionx—tur—l @numD den X integerY VAR ™o™D res X integerAY
(* PRE: (num = 0) y (den 0) *)
(* POST: DivisionNatural (num,den) = c, r y num = c * den + r y 0 = r den *)
begin
if num ` den then begin
™o™ Xa HY
res Xa num
end
else begin
hivisionx—tur—l@numEdenD denD ™o™D resAY
™o™ Xa ™o™ C I
end
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.2. Funcion division natural recursiva *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el dividendo (= 0): 'AY
readln@dividendoAY
writelnY



write@'Introduzca el divisor ( 0): 'AY
readln@divisorAY
hivisionx—tur—l@dividendoD divisorD ™o™ienteD restoAY
writelnY
writeln@'Resultado: cociente = 'D ™o™ienteD ', resto = 'D restoAY
writelnY
readlnY
endF
¦
¥
§ ¤
program elgoritmoU•QY
(*
* Algoritmo 7.3. Funcion producto escalar recursiva lineal
* Fecha: 1/9/2005
*)

uses ™rtY

const
weˆ a IHY

type
†e™tor a array ‘IFFweˆ“ of realY

var
vvID vvP X †e™torY
nD i X integerY

function pei @vID vP X †e™torY —D ˜ X integerA X realY
(* PRE 1 = a = b = MAX, y v1 y v2 tienen valores significativos en [a, b] *)
(* POST pei (v1, v2, a, b) = sumatorio desde i = a hasta b de v1[i] * v2[i] *)
begin
if — a ˜ then pei Xa vI‘—“ B vP‘—“
else (* a b *) pei Xa vI‘—“ B vP‘—“ C pei @vID vPD —CID ˜A
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY



writeln@'***** Algoritmo 7.3. Funcion producto escalar recursiva lineal *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el numero de elementos de los vectores ( 0) y (='DweˆD'): 'AY
readln@nAY
writelnY
writeln@'Primer vector'AY
write@' Componente 'D iD ': 'AY
readln@vvI‘i“AY
endY
writelnY
writeln@'Segundo vector'AY
readln@vvP‘i“AY
endY
writelnY
writeln@'El producto escalar de los vectores es: 'D pei @vvID vvPD ID nAXIXPAY
writelnY
readlnY
endF
¦
¥
§ ¤
program elgoritmoU•RY
(*
* Algoritmo 7.4. Funcion producto escalar recursiva lineal final
* Fecha: 1/9/2005
*)

uses ™rtY

const
weˆ a IHY

type

var



nD i X integerY

function peii @vID vP X †e™torY —D ˜ X integerY ™ X realA X realY
(* POST pei (v1, v2, a, b, c) = c + sumatorio desde i = a hasta b de v1[i] * v2[i] *)
begin
if — a ˜ then peii Xa ™ C vI‘—“ B vP‘—“
else (* a b *) peii Xa peii @vID vPD —CID ˜D ™ C vI‘—“ B vP‘—“A
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.4. Funcion producto escalar recursiva lineal final *****
'AY
writeln@'*****'AY
writelnY
readln@nAY
writelnY
readln@vvI‘i“AY
endY
writelnY
readln@vvP‘i“AY
endY
writelnY
writeln@'El producto escalar de los vectores es: 'D peii @vvID vvPD ID nD HAXIXPAY
writelnY
readlnY
endF
¦
¥
§ ¤
program elgoritmoU•SY
(*
* Algoritmo 7.5. Funcion producto escalar iterativa, equivalente a la del Algoritmo
7.4



* Fecha: 1/9/2005
*)

uses ™rtY

const
weˆ a IHY

type

var
nD i X integerY

function peii @vID vP X †e™torY —D ˜ X integerY ™ X realA X realY
(* POST pei (v1, v2, a, b, c) = c + sumatorio desde i = a hasta b de v1[i] * v2[
i] *)
var
—•lo™ X integerY (* corresponde al parametro a *)
™•lo™ X realY (* corresponde al parametro c *)
(* el parametro b no varia, no necesita copia local *)

begin
—•lo™ Xa —Y ™•lo™ Xa ™Y
while —•lo™ ` ˜ do begin
™•lo™ Xa ™•lo™ C vI‘—•lo™“ B vP‘—•lo™“Y
—•lo™ Xa —•lo™ C I
endY
peii Xa ™•lo™ C vI‘—•lo™“ B vP‘—•lo™“
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.5. Funcion producto escalar iterativa, *****'AY
writeln@'***** equivalente a la del Algoritmo 7.4 *****'AY
writeln@'*****'AY
writelnY
readln@nAY
writelnY



readln@vvI‘i“AY
endY
writelnY
readln@vvP‘i“AY
endY
writelnY
writeln@'El producto escalar de los vectores es: 'D peii @vvID vvPD ID nD HAXIXPAY
writelnY
readlnY
endF
¦
¥
§ ¤
program elgoritmoU•TY
(*
* Algoritmo 7.6. Funcion producto escalar iterativa sin parametros de inmersion (
version 1)
* Fecha: 1/9/2005
*)

uses ™rtY

const
weˆ a IHY

type

var
nD i X integerY

function pe @vID vP X †e™torA X realY
var
—D ˜ X integerY



™ X realY
begin
— Xa IY ˜ Xa nY ™ Xa HY
while — ` ˜ do begin
™ Xa ™ C vI‘—“ B vP‘—“Y
— Xa — C I
endY
pe Xa ™ C vI‘—“ B vP‘—“
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.6. Funcion producto escalar iterativa sin *****'AY
writeln@'***** parametros de inmersion (version 1) *****'AY
writeln@'*****'AY
writelnY
readln@nAY
writelnY
readln@vvI‘i“AY
endY
writelnY
readln@vvP‘i“AY
endY
writelnY
writeln@'El producto escalar de los vectores es: 'D pe @vvID vvPAXIXPAY
writelnY
readlnY
endF
¦
¥
§ ¤
program elgoritmoU•UY
(*
* Algoritmo 7.7. Funcion producto escalar iterativa (version 2)



* Fecha: 1/9/2005
*)

uses ™rtY

const
weˆ a IHY

type

var
nD i X integerY

function pe @vID vP X †e™torA X realY
var
—D ˜ X integerY
™ X realY
begin
— Xa IY ˜ Xa weˆY ™ Xa HY
while — `a ˜ do begin
™ Xa ™ C vI‘—“ B vP‘—“Y
— Xa — C I
endY
pe Xa ™
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.7. Funcion producto escalar iterativa (version 2) *****'
AY
writeln@'*****'AY
writelnY
readln@nAY
writelnY
readln@vvI‘i“AY
endY
writelnY



readln@vvP‘i“AY
endY
writelnY
writeln@'El producto escalar de los vectores es: 'D pe @vvID vvPAXIXPAY
writelnY
readlnY
endF
¦
¥
§ ¤
program elgoritmoU•VY
(*
* Algoritmo 7.8. Funcion potencia natural recursiva
* Fecha: 1/9/2005
*)

uses ™rtY

var
˜—se X realY
exponente X integerY

function €oten™i—x—tur—l @— X realY n X integerA X realY
(* PRE (n = 0) y (n = 0 = a 0) *)
(* POST PotenciaNatural(a, n) = a elevado a n *)

begin
if n a H then
€oten™i—x—tur—l Xa IFH
else (* n 0 *)
€oten™i—x—tur—l Xa — B €oten™i—x—tur—l@—D nEIAY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.8. Funcion potencia natural recursiva *****'AY



writeln@'*****'AY
writelnY
write@'Introduzca un real como base de la potencia: 'AY
readln@˜—seAY
writelnY
write@'Introduzca un entero como exponente de la potencia (= 0): 'AY
readln@exponenteAY
writelnY
writeln@'Resultado: 'D €oten™i—x—tur—l@˜—seD exponenteAXIXPAY
writelnY
readln

endF
¦
¥
§ ¤
program elgoritmoU•WY
(*
* Algoritmo 7.9. Calculo recursivo de Fibo(n) con inmersion de resultados por
eficiencia
* Fecha: 1/9/2005
*)

uses ™rtY

var
nD fi˜D fi˜ent X integerY

(*
* Por este motivo la funcion iFibo se ha convertido en un procedimiento con
* dos parametros paso por variable
*)
procedure ipi˜o @n X integerY VAR —D ˜ X integerAY
(* PRE n 0 *)
(* POST a, b = Fibo(n), Fibo(n-1) *)
var
fi˜D fi˜ent X integerY

begin
if n a I then begin



— Xa IY
˜ Xa IY (* iF = Fibo(1), Fibo(0) *)
end
else (* n 1 *) begin
ipiõ @n E ID fi˜D fi˜entAY
(*
* tenemos: fib = Fibo(n-1) y fibAnt = Fibo(n-2), luego:
* Fibo(n) = Fibo(n-1) + Fibo(n-2) = fib + fibAnt
* Fibo(n-1) = fib :
*)
— Xa fi˜ C fi˜entY
˜ Xa fi˜Y
end
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.9. Calculo recursivo de Fibo(n) con inmersion *****'AY
writeln@'***** de resultados por eficiencia *****'AY
writeln@'*****'AY
writelnY
write@'Termino de la sucesion que se desea calcular ( 0): 'AY
readln@nAY
writelnY
ipiõ @nD fi˜D fi˜entAY
writeln@'El termino 'D nD '-esimo (posicion 'D nCID ') de la sucesion es: 'D fiÃY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoU•IHY
(*
* Algoritmo 7.10. Funcion interfaz para la funcion del Algoritmo 7.9
* Fecha: 1/9/2005
*)

uses ™rtY



var
n X integerY

(*
* Por este motivo la funcion iFibo se ha convertido en un procedimiento con
* dos parametros paso por variable
*)
procedure ipiõ @n X integerY VAR —D ˜ X longintAY
(* PRE n 0 *)
(* POST a, b = Fibo(n), Fibo(n-1) *)
var
fi˜D fi˜ent X longintY
begin
if n a I then begin
— Xa IY
˜ Xa IY (* a = Fibo(1), b = Fibo(0) *)
end
else begin (* n 1 *)
ipiõ @n E ID fi˜D fi˜entAY
(*
* tenemos: fib = Fibo(n-1) y fibAnt = Fibo(n-2), luego:
* Fibo(n) = Fibo(n-1) + Fibo(n-2) = fib + fibAnt
* Fibo(n-1) = fib :
*)
— Xa fi˜ C fi˜entY ˜ Xa fi˜Y
end
endY

function pinterf @n X integerA X longintY
(* PRE n 0 *)
(* POST Finterf (n) = Fibo(n) *)

var
fi˜D fi˜ent X longintY
begin
if n a H then pinterf Xa I
else begin (* n 0 *)
(* se llama a iFibo y se descarta su segundo resultado *)
ipiõ @nD fi˜D fi˜entAY
pinterf Xa fi˜
end
endY

begin
™lrs™rY



writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.10. Funcion interfaz para la funcion *****'AY
writeln@'***** del Algoritmo 7.9 *****'AY
writeln@'*****'AY
writelnY
write@'Termino de la sucesion que se desea calcular (= 0): 'AY
readln@nAY
writelnY
writeln@'El termino 'D nD '-esimo (posicion 'D nCID ') de la sucesion es: 'D
pinterf @nAAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoU•IIY
(*
* Algoritmo 7.11. Funcion potencia natural mejorada
* Fecha: 1/9/2005
*)

uses ™rtY

var
˜—se X realY
exponente X integerY

function €otx—t @— X realY n X integerA X realY
(* PRE (n = 0) y (n = 0 = a 0) *)
(* POST PotNat(a, n) = a elevado a n *)

var
p X realY
begin
if n a H then
€otx—t Xa IFH
p Xa €otx—t @—D n div PAY
if n mod P a H then €otx—t Xa p B p



else €otx—t Xa — B p B p
endY
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.11. Funcion potencia natural mejorada *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca un real como base de la potencia: 'AY
readln@˜—seAY
writelnY
write@'Introduzca un entero como exponente de la potencia (= 0): 'AY
readln@exponenteAY
writelnY
writeln@'Resultado: 'D €otx—t@˜—seD exponenteAXIXPAY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoU•IPY
(*
* Algoritmo 7.12. Funcion division natural mejorada
* Fecha: 1/9/2005
*)

uses ™rtY

var
dividendoD divisorD ™o™ienteD resto X integerY
(*
* Por este motivo la funcion DivNat se ha convertido en un procedimiento
* con dos parametros paso por variable
*)
procedure hivx—t@numD den X integerY VAR ™o™D res X integerAY
(*



* PRE: (num = 0) y (den 0)
* POST: DivNat (num, den, c, r) y num = coc * den + res y 0 = res den
*)
begin
if num ` den then
begin
™o™ Xa HY
res Xa num
end
else
begin
hivx—t@numD den B PD ™o™D resAY
™o™ Xa ™o™ B PY
if res ba den then
begin
™o™ Xa ™o™ C IY
res Xa res E den
end
end
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.12. Funcion division natural mejorada *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el dividendo (= 0): 'AY
readln@dividendoAY
writelnY
write@'Introduzca el divisor ( 0): 'AY
readln@divisorAY
hivx—t@dividendoD divisorD ™o™ienteD restoAY
writelnY
writeln@'Resultado: cociente = 'D ™o™ienteD ', resto = 'D restoAY
writelnY
readln

endF
¦
¥
§ ¤
program elgoritmoU•IQY
(*
* Algoritmo 7.13. Accion recursiva que resuelve el problema de las torres de Hanoi



* Fecha: 1/9/2005
*)

uses ™rtY

const
weˆ a ISY

type
ist—™— a 'A'FF'C'Y (* El tipo Estaca sera un rango de caracteres *)

var
ndis™os X integerY

procedure r—noi@n X integerY origenD intermedioD destinoX ist—™—AY
(* PRE ... la explicada en el texto *)
(* POST ... la explicada en el texto *)
procedure mover@ˆD ‰X ist—™—AY
(* PRE ... la explicada en el texto *)
(* POST ... la explicada en el texto *)
begin (* de la accion mover *)
(*
* En nuestro caso la accion mover se limitara a
* mostrar por la salida el movimiento realizado.
* En general podria involucrar la modificacion del
* estado de las estacas, si quisieramos llevar cuenta
* del estado del juego en cada momento. Por esta
* razon los parametros de tipo Estaca de la accion
* Hanoi son de tipo dato-resultado.
*)
writeln@' mover disco de la estaca 'D ˆD ' a la estaca 'D ‰A
endY
begin (* de la accion Hanoi *)
case n of
I X mover@origenD destinoA
r—noi@nEID origenD destinoD intermedioAY
mover@origenD destinoAY
r—noi@nEID intermedioD origenD destinoA
end
end
endY



begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.13. Accion recursiva que resuelve el *****'AY
writeln@'***** problema de las torres de Hanoi *****'AY
writeln@'*****'AY
writelnY
write@'Numero de discos (maximo 'D weˆD '): 'AY
readln@ndis™osAY
writelnY
r—noi@ndis™osD 'A'D 'B'D 'C'AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoU•IR•ISY
(*
* Algoritmo 7.14. Algoritmo de ordenacion rapida de Hoare
* Algoritmo 7.15. Accion de particionamiento para la accion de clasificacion rapida
*)

(*
* HOARE
*
* Implementa el algoritmo de clasificacion rapida de C. A. R. Hoare.
* Solicita los datos para la generacion de los elementos del vector
* (valores enteros): semilla aleatoria, numero de elementos que se
* desean generar (con un maximo determinado por la constante MAX), y
* valor maximo que se generara. Muestra el vector antes y despues de
* la clasificacion, y comprueba que efectivamente esta ordenado tras
* la llamada a la funcion de clasificacion.
*)

uses ™rtY

const
weˆ a QHHHY



type
„ipof—se a integerY
indi™e a IFFweˆY
„h—tos a array ‘indi™e“ of „ipof—seY

var
t X „h—tosY
m—x•re—l X indi™eY

procedure gomprue˜—@v X „h—tosY mr X indi™eAY
(*
* Comprueba que los 'mr' primeros elementos del vector 'v' esten
* efectivamente ordenados. En caso contrario imprime un mensaje
* de error indicando la posicion 'i' donde hay una inversion, es
* decir, donde v[i] v[i+1].
*)
var
i X indi™eY
error X booleanY
begin
i Xa IY
error Xa falseY
while @i ` mrA and not error do
if v‘i“ b v‘iCI“ then begin
write@' ERROR (i='D iD ')'AY
error Xa true
end
else
i Xa i C I
endY

procedure snit„h—tos@VAR v X „h—tosY VAR mr X indi™eAY
var
i X indi™eY
seedD m—ximo X integerY
begin
write@'Semilla aleatoria: 'AY
readln@seedAY
‚—ndƒeed Xa seedY
writelnY
write@'Elementos en el vector (minimo 1, maximo 'D weˆD '): 'AY
readln@mrAY
writelnY
write@'Generar valores entre cero y: 'AY
readln@m—ximoAY
for i Xa I to mr do v‘i“ Xa ‚—ndom@m—ximoCIA



endY

procedure wostr—r„h—tos@v X „h—tosY mr X indi™eAY
var
i X indi™eY
begin
i Xa IY
write@v‘i“AY
while i `b mr do begin
write@', 'AY
i Xa i C IY
write@v‘i“A
endY
writeln
endY

procedure gl—sifi™—™ion‚—pid—@VAR v X „h—tosY elementos X indi™eAY
procedure gl—sifi™—™ion‚—pid—s@VAR v X „h—tosY infD sup X integerAY
(*
* Los parametros 'inf' y 'sup' son de tipo 'integer' en lugar de
* ser de tipo 'indice' porque en las llamadas recursivas que se
* hacen en esta funcion con los valores ('inf', 'p-1') y
* ('p+1', 'sup') el valor de 'p+1' podria superar el limite
* superior del tipo 'indice', mientras que el de 'p-1' podria
* caer por debajo de su limite inferior, como asi ocurre, de
* hecho.
*)
var
p X indi™eY
procedure €—rti™ion@VAR v X „h—tosY infD sup X indi™eY
VAR pivote X indi™eAY
var
izD dr X indi™eY

procedure snter™—m˜io@VAR v X „h—tosY iD j X indi™eAY
var
t X „ipof—seY
begin
t Xa v‘i“Y
v‘i“ Xa v‘j“Y
v‘j“ Xa t
endY
begin
iz Xa inf C IY
dr Xa supY
while iz `b dr C I do begin
while @iz `a drA and @v‘iz“ `a v‘inf“A do iz Xa iz C IY



while @iz `a drA and @v‘dr“ ba v‘inf“A do dr Xa dr E IY
if iz ` dr then begin
snter™—m˜io@vD izD drAY
iz Xa iz C IY
dr Xa dr E I
end
endY
snter™—m˜io@vD infD drAY
pivote Xa dr
endY

begin
if inf ` sup then begin
€—rti™ion@vD infD supD pAY
gl—sifi™—™ion‚—pid—s@vD infD pEIAY
gl—sifi™—™ion‚—pid—s@vD pCID supA
end
endY

begin
gl—sifi™—™ion‚—pid—s@vD ID elementosA
endY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 7.14_15. óOrdenacin rpida de Hoare'AY
writeln@'*****'AY
writelnY
snit„h—tos@tD m—x•re—lAY
writelnY
writeln@'Vector antes de la clasificacion:'AY
wostr—r„h—tos@tD m—x•re—lAY
write @'Enter para ordenar...'AY
readlnY
gl—sifi™—™ion‚—pid—@tD m—x•re—lAY
writelnY
writeln@'Vector despues de la clasificacion:'AY
wostr—r„h—tos@tD m—x•re—lAY
gomprue˜—@tD m—x•re—lAY
writelnY
readln
endF
¦
¥



3.7. Capítulo 8

§ ¤
program elgoritmoV•IY
(*
* Algoritmo 8.1. Comprobar el equilibrio de los signos puntuacion de apertura/cierre
* Fecha: 1/9/2005
* Capitulo 8. Estructuras de datos dinamicas
* Ficheros de prueba: dat8_1A.txt, dat8_1B.txt, dat8_1C.txt y dat8_1D.txt
*
* SIGNOS
*
* Comprueba el equilibrio de los signos de puntuacion parentizados
* (parentesis, corchetes y llaves) de un fichero cuyo nombre se le
* solicita por teclado al usuario.
*
* A diferencia del algoritmo presentado en el capitulo de EE.DD.
* dinamicas, este programa no solo dice si el texto es correto o
* no, sino que en este ultimo caso informa ademas del punto del
* texto exacto y los signos que causaron el error.
*
* Para ello, al recorrer la secuencia de entrada se va llevando
* cuenta de la posicion por la que en cada momento se va en el reco-
* rrido (numero de linea y columna dentro de esta). Cuando se en-
* cuentra un signo de apertura, no solo se guarda en la pila el
* signo en cuestion, sino tambien el punto (linea y columna) donde
* este se encontro. De este modo, ante la ocurrencia de un error
* es posible notificar exactamente los signos que lo produjeron y
* las posiciones del texto donde estos se encuentran.
*
* Para detectar la condicion de error, en lugar de llevar una unica
* variable booleana llamada 'error', como en el algoritmo del libro,
* utilizaremos dos variables distintas que nos serviran para identi-
* ficar el tipo de error exacto. Los nombres y significados de estas
* variables son los siguientes:
*
* error_pila: esta variable se pondra a VERDADERO cuando se encuentre
* un signo de cierre y la pila este vacia (es decir, no
* haya signos de apertura pendientes de cerrar).
*
* error_signo: esta variable se pondra a VERDADERO cuando se encuen-
* tre un signo de cierre que no se corresponda con el



* ultimo signo de apertura encontrado en el texto.
*)


const
e€i‚„…‚eƒ a ‘ '['D '('D '{' “Y (* conjunto de signos de apertura *)
gsi‚‚iƒ a ‘ ']'D ')'D '}' “Y (* conjunto de signos de cierre *)

type
d—tos•pil— a
record
signo X charY
line—D ™olumn— X integer
endY

pil—•signos a ”nodo•signosY
nodo•signos a
record
d—tos X d—tos•pil—Y
sig X pil—•signos
endY

var
ƒ X ms™IY
p X pil—•signosY
d X d—tos•pil—Y
nom˜re•fi™hero X stringY
error•signoD error•pil— X booleanY
line—•—™tu—lD (* linea actual del recorrido *)
™olumn—•—™tu—l X integerY (* columna actual del recorrido *)

(* ---------------- Operaciones de la Pila ----------------- *)

function €il—†—™i— X pil—•signosY
begin
€il—†—™i— Xa xsv
endY

function is€il—†—™i—@p X pil—•signosA X booleanY
begin
is€il—†—™i— Xa p a €il—†—™i—
endY

function epil—r@p X pil—•signosY d X d—tos•pil—A X pil—•signosY
var
q X pil—•signosY



begin
new@qAY
q”Fd—tos Xa dY
q”Fsig Xa pY

epil—r Xa q
endY

procedure gim—@p X pil—•signosY VAR ™ X d—tos•pil—AY
begin
™ Xa p”Fd—tos
endY

function hes—pil—r@p X pil—•signosA X pil—•signosY
var
q X pil—•signosY
begin
q Xa p”FsigY
dispose@pAY

hes—pil—r Xa q
endY

function hestruir€il—@p X pil—•signosA X pil—•signosY
begin
while not is€il—†—™i—@pA do p Xa hes—pil—r@pAY

hestruir€il— Xa p
endY

(* ---------------- Operaciones del Programa ----------------- *)

function ƒignogierre@—pertur— X charA X charY
(*
* Devuelve el signo de cierre correspondiente al signo
* de apertura 'apertura'.
*
* Pre: el caracter 'apertura' es un signo de apertura
*)
var
res X charY
begin
case —pertur— of
'[' X res Xa ']'Y
'(' X res Xa ')'Y
'{' X res Xa '}'
endY



ƒignogierre Xa res
endY

(* ---------------- Programa Principal ----------------- *)

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 8.1. Comprobar el equilibrio de los signos puntuacion
*****'AY
writeln@'***** de apertura/cierre *****'AY
writeln@'*****'AY
writelnY
g—rg—r•pi™hero•wƒgI@ƒD 'dat8_1A.txt'AY
writeln@'La secuencia de entrada es:'AY
writelnY
if @ie•wƒgI@ƒA a wƒgI•w—r™—pinvine—A then writeln
else write@ie•wƒgI@ƒAAY
endY
writelnY
writelnY
if ie•wƒgI@ƒA a wƒgI•w—r™—pin then
writeln@'Secuencia vacia.'A
else begin
p Xa €il—†—™i—Y
line—•—™tu—l Xa IY
™olumn—•—™tu—l Xa IY
error•signo Xa falseY
error•pil— Xa falseY
repeat
if ie•wƒgI@ƒA in e€i‚„…‚eƒ then begin
dFsigno Xa ie•wƒgI@ƒAY
dFline— Xa line—•—™tu—lY
dF™olumn— Xa ™olumn—•—™tu—lY
p Xa epil—r@pD dA
end
else if ie•wƒgI@ƒA in gsi‚‚iƒ then begin
if is€il—†—™i—@pA then
error•pil— Xa true
else begin
gim—@pD dAY



p Xa hes—pil—r@pAY
error•signo Xa ie•wƒgI@ƒA `b ƒignogierre@dFsignoA
end
end
else if ie•wƒgI@ƒA a wƒgI•w—r™—pinvine— then
begin
line—•—™tu—l Xa line—•—™tu—l C IY
™olumn—•—™tu—l Xa H
endY
(*
* Avanzamos solo si no ha habido error, para preservar
* en ese caso los valores de la posicion actual y poder
* mostrarlos en el mensaje de error
*)
if not @error•signo or error•pil—A then begin
™olumn—•—™tu—l Xa ™olumn—•—™tu—l C I
end
until @ie•wƒgI@ƒA a wƒgI•w—r™—pinA or error•signo or error•pil—Y
(*
* Analizamos la razon por la que se detuvo la iteracion:
*
* error_pila: se encontro (en el EA) un signo de cierre cuando
* no habia pendientes de cierre ningun signo de apertura.
*
* error_signo: se encontro (en el EA) un signo de cierre que
* no se corresponde con el ultimo signo de apertura
* enontrado (que esta en 'd').
*
* no hay error, pero la pila no es vacia: el texto se agoto y
* los signos de apertura que quedan en la pila no se
* cerraron.
*
* en otro caso: se alcanzo la marca de fin sin errores, y en
* la pila no quedan signos de apertura sin cerrar, luego
* el texto es correcto.
*)
if error•pil— then begin
write@'Error: signo de cierre '''D ie•wƒgI@ƒAD ''' en 'AY
writeln@'linea 'D line—•—™tu—lD ', columna 'D ™olumn—•—™tu—lD ','AY
writeln@'no tiene signo de apertura correspondiente.'A
end
else if error•signo then begin
write@'Error: signo de cierre '''D ie•wƒgI@ƒAD ''' en 'AY
writeln@'linea 'D line—•—™tu—lD ', columna 'D ™olumn—•—™tu—lD ','AY
write@'no se corresponde con signo de apertura 'AY
write@''''D dFsignoD ''' en linea 'D dFline—AY



writeln@', columna 'D dF™olumn—AY
end
else if not is€il—†—™i—@pA then begin
writeln@'Error: se agoto el texto con los siguientes 'AY
writeln@'signos de apertura pendientes de cerrar:'AY
writelnY
repeat
gim—@pD dAY
p Xa hes—pil—r@pAY
write@' signo '''D dFsignoD ''': linea 'AY
writeln@dFline—D ', columna 'D dF™olumn—A
until is€il—†—™i—@pA
end
else
writeln@'Texto correcto.'AY

p Xa hestruir€il—@pA
endY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoV•PY
(*
* Algoritmo 8.2. Crear un archivo secuencial que almacena enteros
* Fecha: 1/9/2005
*)

uses ™rtY

var
— X file of integerY
i X integerY
nom˜repi™h X stringY

begin
™lrs™rY
writelnY
writeln@'*****'AY



writeln@'***** Algoritmo 8.2. Crear un archivo secuencial que *****'AY
writeln@'***** almacena enteros *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el nombre del fichero: 'AY
readln@nom˜repi™hAY
writelnY
—ssign@—D nom˜repi™hAY
rewrite@—AY
write@' Introduzca un numero entero (0 para terminar): 'AY
readln@iAY
while i `b H do begin
write@—D iAY
write@' Introduzca un numero entero (0 para terminar): 'AY
readln@iA
endY
™lose@—AY
writelnY
writeln@'Fichero 'D nom˜repi™hD ' creado'AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoV•QY
(*
* Algoritmo 8.3. Recorrido de un archivo secuencial de enteros para mostrarlos
* Fecha: 1/9/2005
*)

uses ™rtY

var
i X integerY
begin
™lrs™rY
writelnY
writeln@'*****'AY



writeln@'***** Algoritmo 8.3. Recorrido de un archivo secuencial de enteros *****'A
Y
writeln@'***** para mostrarlos *****'AY
writeln@'*****'AY
writelnY
write@'Introduzca el nombre del fichero de entrada: 'AY
writelnY
write@'El fichero consta de los siguientes elementos: 'AY
(*
* Notese que este algoritmo sigue el primer esquema de
* recorrido del segundo modelo de acceso secuencial
* en el que se tiene:
* Iniciar: Reset(a)
* EsUltimo: eof(a)
* Avanzar: read(a, i)
*)
reset@—AY
while not eof@—A do begin
read@—D iAY
write@iD ' 'A
endY
™lose@—AY
writelnY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoV•RY
(*
* Algoritmo 8.4. Acceso directo a un archivo para modificar un elemento
* Fecha: 1/9/2005
*)

uses ™rtY

var



pD i X integerY

begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 8.4. Acceso directo a un archivo para *****'AY
writeln@'***** modificar un elemento *****'AY
writeln@'*****'AY
writelnY
reset@—AY
writelnY
write@'Introduzca la posicion que quiere modificar (= 0): 'AY
readln@pAY
writelnY
if @p ` HA or @p b pileƒize@—AEIA then
writeln@'Posicion fuera del archivo'A
else (* (p = 0) and (p FileSize (a)) *) begin
seek@—D pAY
read@—D iAY
writeln@'Valor actual en la posicion 'D pD ': ' D iAY
writelnY
write@'Introduce nuevo valor: 'AY
readln@iAY
seek@—D pAY
write@—D iAY
writelnY
writeln@'Fichero 'D nom˜repi™hD ' actualizado'AY
endY
™lose@—AY
writelnY
readln
endF
¦
¥
§ ¤
program elgoritmoV•SY
(*
* Algoritmo 8.5. Anyadir un elemento al final de un archivo



* Fecha: 1/9/2005
*)

uses ™rtY

var
i X integerY
begin
™lrs™rY
writelnY
writeln@'*****'AY
writeln@'***** Algoritmo 8.5. Anyadir un elemento al final de un archivo *****'AY
writeln@'*****'AY
writelnY
reset@—AY
writelnY
write@'Introduzca un dato entero para anyadir al final del fichero: 'AY
readln@iAY
seek@—D pileƒize @—AAY
write@—D iAY
™lose@—AY
writelnY
writeln@'Fichero 'D nom˜repi™hD ' actualizado'AY
writelnY
readln
endF
¦
¥


ejercicios-resueltos-en-pascal

Más contenido relacionado

La actualidad más candente (20)

Similar a ejercicios-resueltos-en-pascal (20)

Último (20)

ejercicios-resueltos-en-pascal