Recent

Author Topic: Remove goto from procedure  (Read 5910 times)

user07022024

  • New Member
  • *
  • Posts: 13
Remove goto from procedure
« on: February 07, 2024, 10:05:24 am »
Code: Pascal  [Select][+][-]
  1. procedure hqr(var a:TArray2D;n:integer;var wr,wi: TArray1D);
  2. label 2,3,4;
  3. var
  4.    nn,m,l,k,j,its,i,mmin:integer;
  5.    z,y,x,w,v,u,t,s,r,q,p,anorm:TElem;
  6. begin
  7.    anorm := abs(a[1,1]);
  8.    for i := 2 to n do
  9.        for j := i-1 to n do
  10.           anorm := anorm + abs(a[i,j]);
  11.           nn := n;
  12.           t := 0;
  13.           while nn >= 1 do
  14.           begin
  15.             its := 0;
  16.        2:   for l := nn downto 2 do
  17.             begin
  18.               s:= abs(a[l-1,l-1])+abs(a[l,l]);
  19.               if s = 0.0 then
  20.                  s := anorm;
  21.               if abs(a[l,l-1])+s = s then
  22.                   goto 3
  23.             end;
  24.             l := 1;
  25.        3:   x := a[nn,nn];
  26.        if l = nn then
  27.        begin
  28.          wr[nn] := x + t;
  29.          wi[nn] := 0.0;
  30.          nn := nn-1
  31.        end
  32.        else
  33.        begin
  34.           y := a[nn-1,nn-1];
  35.           w := a[nn,nn-1]*a[nn-1,nn];
  36.           if l = nn-1 then
  37.           begin
  38.             p := 0.5*(y-x);
  39.             q := sqr(p)+w;
  40.             z := sqrt(abs(q));
  41.             x := x + t;
  42.             if q >= 0.0 then
  43.             begin
  44.               z := p + sign(z,p);
  45.               wr[nn] := x + z;
  46.               wr[nn-1] := wr[nn];
  47.               if z <> 0.0 then
  48.                  wr[nn] := x - w/z;
  49.                  wi[nn] := 0.0;
  50.                  wi[nn] := 0.0
  51.                end  
  52.                else
  53.                begin
  54.                  wr[nn] := x + p;
  55.                  wr[nn-1] := wr[nn];
  56.                  wi[nn] := z;
  57.                  wi[nn-1] := -z
  58.                end;
  59.                nn := nn-2
  60.              end
  61.              else
  62.              begin
  63.                if its = 30 then
  64.                begin
  65.                  writeln('pause in routine HQR');
  66.                  writeln('too many iterations') ;
  67.                  readln;
  68.                end;
  69.                if (its = 10) or (its = 20) then
  70.                begin
  71.                  t := t + x;
  72.                  for i := 1 to nn do
  73.                      a[i,i] := a[i,i] - x;
  74.                  s := abs(a[nn,nn-1])+abs(a[nn-1,nn-2]);
  75.                  x := 0.75*s;
  76.                  y := x;
  77.                  w := -0.4375*sqr(s)
  78.                end;
  79.                its := its + 1;
  80.                for m := nn-2 downto l do
  81.                begin
  82.                  z := a[m,m];
  83.                  r := x - z;
  84.                  s := y - z;
  85.                  p := (r*s-w)/a[m+1,m]+a[m,m+1];
  86.                  q := a[m+1,m+1] - z - r - s;
  87.                  r := a[m+2,m+1];
  88.                  s := abs(p) + abs(q) + abs(r);
  89.                  p := p/s;
  90.                  q := q/s;
  91.                  r := r/s;
  92.                  if m = l then goto 4;
  93.                  u := abs(a[m,m-1])*(abs(q)+abs(r));
  94.                  v := abs(p) * (abs(a[m-1,m-1]) + abs(z) + abs(a[m+1,m+1]));
  95.                  if u+v = v then goto 4
  96.                end;
  97.            4:  for i := m+2 to nn do
  98.                begin
  99.                  a[i,i-2] := 0;
  100.                  if i <> m+2 then
  101.                     a[i,i-3] := 0.0
  102.                end;
  103.                for k := m to nn-1 do
  104.                begin
  105.                  if k <> m then
  106.                  begin
  107.                      p := a[k,k-1];
  108.                      q := a[k+1,k-1];
  109.                      if k <> nn-1 then
  110.                         r := a[k+2,k-1]
  111.                      else
  112.                         r := 0.0;
  113.                      x := abs(p) + abs(q) + abs(r);
  114.                      if x <> 0.0 then
  115.                      begin
  116.                        p := p/x;
  117.                        q := q/x;
  118.                        r := r/x;
  119.                      end
  120.                   end;
  121.                   s := sign(sqrt(sqr(p) + sqr(q) + sqr(r)),p);
  122.                   if s <> 0.0 then
  123.                   begin
  124.                     if k = m then
  125.                     begin
  126.                       if l <> m then
  127.                         a[k,k-1] := -a[k,k-1];
  128.                       end
  129.                       else
  130.                          a[k,k-1] := -s*x;
  131.                       p := p+s;
  132.                       x := p/s;
  133.                       y := q/s;
  134.                       z := r/s;
  135.                       q := q/p;
  136.                       r := r/p;
  137.                       for j := k to nn do
  138.                       begin
  139.                         p := a[k,j]+q*a[k+1,j];
  140.                         if k <> nn-1 then
  141.                         begin
  142.                           p := p + r * a[k+2,j];
  143.                           a[k+2,j] := a[k+2,j] - p*z
  144.                         end;
  145.                         a[k+1,j] := a[k+1,j]   - p*y;
  146.                         a[k,j] := a[k,j] -p*x
  147.                       end;
  148.                       mmin := min(nn,k+3);
  149.                       for i := l to mmin do
  150.                       begin
  151.                         p := x * a[i,k]+y*a[i,k+1];
  152.                         if k <> nn-1 then
  153.                         begin
  154.                           p := p + z *a[i,k+2];
  155.                           a[i,k+2] := a[i,k+2] - p*r
  156.                         end;
  157.                         a[i,k+1] := a[i,k+1] - p*q;
  158.                         a[i,k] := a[i,k] - p
  159.                       end
  160.                     end
  161.                   end;
  162.                   goto 2
  163.                 end
  164.               end
  165.             end    
  166. end;
  167.  

I found this procedure in Numerical recipes in Pascal
(Press , Teukolsky and others)
and I would like to remove labels

I tried to replace  labels  myself by
modyfing loops and introducing some boolean variables
 I received behavior similar to infinite loop
after playing with these labels




alpine

  • Hero Member
  • *****
  • Posts: 1349
Re: Remove goto from procedure
« Reply #1 on: February 07, 2024, 10:19:17 am »
Are break, continue allowed?
"I'm sorry Dave, I'm afraid I can't do that."
—HAL 9000

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Remove goto from procedure
« Reply #2 on: February 07, 2024, 10:33:31 am »
TBH I suggest to rewrite from scratch and use way better variable names.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

user07022024

  • New Member
  • *
  • Posts: 13
Re: Remove goto from procedure
« Reply #3 on: February 07, 2024, 10:34:23 am »
Are not  preferred but if there are no other ideas they may be

alpine

  • Hero Member
  • *****
  • Posts: 1349
Re: Remove goto from procedure
« Reply #4 on: February 07, 2024, 10:35:48 am »
TBH I suggest to rewrite from scratch and use way better variable names.
Yeah, the indentation is quite bad also.
"I'm sorry Dave, I'm afraid I can't do that."
—HAL 9000

Zvoni

  • Hero Member
  • *****
  • Posts: 2844
Re: Remove goto from procedure
« Reply #5 on: February 07, 2024, 10:51:49 am »
TBH I suggest to rewrite from scratch and use way better variable names.
Yeah, the indentation is quite bad also.
Yeah, just looking at his Line 9 i'm not sure he is aware that only line 10 gets executed in that For-Loop.

This looks like a "direct" port from some convoluted C-Code
I'd probably go with nested Procedures/Functions to "remove" the Labels

Next: His "Begin" in Line 14 "ends" in Line 165

that's just on first look
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad

Josh

  • Hero Member
  • *****
  • Posts: 1361
Re: Remove goto from procedure
« Reply #6 on: February 07, 2024, 11:14:22 am »
i would suggested putting the goto blockcode into nested procs; with a check to make sure things are not run twice where required.

personally i agree it needs recoding, not analyzed so no idea what it does, but its 'ugly' code. i dont see much error checking for div 0, etc.

something like.... not tested

Code: Pascal  [Select][+][-]
  1. procedure hqr(var a:TArray2D;n:integer;var wr,wi: TArray1D);
  2.  
  3.   procedure proc2;forward;
  4.   procedure proc3;forward;
  5.   procedure proc4;forward;
  6.  
  7. var
  8.    nn,m,l,k,j,its,i,mmin:integer;
  9.    z,y,x,w,v,u,t,s,r,q,p,anorm:TElem;
  10.  
  11.  
  12. procedure proc2;
  13. var b3:boolean=false;
  14. begin
  15.    for l := nn downto 2 do
  16.    begin
  17.      s:= abs(a[l-1,l-1])+abs(a[l,l]);
  18.      if s = 0.0 then s := anorm;
  19.      if abs(a[l,l-1])+s = s then
  20.      begin
  21.        b3:=true;
  22.        proc3
  23.      end;
  24.    end;
  25.    if not b3 then l := 1;
  26. end;
  27.  
  28. procedure proc3;
  29. var b4:boolean=false;
  30. begin
  31.   x := a[nn,nn];
  32.   if l = nn then
  33.   begin
  34.     wr[nn] := x + t;
  35.     wi[nn] := 0.0;
  36.     nn := nn-1
  37.   end
  38.   else
  39.   begin
  40.     y := a[nn-1,nn-1];
  41.     w := a[nn,nn-1]*a[nn-1,nn];
  42.     if l = nn-1 then
  43.     begin
  44.       p := 0.5*(y-x);
  45.       q := sqr(p)+w;
  46.       z := sqrt(abs(q));
  47.       x := x + t;
  48.       if q >= 0.0 then
  49.       begin
  50.         z := p + sign(z,p);
  51.         wr[nn] := x + z;
  52.         wr[nn-1] := wr[nn];
  53.         if z <> 0.0 then wr[nn] := x - w/z;
  54.         wi[nn] := 0.0;
  55.         wi[nn] := 0.0
  56.       end
  57.       else
  58.       begin
  59.         wr[nn] := x + p;
  60.         wr[nn-1] := wr[nn];
  61.         wi[nn] := z;
  62.         wi[nn-1] := -z
  63.       end;
  64.       nn := nn-2
  65.     end
  66.     else
  67.     begin
  68.       if its = 30 then
  69.       begin
  70.         writeln('pause in routine HQR');
  71.         writeln('too many iterations') ;
  72.         readln;
  73.       end;
  74.       if (its = 10) or (its = 20) then
  75.       begin
  76.         t := t + x;
  77.         for i := 1 to nn do a[i,i] := a[i,i] - x;
  78.         s := abs(a[nn,nn-1])+abs(a[nn-1,nn-2]);
  79.         x := 0.75*s;
  80.         y := x;
  81.         w := -0.4375*sqr(s)
  82.       end;
  83.       its := its + 1;
  84.       for m := nn-2 downto l do
  85.       begin
  86.         z := a[m,m];
  87.         r := x - z;
  88.         s := y - z;
  89.         p := (r*s-w)/a[m+1,m]+a[m,m+1];
  90.         q := a[m+1,m+1] - z - r - s;
  91.         r := a[m+2,m+1];
  92.         s := abs(p) + abs(q) + abs(r);
  93.         p := p/s;
  94.         q := q/s;
  95.         r := r/s;
  96.         if m = l then
  97.         begin
  98.           b4:=true;
  99.           proc4;
  100.         end;
  101.         if not b4 then
  102.         begin
  103.           u := abs(a[m,m-1])*(abs(q)+abs(r));
  104.           v := abs(p) * (abs(a[m-1,m-1]) + abs(z) + abs(a[m+1,m+1]));
  105.           if u+v = v then proc4;
  106.         end;
  107.      end;
  108.     end;
  109.   end;
  110. end;
  111.  
  112. procedure proc4;
  113. begin
  114.   for i := m+2 to nn do
  115.   begin
  116.     a[i,i-2] := 0;
  117.     if i <> m+2 then a[i,i-3] := 0.0
  118.   end;
  119.   for k := m to nn-1 do
  120.   begin
  121.     if k <> m then
  122.     begin
  123.       p := a[k,k-1];
  124.       q := a[k+1,k-1];
  125.       if k <> nn-1 then r := a[k+2,k-1]
  126.       else r := 0.0;
  127.       x := abs(p) + abs(q) + abs(r);
  128.       if x <> 0.0 then
  129.       begin
  130.         p := p/x;
  131.         q := q/x;
  132.         r := r/x;
  133.       end;
  134.     end;
  135.     s := sign(sqrt(sqr(p) + sqr(q) + sqr(r)),p);
  136.     if s <> 0.0 then
  137.     begin
  138.       if k = m then
  139.       begin
  140.         if l <> m then a[k,k-1] := -a[k,k-1];
  141.       end
  142.       else a[k,k-1] := -s*x;
  143.       p := p+s;
  144.       x := p/s;
  145.       y := q/s;
  146.       z := r/s;
  147.       q := q/p;
  148.       r := r/p;
  149.       for j := k to nn do
  150.       begin
  151.         p := a[k,j]+q*a[k+1,j];
  152.         if k <> nn-1 then
  153.         begin
  154.           p := p + r * a[k+2,j];
  155.           a[k+2,j] := a[k+2,j] - p*z
  156.         end;
  157.         a[k+1,j] := a[k+1,j]   - p*y;
  158.         a[k,j] := a[k,j] -p*x
  159.       end;
  160.       mmin := min(nn,k+3);
  161.       for i := l to mmin do
  162.       begin
  163.         p := x * a[i,k]+y*a[i,k+1];
  164.         if k <> nn-1 then
  165.         begin
  166.           p := p + z *a[i,k+2];
  167.           a[i,k+2] := a[i,k+2] - p*r
  168.         end;
  169.         a[i,k+1] := a[i,k+1] - p*q;
  170.         a[i,k] := a[i,k] - p
  171.       end;
  172.     end;
  173.   end;
  174.   proc2;
  175. end;
  176.  
  177. begin
  178.   anorm := abs(a[1,1]);
  179.   for i := 2 to n do
  180.     for j := i-1 to n do anorm := anorm + abs(a[i,j]);
  181.   nn := n;
  182.   t := 0;
  183.   while nn >= 1 do
  184.   begin
  185.     its := 0;
  186.     proc2;
  187.     proc3;
  188.     proc4;
  189.   end
  190. end;
The best way to get accurate information on the forum is to post something wrong and wait for corrections.

wp

  • Hero Member
  • *****
  • Posts: 12605
Re: Remove goto from procedure
« Reply #7 on: February 07, 2024, 11:24:34 am »
At first I reformatted the code to my style of indentation...

"goto 4" is easy: it jumps out of the "for m" loop --> replace it by "Break"

"goto 3" is a bit tricky. It jumps out of the l loop but continues to use the l index of the loop after the loop was exited. I don't even know whether this is legal... And when the condition is not met, the code after the loop should assume that l is 1. Maybe introduce some auxiliary variable (and exiting the loop by "Break"), this will also fix the "use loop variable outside loop" issue.
Code: Pascal  [Select][+][-]
  1. 2:var
  2.   tmpL: Integer;
  3. ...
  4.   tmpL := -1;
  5.   for l := nn downto 2 do
  6.     begin
  7.       s := abs(a[l-1,l-1])+abs(a[l,l]);
  8.       if s = 0.0 then
  9.         s := anorm;
  10.       if abs(a[l,l-1])+s = s then
  11.       begin
  12.         tmpL := l;
  13.         break;
  14. //      goto 3
  15.     end;
  16.     if tmpL <> -1 then l := tmpL else l := 1;
  17. //    l := 1;
  18. {3:}  x := a[nn,nn];

"Goto 2" finally, the most unclear one because it jump from the end to the beginning of the 200 lines of code... Let me try it this way: goto is inside the outermost "while" loop, and we want to jump back to the beginning --> replace the "goto 2" by "continue". BUT, then it would reset the "its" variable back to 0. Intuitively I would initialize "its" outside the loop, but why is it inside the loop? Is this intentional? Probably... Therefore, I'd propose another aux variable tmpIts:
Code: Pascal  [Select][+][-]
  1. var
  2.   tmpIts: Integer;
  3. ...
  4.   tmpIts := 0;
  5.   while nn >= 1 do
  6.   begin
  7.     its := tmpIts;  // was: 0;
  8. {2:}  for l := nn downto 2 do  
  9.     ...
  10.     // its changes here
  11.     ...
  12. //  goto 2;
  13.     tmpIts := its;
  14.     Continue;
  15.     ...
  16.   end;

I cannot test since the declaration of the used variables is missing. It may work, but still is ugly. You should try to understand the code and split all the loop stuff into separate procedures/functions
« Last Edit: February 07, 2024, 11:27:54 am by wp »

user07022024

  • New Member
  • *
  • Posts: 13
Re: Remove goto from procedure
« Reply #8 on: February 07, 2024, 01:12:06 pm »
This is Press code , not mine
I looked at C version and it suggests to replace label 2: with repeat until loop

In c there is

its = 0
do
{
}
while(l < nn-1)

and

do
{

}
while()

can be replaced with

repeat

until not()

I tried to  write it from scratch but my version was far worse than this

Bart

  • Hero Member
  • *****
  • Posts: 5511
    • Bart en Mariska's Webstek
Re: Remove goto from procedure
« Reply #9 on: February 07, 2024, 02:28:08 pm »
Well, without proper definitions for all the types, and without a functions definition for sign(), the code cannot compile, so it cannot be tested.

And, what is it supposed to do?

Bart
« Last Edit: February 07, 2024, 02:47:14 pm by Bart »

440bx

  • Hero Member
  • *****
  • Posts: 5001
Re: Remove goto from procedure
« Reply #10 on: February 07, 2024, 03:30:57 pm »
And, what is it supposed to do?
IMO, that's the first question that should be answered.




@user07022024

You mentioned that the code isn't yours.  Can you be specific as to where you got the code ?... if it's a book, the book's title and even it's ISBN if you know it, if it isn't then whatever information is necessary to locate the source of that code.  That would likely be useful.
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

Zvoni

  • Hero Member
  • *****
  • Posts: 2844
Re: Remove goto from procedure
« Reply #11 on: February 07, 2024, 03:34:53 pm »
@user07022024

You mentioned that the code isn't yours.  Can you be specific as to where you got the code ?... if it's a book, the book's title and even it's ISBN if you know it, if it isn't then whatever information is necessary to locate the source of that code.  That would likely be useful.

Probably this one: https://en.wikipedia.org/wiki/Numerical_Recipes
https://books.google.de/books/about/Numerical_Recipes_in_Pascal.html?id=69uJzQEACAAJ&redir_esc=y

Acc. to a PDF for the C-Source-code, the Function "hqr" computes "eigenvalues of a Hessenberg matrix"

EDIT: FWIW, the C-Source-Code has no Goto's, so whoever ported that to Pascal.....
« Last Edit: February 07, 2024, 03:42:41 pm by Zvoni »
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad

wp

  • Hero Member
  • *****
  • Posts: 12605
Re: Remove goto from procedure
« Reply #12 on: February 07, 2024, 03:57:11 pm »
I used to be a big fan of the Numerical Recipes, but now I try to avoid them due to their restrictive copyright policy: http://mingus.as.arizona.edu/~bjw/software/boycottnr.html, see also Zvoni's wikipedia article. From their point of view, publishing some code of this book as it was done a few posts higher is a refringement of copyright...

korba812

  • Sr. Member
  • ****
  • Posts: 451
Re: Remove goto from procedure
« Reply #13 on: February 07, 2024, 04:21:47 pm »
Why do you want to remove "goto"? Will this code be more readable, less messy or faster after getting rid of "goto"?

Curt Carpenter

  • Hero Member
  • *****
  • Posts: 594
Re: Remove goto from procedure
« Reply #14 on: February 07, 2024, 04:42:42 pm »
It's the FORTRAN legacy.  I'm very fond of Numerical Recipes, but translating its code into readable Pascal can be agonizing.  For me, it has always taken an iterative process that starts with inventing meaningful names for all the variables involved.

On the upside, once you've done it, you will understand the algorithm.

(Favorite quote I remember from the book:  "If you hate black boxes as much as we do...")
« Last Edit: February 07, 2024, 06:32:52 pm by Curt Carpenter »

 

TinyPortal © 2005-2018