Pascal es un lenguaje de programación de alto nivel de propósito general; esto es, se puede utilizar para escribir programas para fines científicos y comerciales.
El lenguaje de programación Pascal fue desarrollado por el profesor Niklaus (Nicolás) Wirth en Zurich, Zuiza, al final de los años 1960s y principios de los 70s. Wirth diseñó este lenguaje para que fuese un buen primer lenguaje de programación para personas comenzando a aprender a programar. Pascal tiene un número relativamente pequeño de conceptos para aprender y dominar. Su diseño facilita escribir programas usando un estilo que está generalmente aceptado como práctica estándar de programación buena. Otra de las metas del diseño de Wirth era la implementación fácil. Él diseñó un lenguaje para el cual fuese fácil escribir un compilador para un nuevo tipo de computadora.
program Sorting;
{
Este programa lee un natural y una secuencia de N caracteres de la entrada estandar; construye un indice para ordenarlos de menor a mayor e imprime en la salida la secuencia ordenada.
}
uses CRT;
Const Max = 10;
Espacio = ' ';
Enter = chr (13);
type Indice = 1..Max;
Cantidad= 0..Max;
SecOfChar = record
elems : array [Indice] of char;
ult : Cantidad;
end;
SecOfInd = record
elems : array [Indice] of Indice;
ult : Cantidad;
end;
Natural = 0..MaxInt;
function PosMin (idx: SecOfInd; i: Indice; s: SecOfChar): Cantidad;
{ Devuelve la posicion en el indice idx del menor caracter en s, para
las posiciones >= i. }
var j: Indice;
pm: Cantidad;
begin
if i > idx.ult then
pm := 0
else begin
pm := i;
for j := i+1 to idx.ult do
if s.elems[idx.elems[j]] < s.elems[idx.elems[pm]] then
pm := j;
end;
PosMin := pm;
end;
procedure Swap (var idx: SecOfInd; i,j: Indice);
{ Intercambia las posiciones i j en idx. }
var tmp: Indice;
begin
if (i<=idx.ult) and (j<=idx.ult) then begin
tmp := idx.elems[i];
idx.elems[i] := idx.elems[j];
idx.elems[j] := tmp;
end;
end;
procedure InicInds (var idx: SecOfInd; cant: Indice);
{ Construye la secuencia de indices 1,2,3,...,n. Sera el indice
inicial para el ordenamiento de una secuencia de caracteres
c1,c2,...,cn. }
var n: Natural;
begin
n := cant;
idx.ult := n;
while n > 0 do begin
idx.elems [n] := n;
n := n-1;
end;
end;
procedure InicSecChar (var s: SecOfChar);
{ Devuelve la secuencia vacia. }
begin
s.ult := 0;
end;
function Llena (s: SecOfChar): Boolean;
begin
Llena := s.ult = Max;
end;
{ PRE: not Llena(s) }
procedure InsCar (var s: SecOfChar; c: char);
{ Inserta el caracter c en la secuencia s }
begin
s.ult := s.ult + 1;
s.elems [s.ult] := c;
end;
procedure IndSelSort (s: SecOfChar; var ind: SecOfInd);
{ Construye el indice que ordena la secuencia s. Ordena el indice
inicial 1,2, ..., n por el metodo de selection sort }
var i: Indice;
begin
InicInds (ind, s.ult);
for i := 1 to ind.ult-1 do begin
Swap (ind, i, PosMin (ind, i, s));
end
end;
procedure WriteSorted (idx: SecOfInd; s: SecOfChar);
{ Imprime en la salida estandar la secuencia s ordenada segun el
indice idx }
var i: Indice;
begin
write ('Ordenado: ');
for i := 1 to idx.ult do
write (s.elems[idx.elems[i]],' ');
writeln;
end;
procedure LeerCar (var c: char; var ok: boolean; sep: Char);
{ Lee de la entrada estandar un caracter seguido del caracter sep }
var c1, c2: char;
begin
c := ReadKey; write (c);
c1 := ReadKey; write (c1);
ok := c1 = sep;
end;
procedure LeerSecOfChar (var s: SecOfChar; cant: Natural; var ok: Boolean);
{ Construye una secuencia de cant caracteres provistos por el
procedimeinto LeerCar. Si cant > Max trunca. }
var bien: Boolean;
i: Natural;
ch, sep: Char;
begin
writeln ('Ingrese ',cant, ' caracteres separados por blancos. Enter para terminar ');
write (' > ');
InicSecChar (s);
i := 1;
ok := true;
sep := Espacio;
while ok and (i <= cant) and not Llena (s) do begin
if i = cant then sep := Enter;
LeerCar (ch, bien, sep);
i := i+1;
ok := ok and bien;
if ok then
InsCar (s, ch);
end;
end;
procedure LeerCant (var n: Natural);
{ Lee de la entrada estandar un natural <= Max }
begin
repeat
writeln ('Ingrese cantidad de caracteres (<=',Max,')');
write (' > ');
readln (n);
until n <= Max;
end;
procedure Continuar (var seguir: Boolean);
var car: Char;
begin
writeln;
writeln ('Otro ? (s/n)');
write (' > ');
car := ReadKey;
writeln (car);
seguir := car in ['s','S'];
end;
var cant: Natural;
cars: SecOfChar;
inds: SecOfInd;
seguir, ok: boolean;
begin
repeat
ClrScr;
LeerCant (cant);
LeerSecOfChar (cars, cant, ok);
if ok then begin
IndSelSort (cars, inds);
writeln;
WriteSorted (inds, cars);
end
else begin
writeln;
writeln ('Error en los datos');
end;
Continuar (seguir);
