Programozás‎ > ‎Feladatok‎ > ‎Pályázatok‎ > ‎Megoldás‎ > ‎

lb_palyazat.pas

Letöltés: lb_palyazat.pas

{$R+}
PROGRAM palyazat;
USES crt;
VAR
    n,kih: INTEGER; //munkak szama, osszesen kihagyando munkak szama
    ossz: LONGINT;  //osszhaszon
    h,p,rend: ARRAY [1..10000] OF INTEGER;  //hatarido, kapott osszeg, rendezett munkak sorszamai
    ki: ARRAY [0..10000] OF INTEGER;    //adott napig levo munkak szama, adott napig kihagyando munkak szama
    dolg: ARRAY [1..10000] OF BOOLEAN;  //adott szamu munkat megcsinaljuk-e
 
PROCEDURE beolvas(mit: STRING);
    VAR
        f: TEXT;
        i: INTEGER;
    BEGIN
        ASSIGN(f,mit);
        RESET(f);
        READLN(f,n);
        FOR i:=1 TO n DO
            BEGIN
                dolg[i]:=FALSE;
                READ(f,h[i]);
                READ(f,p[i]);
            END;
        CLOSE(f);
    END;
 
PROCEDURE kihagyas;
    VAR
        mu,i,j: INTEGER;
    BEGIN
        mu:=0;
        kih:=0;
        FOR i:=1 TO n DO
            BEGIN
                FOR j:=1 TO n DO
                    BEGIN
                        IF (h[j]=i) THEN
                            BEGIN
                                mu:=mu+1;
                            END;
                    END;
                    ki[i]:=mu-i;
                    IF ki[i]<0 THEN ki[i]:=0;
                    IF ((mu-i)>kih) THEN
                        BEGIN
                            kih:=mu-i;
                        END;
            END;
        WRITELN(kih);
    END;
 
PROCEDURE rendez;
    VAR
        i,j,ma,mm,mc,rsz: INTEGER;  //ciklusvaltozok, maximum, maxok szama, el-nem erendo max, sorszam
        sm: ARRAY [1..10000] OF INTEGER;    //maxok sorszamai tombbe gyujtve
    BEGIN
        ma:=0;
        mm:=0;
        mc:=10001;
        rsz:=0;
        FOR i:=1 TO n DO
            BEGIN
                FOR j:=1 TO n DO
                    BEGIN
                        IF ((h[i]>ma) AND (h[i]<mc)) THEN
                            BEGIN
                                ma:=h[i];
                                mm:=1;
                                sm[1]:=i;
                            END ELSE BEGIN
                                IF h[i]=ma THEN
                                    BEGIN
                                        mm:=mm+1;
                                        sm[mm]:=j;
                                    END;
                            END;
                        
                    END;
                mc:=ma;
                FOR j:=1 TO mm DO
                    BEGIN
                        rsz:=rsz+1;
                        rend[rsz]:=sm[j];
                    END;
                ma:=0;
                mm:=0;
            END;
    END;
 
PROCEDURE megold;
    VAR
        i,j,ma{,sm}: INTEGER;
    BEGIN
        i:=1;
        WHILE (i<n) DO
            BEGIN
                j:=1;
                ma:=0;
                //sm:=0;
                WHILE (rend[i]=rend[i+j]) DO
                    BEGIN
                        IF p[rend[i+j]]>ma THEN
                            BEGIN
                                //sm:=rend[i+j];
                                ma:=p[rend[i+j]];
                            END;
                        j:=j+1;
                    END;
                ossz:=ossz+ma;
                i:=i+j;
            END;
        WRITELN(ossz);
    END;
 
PROCEDURE moho;
    VAR
        i,j,m,sm: INTEGER;
        f: TEXT;
    BEGIN
        ossz:=0;
        ASSIGN(f,'debug.txt');
        REWRITE(f);
        FOR i:=10000 DOWNTO 1 DO
            BEGIN
                m:=0;
                sm:=0;
                FOR j:=1 TO n DO
                    BEGIN
                        IF ((h[j]>=i) AND ((p[j]>m) AND NOT(dolg[j]))) THEN
                            BEGIN
                                m:=p[j];
                                sm:=j;
                            END;
                    END;
                WRITELN(f,'sm:' ,sm,'  m: ',m);
                IF sm>0 THEN
                    BEGIN
                        j:=sm;
                        WHILE dolg[j] DO
                            BEGIN
                                j:=j-1;
                            END;
                        dolg[j]:=TRUE;
                    END;
                ossz:=ossz+m;
            END;
        WRITELN(ossz);
        WRITELN(f,ossz);CLOSE(f);
    END;
 
PROCEDURE foprogram;
    BEGIN
        beolvas('utemez2.be');
        kihagyas;
        //rendez; megold;
        moho;
    END;
 
BEGIN
    foprogram;
END.