Los lenguajes de programación informática - Pascal

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