troubleshooting Question

CONVERSION OF PASCAL TO C

Avatar of reachganesh
reachganesh asked on
Pascal
9 Comments2 Solutions2357 ViewsLast Modified:
hi there
I have got some codes that need to be converted into c.I have good knowledge in c but this seems to be a difficult task since I donno anything in pascal.I will post the code here ,pls have look at it and send the converted.I thinks it is not a tough task for a person who has good knowledge in c and pascal.Pls reply ASAP.I have got 15 more files like this ,but if i get some basic idea I think i can work on the rest.thanks in advance



unit allint;
interface
uses crt,dos,printer,lpvars,stackm;

procedure AllIntegerGomory;

implementation

var linecnt : integer;

  Procedure CheckScreenFull;
    begin
      if Textoutputdestination <> 'S' then exit;
      if linecnt >= 22 then begin
        { Window(1,24,80,25);}
        writeln(outf);
        gotoxy(1,24);
        write(outf,'                 Any key to continue, Esc to abort program.');
        ch:=readkey;
        if ch=#27 then begin
          {Window(1,1,80,25);}
          UserInterrupt;
        end;
        {window(1,1,80,22);}
        clrscr;
        linecnt := 0;
      end;
    end;{procedure checkFullScreen}
procedure allintegerGomory;
  {allinteger data}
  {zBoundFound:boolean indicates whether user has provided bound}
  {zBound:real is the user value -- 0 if zBoundFound is False}
CONST
  TableauField = 9;
  Spaces = '                    ';
  numtableaufields = 9;
VAR
  HB : ARRAY[0..MaxConstraints] of real;
  LPLabels : ARRAY[0..MaxVars] of String[TableauField];
  I, N, N1, M, Minit : INTEGER;
  NOFEAS : BOOLEAN;
  PRINTINFOR : BOOLEAN;
  NumberVar1, NV, COUNT : INTEGER; ch : char;
  sum : real;
  errmsg:string[80];


procedure PrintTableau;

var i,j,k,l :integer;
    more : boolean;
begin
  writeln(outf);
  writeln(outf,'Iteration: ',count:5);
  writeln(outf);
  for i := 0 to  M do
  begin
    L := 1; k := numTableaufields ; if k > N then k := N;
    repeat
      for j := L to k do write(outf,' ',A^[i,j]:5:0);
      if k < N then writeln(outf)
               else if i <> 0 then
               writeln(outf,'  <= ',A^[i,N1]:5:0)
               else begin
                 writeln(outf,' obj ',A^[i,N1]:5:0);
                 for j := 1 to (k*6 + 10) do write(outf,'-');
                 writeln(outf);
               end;
      if k < N then begin
        more := true;
        L := k+1; k := (k + NumTableauFields);
        if k > N then k := N;
      end  else more := false;
    until not more;

  end; {for i }
    IF (TextOutputDestination='S')  then
    begin
      writeln;writeln; writeln('Press any key to continue ... ESC to exit');
      ch:=ReadKey;
      if ch = #27 then UserInterrupt;
    end;

end;{procedure printtableaux}

FUNCTION GetFunction(l:integer):real;
Begin
  PushArgument;
  CurArgument := FncRec[l].Arg;
  GetFunction := StackMachine( FncRec[l].CodeStream );
  PopArgument;
End;

PROCEDURE CreateLpLabel(i:integer);
VAR kf,kr,l,m,n:integer;
Begin
  n:=TableauField -1;
  l := Length(SymTab[Variables[i]].lexeme);
  IF l>= (n-1) THEN
    Begin
      m:= n-1; kf:=1;kr:=0;
    End
  ELSE
    Begin
      m := l; kf := ((n- l)DIV 2);kr:=n-l-kf;
      if kr > kf then
        begin
          n:=kr;kr:=kf;kr:=n;
        end;
    End;
  LpLabels[i] := Copy(Spaces,1,kf) + Copy(SymTab[Variables[i]].lexeme,1,m)
                 + Copy(Spaces,1,kr);
End;


PROCEDURE ALLintegerALG;

VAR  C, DENUM,I,J,K,L,NP,NUM,R,R1,S,T : INTEGER;
     kprt,lprt,jprt : integer;
     B, ITER : BOOLEAN;

  FUNCTION EUCLID(U,V :INTEGER):INTEGER;
  VAR W : INTEGER;
  BEGIN
    W := U DIV V;
    IF W*V > U THEN W := W - 1;
    IF (W+1)*V <= U THEN W := W + 1;
    EUCLID := W;
  END; {END OF EUCLID}

BEGIN
  COUNT := 0;
  NP := N + 1;
  if choicetableaux <> 'N' then printtableau;
  REPEAT
    if checkesckey then begin
        writeln; writeln;
        writeln('Algorithm completed iteration ',count:5);
        writeln('Note: this method is not feasible until optimal');
        UserInterrupt;
      end;
    COUNT := COUNT + 1;
    R := 0;
    REPEAT
      R := R + 1;
      ITER := A^[R,NP] < 0;
    UNTIL ITER OR (R=M);
    IF ITER THEN
    BEGIN
      K := 0;
      REPEAT
        K := K + 1;
        ITER := A^[R,K] < 0;
      UNTIL ITER OR (K = N);
      NOFEAS := NOT ITER;
      IF ITER THEN
      BEGIN
        L := K;
        FOR J := K + 1 TO N DO
          IF A^[R,J] < 0 THEN
            BEGIN
              I := -1;
              REPEAT
                I := I + 1;
                S := trunc(A^[I,J] - A^[I,L]);
              UNTIL S <> 0;
              IF S < 0 THEN L := J;
            END; {IF A^[R,J] < 0 }
          S := 0;
          WHILE A^[S,L] = 0 DO S := S + 1;
          NUM := - trunc(A^[R,L]);
          DENUM := 1;
          FOR J := 1 TO N DO
            IF (A^[R,J] < 0) AND (J<>L) THEN
            BEGIN
              I := S -1;
              B := TRUE;
              WHILE B AND (I >= 0) DO
              BEGIN
                B := A^[I,J] < 0;
                I := I-1;
              END;
              IF B THEN
              BEGIN
                I := trunc(A^[S,J]);
                R1 := trunc(A^[S,L]);
                T := EUCLID(I,R1);
                IF (T*R1 = I) AND (T > 1 ) THEN
                BEGIN
                  I := S;
                  REPEAT
                    I := I + 1;
                    R1 := trunc(T*A^[I,L] - A^[I,J]);
                  UNTIL R1 <> 0;
                  IF R1 > 0 THEN T := T -1;
                END; { IF T }
                C := -trunc(A^[R,J]);
                 IF C*DENUM > T*NUM THEN
                 BEGIN
                   NUM := C;
                   DENUM := T;
                 END;
              END; { IF B }
            END; { FOR J AND IF  }
         writeln;
         writeln(outf,' cut row is ',r:3,'   pivot coln is ',L:3);

         lprt := 1; kprt := numTableaufields ; if kprt > NP then kprt := NP;
         for jprt := 1 to ((kprt-1)*6 + 10) do write(outf,'-');
         writeln(outf);
         FOR J := 1 TO NP DO
           IF J <> L THEN
           BEGIN
             C := EUCLID(trunc(A^[R,J])*DENUM, NUM);
             if J <> NP then write(outf,c:6)
             else  write(outf,'  <= ',c:5);
           END ELSE
             write(outf,'    -1');
         writeln;
         {writeln(outf,'--------------------------------');}
         for jprt := 1 to ((kprt-1)*6 + 10) do write(outf,'-');
         writeln(outf);

         FOR J := 1 TO NP DO
           IF J <> L THEN
           BEGIN
             C := EUCLID(trunc(A^[R,J])*DENUM, NUM);
             IF C <> 0 THEN
               FOR I := 0 TO M DO
                 A^[I,J] := A^[I,J] + C*A^[I,L];
           END;
      END; {ITER}
    END; { IF ITER }
  if choicetableaux = 'A' then printtableau;
  UNTIL NOT ITER OR NOFEAS;
  if choicetableaux = 'F' then printtableau;
END;  {END OF PROCEDURE ALLINTEGERALG }

Procedure SETUPALLINTEGER;
VAR
  n,i,j,k,l : integer;   y,t,t0,t1,temp:real;
  s:string[10];
Begin
  IF Not TableInput then begin
    New(A);
    New(Argument);
    New(ArgStack); ArgStack^.OldArgument:=nil; ArgStack^.next:=nil;
    CurArgument := nil;
    For i:= 0 to NumConstraints do FncRec[i].Arg := Argument;
  end; {if not tableinput}
  Begin {linear}
   CreateLpLabel(0);
   For i:= 1 to NumVars do
     begin
       if not tableinput then Argument^[i]:=0;
       CreateLpLabel(i);
     end;

   k:=-1;
   For i:= 0 to NumConstraints do
     Begin
       k:=k+1;
       For j:= 1 to NumVars Do
         Begin
           if TableInput then begin
              y := trunc(A^[k,j]);
              if y <> A^[k,j] then  begin
                str(A^[k,j]:9:3,errmsg);
                str(k:4,s);
                errmsg := 'Coefficient of '+ SymTab[Variables[j]].lexeme+' = ' + errmsg;
                errmsg := errmsg + ' is not integer-valued in row '+s+'.';
                ERROR(Errmsg);
              end;
           end else begin
             Argument^[j] := 2; t:= GetFunction(i);
             Argument^[j] := 1;
             y := t - GetFunction(i);
             A^[k,j] :=trunc( y);
             if y <> A^[k,j] then begin
                str(y:9:3,errmsg);
                str(k:4,s);
                errmsg := 'Coefficient of '+SymTab[Variables[j]].lexeme+' = ' + errmsg;
                errmsg := errmsg + ' is not integer-valued in row '+s+'.';
                ERROR(Errmsg);
           end;
           Argument^[j]:=0;
           end;
           if (i = 0) and (optimize = 1) then
              A^[i,j] := - A^[i,j]; {minimize only}
         End;
     End;
   NV := NumVars;
   End; {Linear part}

  If TableInput Then HB[0] := Rhs[0]
  Else HB[0]:=GetFunction(0);
  Inequalities[0]:=0;
  A^[0,n1] := trunc(HB[0] );
  k:=0;  NumberVar1 := NumVars + 1;
  For i := 1 to NumConstraints do
    Begin
      k:= k + 1;
      A^[k,0] := 0;
      If TableInput then HB[k] := Rhs[i]
      Else HB[k] := Rhs[i] - GetFunction(i);
      A^[k,NumberVar1] := trunc(HB[k]);
      if HB[k] <> A^[k,NumberVar1] then begin
         str(Hb[k]:9:3,errmsg);str(k:4,s);
         Errmsg := 'RHS = '+ Errmsg +' is not integer-valued in row '+s+'.';
         ERROR(Errmsg);
      end;
      IF Inequalities[i] = 2 THEN
          for j := 1 to (NumberVar1) Do  A^[i,j] := -A^[i,j];
      if Inequalities[i] = 3 then
        error('Equality Constraints Not Allowed In All Integer Algorithm.');
    End;
{add -x sub i <= 0 constraints}
  k := NumConstraints;
  For i := 1 to NumVars Do
    begin
      k := k + 1;
      for j := 1 to NumberVar1 Do A^[k,j] := 0;
      A^[k,i] := -1;
    end; {for i}
{end of add }
  count := 0;
  if choicetableaux = 'A' then begin
    writeln(outf);
    writeln(outf,'Initial tableau with - x <= 0 constraints added ');
    printtableau;
  end;
{check for dual feasible}
  t0 := 0; k := 0;
  for i := 1 to Nv do if A^[0,i] < t0 then
    begin
      t0 := A^[0,i]; k := i;
    end;

  if t0 < 0 then begin {adjustment necessary}
      M := M +1; Minit := Minit + 1;
      for i := M downto 2 Do
        for j := 1 to N1 do
          A^[i,j] := A^[i-1,j];
      for i := 1 to N1 do A^[1,i] := 1;

      A^[1,N1] := trunc(VarBound);
 if choicetableaux = 'A' then begin
    writeln(outf);
    writeln(outf,'Bound on Sum Constraint Added as First Constraint');
    printtableau;
    writeln(outf);
    writeln(outf,'Inversion-In-Place Pivot on Column ',k:3,' Row 1 is necessary');
  end;
     for i := 0 to M do begin
       if i <>1 then begin
         for j := 1 to N1 do
           if j <> k then
             A^[i,j] := A^[i,j] - A^[1,j]*A^[i,k];{pivot = 1}
       end;
     end; {for i}

     for j := 2 to M do A^[j,k] := -A^[j,k];
     A^[0,k] := -A^[0,k];
    end;
  {end of adjustment}
(*
  IF NumberVar1 +1 >= MaxFields THEN LinCols := tableauField*(MaxFields)
  ELSE LinCols:=  TableauField*(NumberVar1+1);
  eqs:=''; dsh:='';
  For i:= 1 to LinCols do
    Begin
      eqs := eqs + '='; dsh := dsh + '-';
    End;
*)
count := 0;
End; {procedure SetupAllInteger}

BEGIN  {MAIN Procedure SetupALLInteger}
{   SETUP PROGRAM DATA   }
{
  PROBLEM STANDARD FORM IS:
    MIN Z = AI 0.j'X st AI X <= AI.,N+1 , -X <= 0 IN ALLINTEGER
}
  writeln(outf);writeln(outf,'Gomory Dual All-Integer Algorithm');
N := NumVars;
Minit := NumConstraints;
M := Minit + N;  N1 := N + 1;
if N > MaxVars then ERROR('All Integer Problem Has Too Many Variables.');
if M > MaxConstraints then ERROR('All Integer Problem Has Too Many Constraints.');
if not Varboundfound then
        Error('<BOUNDonSUM = value> is missing.');
if not IsAllInteger then ERROR('All integer required.');
SETUPALLINTEGER;

ALLINTEGERALG;
IF NOFEAS THEN
  BEGIN
    writeln(outf,'NO FEASIBLE SOLUTION' );
  END
ELSE {SOLUTION FOUND}
  BEGIN
    clrscr;
    WRITELN(outf);
    WRITELN(outf,'OPTIMAL ALL INTEGER SOLUTION ');
    writeln(outf);
    if optimize = 1 then
       WRITELN(outf,LPLabels[0], ' = ', A^[0,N1]:10:0)
       else  WRITELN(outf,LPLabels[0], ' = ',-A^[0,N1]:10:0);
    WRITELN(outf);
    linecnt := 5;
    sum := 0;
    FOR I := 1 TO N DO begin
      WRITELN(outf,LPLabels[i], ' = ',A^[Minit+I,N1]:10:0);
      linecnt := linecnt + 1; CheckScreenFull;
      sum := sum + A^[Minit+i,N1];
    end;
    writeln(outf);
    WRITELN(outf,' NUMBER OF DUAL PIVOTS IS ',COUNT:4);
    linecnt := linecnt + 2; CheckScreenFull;
    if varboundfound then
      if sum >= varbound then begin
        writeln(outf);
        writeln(outf,'Caution: Variable Sum: ',sum:7:0,
                ' >= VarBound Value: ',VarBound:7:0);
      end;
  END;
end; {end of allintegerGomory}

begin
end.
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 2 Answers and 9 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 9 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros