Caja de Bombones

1. Se dice que una caja de bombones es aburrida si la mitad más uno de ellos son del
mismo tipo. Codifique la siguiente función que indica si una caja de bombones es
aburrida o no. Se sabe que TCajaBombon está definido como
TCajaBombon =ARRAY [1..n] OF TBombon
Function aburrida (protected VAR caja:TCajaBombon;
n:integer):Boolean;



PROGRAM cajabomb (input,output);
        TYPE
             TBombon = string(50);
             TCajaBombon = ARRAY [1..50] OF TBombon;
        VAR
            Bombon:TCajaBombon;
            c:char;
            n:integer;
            buleano:boolean;
           
        PROCEDURE llenar;
                  VAR
                     i:integer;
                     Opcion:char;
                  BEGIN
                       Write('¿De cuantos bombones se compone la caja?: ');
                       Readln(n);
                       FOR i:=1 TO n DO
                           BEGIN
                                Writeln('De que es el ',i:0,' bombon?: ');
                                REPEAT
                                Writeln('[A] Avellanas');
                                Writeln('[C] Chocolate');
                                Writeln('[P] Pistachos');
                                Writeln('[G] Galletas');
                                Readln(Opcion);
                                CASE Opcion OF
                                     'A','a': Bombon[i]:='Avellanas';
                                     'C','c': Bombon[i]:='Chocolate';
                                     'P','p': Bombon[i]:='Pistachos';
                                     'G','g': Bombon[i]:='Galletas';
                                OTHERWISE
                                         Writeln('Opcion no valida, elija otra.');
                                END;
                                UNTIL (Opcion='a') OR (Opcion='A') OR (Opcion='c') OR (Opcion='C') OR (Opcion='P') OR (Opcion='p') OR (Opcion='G') OR (Opcion='g');
                           END;
                  END;
(******************************************************************************)
PROCEDURE control;
          BEGIN
               IF n MOD (2) =1 THEN
                  n:=n+1;
          END;
 (*****************************************************************************)                
        FUNCTION aburrida (PROTECTED VAR Bombon:TCajaBombon):boolean;
                 VAR
                    i:integer;
                    j:integer;
                    contador:integer;
                    resultado:boolean;
                 BEGIN
                      Resultado:=FALSE;
                      contador:=0;
                      i:=1;
                      WHILE i<=n DO
                          BEGIN
                               contador:=0;
                               FOR j:=1 TO n DO
                                   BEGIN
                                        IF (Bombon[i] = Bombon[j]) THEN
                                           BEGIN
                                                contador:=1 +contador;
                                                IF contador>n/2 THEN
                                                   BEGIN
                                                        i:=n+1;
                                                        resultado:=TRUE;
                                                   END;
                                           END
                                        ELSE
                                            contador:=contador;
                                    END;
                                i:=i+1;  
                        END;
                    aburrida:=resultado;
                 END;
                     
(******************************************************************************)                              
        PROCEDURE iniciar;
                  BEGIN
                  REPEAT
                  llenar;
                  control;
                  buleano:=aburrida(Bombon);
                  IF buleano = TRUE THEN
                     Writeln('La caja de bombones es aburrida...')
                  ELSE
                       Writeln('La caja de bombones no es aburrida');
                  UNTIL n = 199;
                  END;
        BEGIN
             iniciar;
        END.

Ejemplo de ejecucion: