dimitris kalamaras

mathematics, social network analysis, free software…

Tag: Pascal

Sparse Linear Systems Solver With SOR

This is a very simple Pascal program I wrote in mid 1990s, which solves a sparse NxN linear system using the Succesive Overrelaxation Method (SOR), which in turn is based on Gauss Seidel Method.
Both methods are iterative.

N is initially set at maximum …64.
You need the W factor for the SOR to complete successful. The theory assures us that it must be W=1.062.

Read More

Tridiagonal Linear System Solver

This Pascal program is usefull in solving large tridiagonal linear systems. An example is the systems emerging from numerically integrating parabolic PDE’s by Finite Differences method.

It was ported to Turbo Pascal from a Fortran 77 program.
Its usage is very simple. All you have to do is to enter dimension of the system and the data, ie the three diagonals and the constant vector. Have fun…

Read More

Turbo Editor

This is a simple text editor, called TED (Turbo EDitor). It opens text files or creates new ones in the same directory as the executable. It has a limit in the rows of the text file, but you can easily extend it by changing the appropriate variable. With small text files, ie less than 200 lines, it should work with them easily. The user interface is completely DOS oriented. Don’t expect mouse support or any Hi-Tech GUI. It is just a small DOS program which was originally created to demonstrate string manipulation algorithms in Turbo Pascal. Thus, it provides you with actions like SEARCH string, DELETE string, INSERT string etc.
This program is the same algorithmically with CED, the text editor in C++ section.

program ted2;
uses crt;
 
var
   arxeio            : text;
   grammi            : array [1..700] of string[80];
   filename1         : string[12];
   page              : array [0..10] of integer;
   i,j,k,x,y,plithos,d1,d2,inserted_lines           : integer;
   neo,key,flag,flag1,ikey,pkey      :  char;
 
 
   procedure open (flag : char ;filename1 :string);
     begin
       assign (arxeio,filename1);
        if flag='n' then
         begin
          rewrite(arxeio);
         end;
       reset(arxeio);
     end;
 
    procedure readfile (j : integer);
         begin
          i:=1;
          if flag<>'n'then
             begin
               while not  EOF(arxeio) do
                begin
 
                 readln(arxeio,grammi[i]);
                 i:=i+1;
                end;
                  plithos:=i;
                  for i:=plithos+1 to plithos+20 do
                  fillchar(grammi[i],sizeof(grammi[i]),' ');
 
              end;
        end;
 
   procedure close1 ;
    begin
 
        rewrite(arxeio);
        for i:=1 to plithos+inserted_lines do
        begin
 
        writeln(arxeio,grammi[i]);
 
        end;
        close(arxeio);
   end;
 
   procedure kelyfos(neo : char)    ;
      begin
 
          for i:=1 to 32 do
            begin
               gotoxy(i,1);
               if ( i=32) then
                  begin
                   write (chr(181));
                  end
                else
                 write(chr(205));
            end;
 
 
             for i:=47 to 80 do
              begin
               if (i=47) then
                 begin
                 gotoxy(i,1);
                 write (chr(198));
                 end
              else
                begin
                gotoxy(i,1);
                 write(chr(205));
                 end;
             end;
 
             if neo='n' then
              begin
               gotoxy(33,1);writeln(' ',filename1,' ');
              end
             else
              begin
               gotoxy(33,1);writeln('     tEd      ');
              end;
 
             for i:=1 to 79 do
              begin
               gotoxy(i,24);
               if (i=1) then begin write(chr(192));end;
                write(chr(196));
               if (i=79) then begin write(chr(217));end;
              end;
 
      gotoxy(3,24); write (' ',x,':',y+22*d1,' ');
      gotoxy(70,24);write(' page ',d1,' ');
     end;
 
   procedure refresh ;
        begin
            clrscr;
 
            delay(0);
            kelyfos(neo);
            delay(0);
            gotoxy(1,2);
            for i:=page[d1]+1 to page[d2] do
            begin
             writeln(grammi[i]);
            end;
        end;
 
     procedure refresh1 ;
       begin
            clrscr;
            kelyfos(neo);
                 gotoxy(1,2);
            if (plithos&lt;22) then
            begin
             for i:=page[d1]+1 to plithos do
               begin
 
                writeln(grammi[i]);
               end;
            end;
           gotoxy(1,2);
           if (plithos>=22) then
           begin
             for i:=page[d1]+1 to page[d2] do
               begin
                writeln(grammi[i]);
               end;
                  gotoxy(3,25);clreol;
                  write('L:',plithos,' ',' Select Page: <n>ext <p>revious <s>tay or Page Number');
                  pkey:=readkey;
                  case pkey of
                     'S','s' :  begin refresh; end;
                     'n','N' : begin d1:=d1+1;d2:=d2+1;refresh; end;
                     'p','P' : begin d1:=d1-1;d2:=d2-1;refresh;end;
                     '1'     : begin d1:=0;d2:=1;refresh;end;
                     '2'     : begin d1:=1;d2:=2;refresh;end;
                     '3'     :begin d1:=2;d2:=3;refresh;end;
                     '4'     :begin d1:=3;d2:=4;refresh;end;
                     '5'     :begin d1:=4;d2:=5;refresh;end;
                     '6'     :begin d1:=5;d2:=6;refresh;end;
                     '7'     :begin d1:=6;d2:=7;refresh;end;
                     '8'     :begin d1:=8;d2:=9;refresh;end;
                     '9'     :begin d1:=9;d2:=10;refresh;end;
 
                     else
                     refresh;
                  end;
 
 
            end;
 
       end;
 
   procedure del_char(x,y,i : integer);
        begin
             delete(grammi[y+page[d1]],x,i);
             gotoxy(1,y+1);clreol;write(grammi[y+page[d1]]);
             gotoxy(x,y+1);
         end;
 
   procedure seekdestroy (var x,y : integer );
       var
       str : string [20];
       begin
          gotoxy(3,25);delline;
          write('Enter string : ');
          readln;read(str);
          k:=0;
           for i:=page[d1]+1 to page[d2] do
            begin
 
               if pos(str,grammi[i]) <> 0 then
                 begin
                   k:=k+1; y:=i-page[d1];
                   x:=pos(str,grammi[i]);
                   gotoxy(x,i+1);
                   delete(grammi[i],x,length(str));
                   gotoxy(1,i+1);clreol;write(grammi[i]);
                 end;
             end;
             refresh;
           gotoxy(3,25);delline;
           write('Deleted ',k,' strings.');
 
        end;
 
 
   procedure search1 (var x,y : integer);
      var
       str : string [20];
       ans : char;
       k: integer;
 label l1;
       begin
          gotoxy(3,25);delline;
          write('Enter string : ');
          readln;read(str);
          refresh;
          k:=0;
           for i:=page[d1]+1 to page[d2] do
            begin
               if pos(str,grammi[i]) <> 0 then
                 begin
                   x:=pos(str,grammi[i]);
                   y:=i-page[d1];
                   gotoxy(x,y+1);
                   gotoxy(3,25);clreol;
                   write ('Found at ',x,':',y+page[d1]);
                   gotoxy(55,25);clreol;
                   write('Find next? (Y/N)');
                   gotoxy(x,y+1);
                   ans:=readkey;
                   if (ans='n') or (ans='N') then goto l1;
                   k:=k+1;
                  end;
             end;
   l1 :    gotoxy(3,25);delline;
           write('Found ',k,' matches.');
        end;
 
 
     procedure ins_str (var x,y :integer);
         begin
            i:=0;
            ikey:=' ';
            repeat
             begin
              ikey:=readkey;
              if ikey <> chr(13) then
              begin
               gotoxy(20+i,25);write(ikey);
               insert(ikey,grammi[y+page[d1]],x);
               gotoxy(1,y+1);clreol;write(grammi[y+page[d1]]);
               gotoxy(20+i,25);
               i:=i+1;
               x:=x+1;
               end;
             end;
           until ikey= chr(13);
             gotoxy(3,25);delline;
             write('Insert : <l>ine S<t>ring <b>ack:');
         end;
 
 
     procedure ins_line (var x,y :integer);
       var i : integer;
         begin
             inserted_lines:=inserted_lines+1;
             gotoxy(1,y+1);
             for i:=plithos+inserted_lines downto y+page[d1]+1 do
              begin
                 move(grammi[i-1],grammi[i],80);
              end;
              fillchar(grammi[i-1],sizeof(grammi[i-1]),' ');
             refresh;
             gotoxy(3,25);delline;
             write('Insert : <l>ine S<t>ring <b>ack:');
             kelyfos('n');
             y:=y+1;
             gotoxy(1,y+1);
         end;
 
       procedure del_line (var x,y :integer);
       var i : integer;
         begin
             gotoxy(1,y+1);
             for i:=y+page[d1]+1 to plithos+inserted_lines do
              begin
                 move(grammi[i],grammi[i-1],80);
              end;
              refresh;
             gotoxy(3,25);delline;
             write('Delete : S<t>ring <c>har <l>ine <b>ack:');
             kelyfos('n');
             gotoxy(1,y+1);
         end;
 
    procedure uppercase_all (x,y : integer);
     var
          i,j       : integer;
         str1   : string [80];
        begin
           gotoxy(1,y);
            for i:=page[d1]+1 to page[d2] do
             begin
 
               str1:=copy(grammi[i],1,80);
                 for j:=1 to 80 do
                   begin
                    str1[j]:=upcase(str1[j]);
                   end;
               grammi[i]:=copy(str1,1,80);
             end;
             refresh;
             gotoxy(3,25);delline;
             write('UpperCase : S<t>ring <a>ll <b>ack:');
             kelyfos('n');
 
         end;
 
 
 {   procedure downcase_all (x,y : integer);
     var
          i,j       : integer;
         str1   : string [80];
        begin
           gotoxy(1,y);
            for i:=y to 24 do
             begin
 
               str1:=copy(grammi[i],1,80);
                 for j:=1 to 80 do
                   begin
                    str1[j]:=(val(str1[j])+20);
                   end;
               grammi[i]:=copy(str1,1,80);
             end;
             refresh;
             gotoxy(3,25);delline;
             write('DownCase : S<t>ring <a>ll <b>ack:');
             kelyfos('n');
 
         end; }
 
 
    procedure mainmenu;
          begin
           gotoxy(3,25);
           write('CRTL: <m>enu Mode  <c>ursor Mode: ');
          end;
 
    procedure menumode(var flag1 : char );
        begin
           kelyfos('n');
           if key=chr(13) then
            begin
            gotoxy(3,25); delline;
            write('Menu Mode: <s>earch <i>nsert <d>elete <u>pperCase <p>age <e>xit');
            end;
 
            if (key='e') or (key='E') then
             begin
              gotoxy(3,25);delline;
              write('Closing File....'); delay(1000);
              write('BYE!'); delay(1000);close1;halt;
             end;
 
            if (key='S') or (key='s') then
              begin
               gotoxy(3,25);delline;
               write('Search : S<t>ring <c>har <b>ack:');
               flag1:='s';
              end;
 
              if (key='p') or (key='P') then
              begin
               gotoxy(3,25);delline;
               write('Invoking Refresh Procedure...');delay(1000);
               flag1:='p';
               refresh1;
              end;
 
 
             if flag1='s' then
              begin
               if (key='t') or (key='T') then
                begin
                 gotoxy(3,25);delline;
                 write('Search String....: ');
                 search1(x,y);
                end;
              end;
 
             if flag1='s' then
              begin
               if (key='C') or (key='c') then
                begin
                 gotoxy(3,25);delline;
                 write('Search Char...: ');
                end;
              end;
 
             if (key='d') or (key='D') then
               begin
                gotoxy(3,25);delline;
                write('Delete : S<t>ring <c>har <l>ine <b>ack:');
                flag1:='d';
               end;
 
             if flag1='d' then
              begin
               if (key='t') or (key='T') then
                 begin
                  gotoxy(3,25);delline;
                  write('Delete String....: ');
                  seekdestroy(x,y);
                  end;
              end;
 
             if flag1='d' then
              begin
               if (key='C') or (key='c') then
                 begin
                  gotoxy(3,25);delline;
                  write('Delete Char...: ');
                  del_char(x,y,1);
                 end;
              end;
 
            if flag1='d' then
              begin
               if (key='L') or (key='l') then
                 begin
                  gotoxy(3,25);delline;
                  write('Deleting Line...');
                  del_line (x,y);
                 end;
              end;
 
 
            if (key='b') or (key='B') then
              begin
                gotoxy(3,25);delline;
                key:=chr(13);
                flag1:=' ';
                menumode(flag1);
              end;
 
            if (key='U') or (key='u') then
              begin
               gotoxy(3,25);delline;
               write('UpperCase : S<t>ring <a>ll <b>ack:');
               flag1:='u';
              end;
 
            if flag1='u' then
              begin
               if (key='t') or (key='T') then
                 begin
                  gotoxy(3,25);delline;
                  write('Insert String to UpperCase...: ');
 
                  end;
                end;
 
            if flag1='u' then
              begin
               if (key='a') or (key='A') then
                 begin
                  gotoxy(3,25);delline;
                  write('Wait... '); delay(1000);
                  uppercase_all(x,y);
                 end;
               end;
 
            if (key='i') or (key='I') then
              begin
               gotoxy(3,25);delline;
               write('Insert : <l>ine S<t>ring <b>ack:');
               flag1:='i';
              end;
 
            if flag1='i' then
              begin
               if (key='t') or (key='T') then
                 begin
                  gotoxy(3,25);delline;
                  write('Insert String...: ');
                  ins_str(x,y);
                 end;
              end;
 
            if flag1='i' then
              begin
               if (key='L') or (key='l') then
                 begin
                  gotoxy(3,25);delline;
                  write('Insert line...: ');
                  ins_line (x,y);
                 end;
              end;
       end;
 
 
    procedure cursormode (var x,y : integer) ;
         begin
             gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
             gotoxy(3,25) ; delline;
             write('  Turn NumLock [ON] Use num pad.');
             if (key=chr(56)) then
              begin
               if y=1 then
               begin
                gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
                gotoxy(3,25) ; delline;
                write('  Turn NumLock [ON] Use num pad.');
                y:=y;
               end
               else
               begin
                x:=x;    y:=y-1;
                 gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
                gotoxy(3,25) ; delline;
                write('  Turn NumLock [ON] Use num pad.');
 
               end;
              end;
            if (key=chr(54)) then
              begin
               if x=80 then
               begin
                 x:=x;
                  gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
                gotoxy(3,25) ; delline;
                write('  Turn NumLock [ON] Use num pad.');
 
               end
               else
               begin
                 x:=x+1;    y:=y;
                 gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
                gotoxy(3,25) ; delline;
                write('  Turn NumLock [ON] Use num pad.');
               end;
              end;
           if (key=chr(52)) then
              begin
               if x=1 then
               begin       x:=x;   end
               else
               begin
                x:=x-1;    y:=y;
                gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
                gotoxy(3,25) ; delline;
                write('  Turn NumLock [ON] Use num pad.');
 
              end;
              end;
            if (key=chr(50)) then
              begin
               if y=22 then
               begin       y:=y;   end
               else
               begin
                x:=x;    y:=y+1;
                gotoxy(3,24); write (' ',x,':',y+d1*22,' ');
                gotoxy(3,25) ; delline;
                write('  Turn NumLock [ON] Use num pad.');
                end;
              end;
            gotoxy(x,y+1);
         end;
 
 
 
  begin
         inserted_lines:=0;
         d1:=0;d2:=1;
         x:=1;y:=1;
 
 
        for i:=0 to 10 do
        begin
        page[i]:=(22*i);
        end;
 
 
        clrscr;
        kelyfos(neo);
 
        gotoxy(3,25);
        write ('<n>ew Text File <o>pen Text File : ');
        key:=readkey;
        if (key='n') or (key='N') then
         begin
          gotoxy(3,25);delline;
          write('Enter a Name for the New Text File:');
          read(filename1);
          flag:='n';
         end
        else
         begin
          gotoxy(3,25);delline;
          write (' Enter the Name of the Text File to load:  ');
          read(filename1);
        end;
 
        clrscr;
 
             open (flag ,filename1 );
 
             neo:='n';  kelyfos(neo) ;
 
             j:=1;   readfile (j);
               refresh1;
 
 
       mainmenu;
         repeat
          begin
 
             key:=readkey;
 
              if key =chr(3) then
               begin
                repeat
                 begin
                  cursormode(x,y);
                  key:=readkey;
                 end;
                until (key=chr(13));
               end;
 
             if key= chr(13) then
              begin
               repeat
                begin
                  menumode(flag1);
                  key:=readkey;
                end;
              until  (key=chr(3));
             end;
 
 
          end;
         until (key='E') or (key='e');
 
        gotoxy(3,25);delline;write('Closing File...');delay(2000);
        write('BYE!');delay(1000);clrscr;
 
        close1;
  end.
</o></n></b></t></l></b></a></t></b></l></c></t></b></c></t></e></p></u></d></i></s></c></m></b></a></t></b></a></t></b></l></c></t></b></t></l></b></t></l></s></p></n>

Prime numbers’ generator

This is a Prime Numbers’ Generator from Integers up to 2,000,000,000, written in Turbo Pascal.
This program generates the prime numbers up to a given arithmetic limit, using 4 (four) different known methods. They are all based in modulo algebra. The methods are:

  1. This uses the mathematical definition of a prime number to generate them. A prime is only divided by 1 and himself. Disadvantage: The method is very slow.
  2. In this method, each number N is modulo divided only with the half of the numbers below it (N/2). Thus, the search is becoming faster than the first method.
  3. In the third method, a number, let N, is modulo divided only with the numbers up to sqrt{N}. As a result of that, the generation process is 10 times faster than the previous methods.
  4. The fourth method is the best of all. It is based on the 3rd method, only it bypass the sqrt{x} praxis, by modulo dividing each number N with the first, the second and the third prime number and then, if there is a residue, it modulo divides N with j, where j is an integer from j*j cdots N with step 2. The above trick has the eye-blink effect: the method generates primes (within a reasonable range) before you blink your eyes….:-)

Read More

Creative Commons License
Licensed under a Creative Commons Attribution-ShareAlike 4.0 International License - Powered by Linux