WeixiangYan/CodeTransOcean huggingface dataset:
Task: Exceptions








VB: Sub foo1()
    err.raise(vbObjectError + 1050)
End Sub

Sub foo2()
    Error vbObjectError + 1051
End Sub




Ada: Foo_Error : exception;
Task: Hofstadter Q sequence








VB: Public Q(100000) As Long
Public Sub HofstadterQ()
    Dim n As Long, smaller As Long
    Q(1) = 1
    Q(2) = 1
    For n = 3 To 100000
        Q(n) = Q(n - Q(n - 1)) + Q(n - Q(n - 2))
        If Q(n) < Q(n - 1) Then smaller = smaller + 1
    Next n
    Debug.Print "First ten terms:"
    For i = 1 To 10
        Debug.Print Q(i);
    Next i
    Debug.print
    Debug.Print "The 1000th term is:"; Q(1000)
    Debug.Print "Number of times smaller:"; smaller
End Sub




Ada: with Ada.Text_IO;

procedure Hofstadter_Q_Sequence is

   type Callback is access procedure(N: Positive);

   procedure Q(First, Last: Positive; Q_Proc: Callback) is
   
   

      Q_Store: array(1 .. Last) of Natural := (1 => 1, 2 => 1, others => 0);
      
      
      

      function Q(N: Positive) return Positive is
      begin
         if Q_Store(N) = 0 then
            Q_Store(N) := Q(N - Q(N-1)) + Q(N-Q(N-2));
         end if;
         return Q_Store(N);
      end Q;

   begin
      for I in First .. Last loop
         Q_Proc(Q(I));
      end loop;
   end Q;

   procedure Print(P: Positive) is
   begin
      Ada.Text_IO.Put(Positive'Image(P));
   end Print;

   Decrease_Counter: Natural := 0;
   Previous_Value: Positive := 1;

   procedure Decrease_Count(P: Positive) is
   begin
      if P < Previous_Value then
         Decrease_Counter := Decrease_Counter + 1;
      end if;
      Previous_Value := P;
   end Decrease_Count;

begin
   Q(1, 10, Print'Access);
   
   Ada.Text_IO.New_Line;

   Q(1000, 1000,  Print'Access);
   
   Ada.Text_IO.New_Line;

   Q(2, 100_000, Decrease_Count'Access);
   Ada.Text_IO.Put_Line(Integer'Image(Decrease_Counter));
   
   
end Hofstadter_Q_Sequence;
Task: Count occurrences of a substring








VB: Function CountSubstring(str,substr)
	CountSubstring = 0
	For i = 1 To Len(str)
		If Len(str) >= Len(substr) Then
			If InStr(i,str,substr) Then
				CountSubstring = CountSubstring + 1
				i = InStr(i,str,substr) + Len(substr) - 1
			End If
		Else
			Exit For
		End If
	Next
End Function

WScript.StdOut.Write CountSubstring("the three truths","th") & vbCrLf
WScript.StdOut.Write CountSubstring("ababababab","abab") & vbCrLf




Ada: with Ada.Strings.Fixed, Ada.Integer_Text_IO;

procedure Substrings is
begin
   Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source  => "the three truths",
                                                     Pattern => "th"));
   Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source  => "ababababab",
                                                     Pattern => "abab"));
end Substrings;
Task: Arithmetic numbers








VB: 


function isarit_compo(i)
     cnt=0
     sum=0
     for j=1 to sqr(i)
       if (i mod j)=0 then 
          k=i\j 
             
         if k=j then 
            cnt=cnt+1:sum=sum+j 
         else  
            cnt=cnt+2:sum=sum+j+k 
         end if
       end if
     next
   avg= sum/cnt
   isarit_compo= array((fix(avg)=avg),-(cnt>2))
end function

function rpad(a,n) rpad=right(space(n)&a,n) :end function

dim s1
sub print(s) 
  s1=s1& rpad(s,4)
  if len(s1)=40 then wscript.stdout.writeline s1:s1=""
end sub


cntr=0
cntcompo=0
i=1
wscript.stdout.writeline "the first 100 arithmetic numbers are:"
do
  a=isarit_compo(i)
  if a(0) then  
    cntcompo=cntcompo+a(1)
    cntr=cntr+1
    if cntr<=100 then print i
    if cntr=1000 then wscript.stdout.writeline vbcrlf&"1000th   : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6)
    if cntr=10000 then wscript.stdout.writeline vbcrlf& "10000th  : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6)
    if cntr=100000 then wscript.stdout.writeline vbcrlf &"100000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6):exit do
  end if 
  i=i+1
loop




Ada: with Ada.Text_IO;         use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Main is
   procedure divisor_count_and_sum
     (n : Positive; divisor_count : out Natural; divisor_sum : out Natural)
   is
      I : Positive := 1;
      J : Natural;
   begin
      divisor_count := 0;
      divisor_sum   := 0;
      loop
         J := n / I;
         exit when J < I;
         if I * J = n then
            divisor_sum   := divisor_sum + I;
            divisor_count := divisor_count + 1;
            if I /= J then
               divisor_sum   := divisor_sum + J;
               divisor_count := divisor_count + 1;
            end if;
         end if;
         I := I + 1;
      end loop;
   end divisor_count_and_sum;

   arithmetic_count : Natural  := 0;
   composite_count  : Natural  := 0;
   div_count        : Natural;
   div_sum          : Natural;
   mean             : Natural;
   n                : Positive := 1;
begin

   while arithmetic_count <= 1_000_000 loop
      divisor_count_and_sum (n, div_count, div_sum);
      mean := div_sum / div_count;
      if mean * div_count = div_sum then
         arithmetic_count := arithmetic_count + 1;
         if div_count > 2 then
            composite_count := composite_count + 1;
         end if;
         if arithmetic_count <= 100 then
            Put (Item => n, Width => 4);
            if arithmetic_count mod 10 = 0 then
               New_Line;
            end if;
         end if;
         if arithmetic_count = 1_000 or else arithmetic_count = 10_000
           or else arithmetic_count = 100_000
           or else arithmetic_count = 1_000_000
         then
            New_Line;
            Put (Item => arithmetic_count, Width => 1);
            Put_Line ("th arithmetic number is" & n'Image);
            Put_Line
              ("Number of composite arithmetic numbers <=" & n'Image & ":" &
               composite_count'Image);
         end if;
      end if;
      n := n + 1;
   end loop;
end Main;
Task: Carmichael 3 strong pseudoprimes








VB: max_sieve = 1e7
dim isprime(max_sieve)

//set up sieve
for i = 3 to max_sieve step 2
  isprime(i) = 1
next i

isprime(2) = 1
for i = 3 to sqrt(max_sieve) step 2
  if isprime(i) = 1 then
    for j = i * i to max_sieve step i * 2
      isprime(j) = 0
    next j
  fi
next i

for i = 2 to 61
  carmichael3(i)
next i
end
 
sub carmichael3(p1) 
  local h3, d, p2, p3, t1, t2

  if isprime(p1) = 0  return
  for h3 = 1 to p1 -1
    t1 = (h3 + p1) * (p1 -1)
    t2 = mod((-p1 * p1), h3)
    if t2 < 0   t2 = t2 + h3
    for d = 1 to h3 + p1 -1
      if mod(t1, d) = 0 and t2 = mod(d, h3) then
        p2 = 1 + int(t1 / d)
        if isprime(p2) = 0  continue
        p3 = 1 + int(p1 * p2 / h3)
        if isprime(p3) = 0 or mod((p2 * p3), (p1 -1)) <> 1  continue
        print p1 using ("###"), " * ", p2 using ("####"), " * ", p3 using ("#####")
      fi
    next d
  next h3
end sub




Ada: with Ada.Text_IO, Miller_Rabin;

procedure Nemesis is

   type Number is range 0 .. 2**40-1; 

   function Is_Prime(N: Number) return Boolean is
      package MR is new Miller_Rabin(Number); use MR;
   begin
      return MR.Is_Prime(N) = Probably_Prime;
   end Is_Prime;

begin
   for P1 in Number(2) .. 61 loop
      if Is_Prime(P1) then
         for H3 in Number(1) .. P1 loop
            declare
               G: Number := H3 + P1;
               P2, P3: Number;
            begin
               Inner:
               for D in 1 .. G-1 loop
                  if ((H3+P1) * (P1-1)) mod D = 0 and then
                    (-(P1 * P1)) mod H3 = D mod H3
                  then
                     P2 := 1 + ((P1-1) * G / D);
                     P3 := 1 +(P1*P2/H3);
                     if Is_Prime(P2) and then Is_Prime(P3)
                       and then (P2*P3) mod (P1-1) = 1
                     then
                       Ada.Text_IO.Put_Line
                        ( Number'Image(P1) & " *"   & Number'Image(P2) & " *" &
                          Number'Image(P3) & "  = " & Number'Image(P1*P2*P3) );
                     end if;
                  end if;
               end loop Inner;
            end;
         end loop;
      end if;
   end loop;
end Nemesis;
Task: Benford's law








VB: Sub BenfordLaw()

Dim BenResult(1 To 9) As Long

BENref = "30,1%|17,6%|12,5%|9,7%|7,9%|6,7%|5,8%|5,1%|4,6%"

For Each c In Selection.Cells
  If InStr(1, "-0123456789", Left(c, 1)) > 0 Then
    For i = 1 To 9
      If CInt(Left(Abs(c), 1)) = i Then BenResult(i) = BenResult(i) + 1: Exit For
    Next
  End If
Next
Total= Application.Sum(BenResult)
biggest= Len(CStr(BenResult(1)))

txt = "#   |   Values    |     Real     |  Expected   " & vbCrLf
For i = 1 To 9
  If BenResult(i) > 0 Then
    txt = txt & "#" & i & " | " & vbTab
    txt = txt & String((biggest - Len(CStr(BenResult(i)))) * 2, " ") & Format(BenResult(i), "0") & " | " & vbTab
    txt = txt & String((Len(CStr(Format(BenResult(1) / Total, "##0.0%"))) - Len(CStr(Format(BenResult(i) / Total, "##0.0%")))) * 2, " ") & Format(BenResult(i) / Total, "##0.0%") & " | " & vbTab
    txt = txt & Format(Split(BENref, "|")(i - 1), "     ##0.0%") & vbCrLf
  End If
Next

MsgBox txt, vbOKOnly, "Finish"

End Sub

}




Ada: with Ada.Text_IO, Ada.Numerics.Generic_Elementary_Functions; 

procedure Benford is
   
   subtype Nonzero_Digit is Natural range 1 .. 9;
   function First_Digit(S: String) return Nonzero_Digit is
      (if S(S'First) in '1' .. '9' 
         then Nonzero_Digit'Value(S(S'First .. S'First))
         else First_Digit(S(S'First+1 .. S'Last)));
      
   package N_IO is new Ada.Text_IO.Integer_IO(Natural);  
      
   procedure Print(D: Nonzero_Digit; Counted, Sum: Natural) is
      package Math is new Ada.Numerics.Generic_Elementary_Functions(Float);
      package F_IO is new Ada.Text_IO.Float_IO(Float);
      Actual: constant Float := Float(Counted) / Float(Sum);
      Expected: constant Float := Math.Log(1.0 + 1.0 / Float(D), Base => 10.0);
      Deviation: constant Float := abs(Expected-Actual);
   begin
      N_IO.Put(D, 5);
      N_IO.Put(Counted, 14);
      F_IO.Put(Float(Sum)*Expected, Fore => 16, Aft => 1, Exp => 0);
      F_IO.Put(100.0*Actual, Fore => 9, Aft => 2, Exp => 0); 
      F_IO.Put(100.0*Expected, Fore => 11, Aft => 2, Exp => 0); 
      F_IO.Put(100.0*Deviation, Fore => 13, Aft => 2, Exp => 0);
   end Print;
   
   Cnt: array(Nonzero_Digit) of Natural := (1 .. 9 => 0);   
   D: Nonzero_Digit;
   Sum: Natural := 0;
   Counter: Positive;       
       
begin     
   while not Ada.Text_IO.End_Of_File loop
      
      N_IO.Get(Counter); 
        
      D := First_Digit(Ada.Text_IO.Get_Line); 
        
      Cnt(D) := Cnt(D)+1;
      Sum := Sum + 1;
   end loop;
   Ada.Text_IO.Put_Line(" Digit  Found[total]   Expected[total]    Found[%]" 
                                          & "   Expected[%]   Difference[%]");
   for I in Nonzero_Digit loop
      Print(I, Cnt(I), Sum);
      Ada.Text_IO.New_Line;
   end loop;
end Benford;
Task: Read a configuration file








VB: type TSettings extends QObject
    FullName as string
    FavouriteFruit as string
    NeedSpelling as integer
    SeedsRemoved as integer
    OtherFamily as QStringlist
    
    Constructor
        FullName = ""
        FavouriteFruit = ""
        NeedSpelling = 0
        SeedsRemoved = 0
        OtherFamily.clear
    end constructor
end type

Dim Settings as TSettings
dim ConfigList as QStringList
dim x as integer
dim StrLine as string
dim StrPara as string
dim StrData as string

function Trim$(Expr as string) as string
    Result = Rtrim$(Ltrim$(Expr))
end function

Sub ConfigOption(PData as string)
    dim x as integer
    for x = 1 to tally(PData, ",") +1
        Settings.OtherFamily.AddItems Trim$(field$(PData, "," ,x))
    next
end sub 

Function ConfigBoolean(PData as string) as integer
    PData = Trim$(PData)
    Result = iif(lcase$(PData)="true" or PData="1" or PData="", 1, 0)
end function

sub ReadSettings
    ConfigList.LoadFromFile("Rosetta.cfg")
    ConfigList.text = REPLACESUBSTR$(ConfigList.text,"="," ")

    for x = 0 to ConfigList.ItemCount -1
        StrLine = Trim$(ConfigList.item(x))
        StrPara = Trim$(field$(StrLine," ",1))
        StrData = Trim$(lTrim$(StrLine - StrPara))  
    
        Select case UCase$(StrPara)
        case "FULLNAME"       : Settings.FullName = StrData 
        case "FAVOURITEFRUIT" : Settings.FavouriteFruit = StrData 
        case "NEEDSPEELING"   : Settings.NeedSpelling = ConfigBoolean(StrData)
        case "SEEDSREMOVED"   : Settings.SeedsRemoved = ConfigBoolean(StrData)
        case "OTHERFAMILY"    : Call ConfigOption(StrData)
        end select
    next
end sub

Call ReadSettings




Ada: with Config; use Config;
with Ada.Text_IO; use Ada.Text_IO;

procedure Rosetta_Read_Cfg is
  cfg: Configuration:= Init("rosetta_read.cfg", Case_Sensitive => False, Variable_Terminator => ' ');
  fullname       : String  := cfg.Value_Of("*", "fullname");
  favouritefruit : String  := cfg.Value_Of("*", "favouritefruit");
  needspeeling   : Boolean := cfg.Is_Set("*", "needspeeling");
  seedsremoved   : Boolean := cfg.Is_Set("*", "seedsremoved");
  otherfamily    : String  := cfg.Value_Of("*", "otherfamily");
begin
  Put_Line("fullname = "       & fullname);
  Put_Line("favouritefruit = " & favouritefruit);
  Put_Line("needspeeling = "   & Boolean'Image(needspeeling));
  Put_Line("seedsremoved = "   & Boolean'Image(seedsremoved));
  Put_Line("otherfamily = "    & otherfamily);
end;
Task: Case-sensitivity of identifiers








VB: Public Sub case_sensitivity()
    
    
    
    Dim DOG As String
    DOG = "Benjamin"
    DOG = "Samba"
    DOG = "Bernie"
    Debug.Print "There is just one dog named " & DOG
End Sub




Ada: with Ada.Text_IO;
procedure Dogs is
   Dog : String := "Bernie";
begin
   Ada.Text_IO.Put_Line ("There is just one dog named " & DOG);
end Dogs;
Task: Start from a main routine








VB: SUB Main()
  
END




Ada: with Ada.Text_IO;
procedure Foo is
begin
   Ada.Text_IO.Put_Line("Bar");
end Foo;
Task: Truncate a file








VB: Sub truncate(fpath,n)
	
	Set objfso = CreateObject("Scripting.FileSystemObject")
	If objfso.FileExists(fpath) = False Then
		WScript.Echo fpath & " does not exist"
		Exit Sub
	End If
	content = ""
	
	Set objinstream = CreateObject("Adodb.Stream")
	With objinstream
		.Type = 1
		.Open
		.LoadFromFile(fpath)
		
		If n <= .Size Then
			content = .Read(n)
		Else
			WScript.Echo "The specified size is larger than the file content"
			Exit Sub
		End If
		.Close
	End With
	
	Set objoutstream = CreateObject("Adodb.Stream")
	With objoutstream
		.Type = 1
		.Open
		.Write content
		.SaveToFile fpath,2
		.Close
	End With
	Set objinstream = Nothing
	Set objoutstream = Nothing
	Set objfso = Nothing
End Sub


Call truncate("C:\temp\test.txt",30)




Ada: with Ada.Command_Line, Ada.Sequential_IO, Ada.Directories;

procedure Truncate_File is

   type Byte is mod 256;
   for Byte'Size use 8;

   package Byte_IO is new Ada.Sequential_IO(Byte);

   function Arg(N: Positive) return String renames Ada.Command_Line.Argument;
   function Args return Natural renames Ada.Command_Line.Argument_Count;

begin
   
   if Args < 2 or else Args > 3 then
      raise Program_Error
        with "usage: truncate_file <filename> <length> [<temp_file>]";
   end if;

   
   declare
      File_Name: String := Arg(1);
      Temp_Name: String := (if Args = 2 then Arg(1) & ".tmp" else Arg(3));
                             
      File, Temp: Byte_IO.File_Type;
      Count: Natural := Natural'Value(Arg(2));
      Value: Byte;
   begin
      
      Byte_IO.Open  (File => File, Mode => Byte_IO.In_File,  Name => File_Name);
      Byte_IO.Create(File => Temp, Mode => Byte_IO.Out_File, Name => Temp_Name);

      
      while (not Byte_IO.End_Of_File(File)) and Count > 0 loop
         Byte_IO.Read (File, Value);
         Byte_IO.Write(Temp, Value);
         Count := Count - 1;
      end loop;

      
      Byte_IO.Close(Temp);
      Byte_IO.Close(File);

      if Count = 0 then 
         
         Ada.Directories.Delete_File(Name => File_Name);
         Ada.Directories.Rename(Old_Name => Temp_Name, New_Name => File_Name);
      else 
         
         Ada.Directories.Delete_File(Name => Temp_Name);
         raise Program_Error
           with "Size of """ & File_Name & """ less than " & Arg(2);
      end if;
   end;
end Truncate_File;
Task: Sorting algorithms_Shell sort








VB: Sub arrShellSort(ByVal arrData As Variant)
  Dim lngHold, lngGap As Long
  Dim lngCount, lngMin, lngMax As Long
  Dim varItem As Variant
  
  lngMin = LBound(arrData)
  lngMax = UBound(arrData)
  lngGap = lngMin
  Do While (lngGap < lngMax)
    lngGap = 3 * lngGap + 1
  Loop
  Do While (lngGap > 1)
    lngGap = lngGap \ 3
    For lngCount = lngGap + lngMin To lngMax
      varItem = arrData(lngCount)
      lngHold = lngCount
      Do While ((arrData(lngHold - lngGap) > varItem))
        arrData(lngHold) = arrData(lngHold - lngGap)
        lngHold = lngHold - lngGap
        If (lngHold < lngMin + lngGap) Then Exit Do
      Loop
      arrData(lngHold) = varItem
    Next
  Loop
  arrShellSort = arrData
End Sub




Ada: generic
   type Element_Type is digits <>;
   type Index_Type is (<>);
   type Array_Type is array(Index_Type range <>) of Element_Type;
package Shell_Sort is
   procedure Sort(Item : in out Array_Type);
end Shell_Sort;
Task: Read a specific line from a file








VB: Function read_line(filepath,n)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile(filepath,1)
	arrLines = Split(objFile.ReadAll,vbCrLf)
	If UBound(arrLines) >= n-1 Then
		If arrLines(n-1) <> "" Then
			read_line = arrLines(n-1)
		Else
			read_line = "Line " & n & " is null."
		End If
	Else
		read_line = "Line " & n & " does not exist."
	End If
	objFile.Close
	Set objFSO = Nothing
End Function

WScript.Echo read_line("c:\temp\input.txt",7)




Ada: with Ada.Text_IO;  use Ada.Text_IO;

procedure Rosetta_Read is
   File : File_Type;
begin
   Open (File => File,
         Mode => In_File,
         Name => "rosetta_read.adb");
   Set_Line (File, To => 7);

   declare
      Line_7 : constant String := Get_Line (File);
   begin
      if Line_7'Length = 0 then
         Put_Line ("Line 7 is empty.");
      else
         Put_Line (Line_7);
      end if;
   end;

   Close (File);
exception
   when End_Error =>
      Put_Line ("The file contains fewer than 7 lines.");
      Close (File);
   when Storage_Error =>
      Put_Line ("Line 7 is too long to load.");
      Close (File);
end Rosetta_Read;
Task: URL encoding








VB:   Dim URL As String = "http://foo bar/"
  URL = EncodeURLComponent(URL)
  Print(URL)




Ada: with AWS.URL;
with Ada.Text_IO; use Ada.Text_IO;
procedure Encode is
   Normal : constant String := "http://foo bar/";
begin
   Put_Line (AWS.URL.Encode (Normal));
end Encode;
Task: LU decomposition








VB: Option Base 1
Private Function pivotize(m As Variant) As Variant
    Dim n As Integer: n = UBound(m)
    Dim im() As Double
    ReDim im(n, n)
    For i = 1 To n
        For j = 1 To n
            im(i, j) = 0
        Next j
        im(i, i) = 1
    Next i
    For i = 1 To n
        mx = Abs(m(i, i))
        row_ = i
        For j = i To n
            If Abs(m(j, i)) > mx Then
                mx = Abs(m(j, i))
                row_ = j
            End If
        Next j
        If i <> Row Then
            For j = 1 To n
                tmp = im(i, j)
                im(i, j) = im(row_, j)
                im(row_, j) = tmp
            Next j
        End If
    Next i
    pivotize = im
End Function
 
Private Function lu(a As Variant) As Variant
    Dim n As Integer: n = UBound(a)
    Dim l() As Double
    ReDim l(n, n)
    For i = 1 To n
        For j = 1 To n
            l(i, j) = 0
        Next j
    Next i
    u = l
    p = pivotize(a)
    a2 = WorksheetFunction.MMult(p, a)
    For j = 1 To n
        l(j, j) = 1#
        For i = 1 To j
            sum1 = 0#
            For k = 1 To i
                sum1 = sum1 + u(k, j) * l(i, k)
            Next k
            u(i, j) = a2(i, j) - sum1
        Next i
        For i = j + 1 To n
            sum2 = 0#
            For k = 1 To j
                sum2 = sum2 + u(k, j) * l(i, k)
            Next k
            l(i, j) = (a2(i, j) - sum2) / u(j, j)
        Next i
    Next j
    Dim res(4) As Variant
    res(1) = a
    res(2) = l
    res(3) = u
    res(4) = p
    lu = res
End Function
 
Public Sub main()
    
    a = [{1, 3, 5; 2, 4, 7; 1, 1, 0}]
    Debug.Print "== a,l,u,p: =="
    result = lu(a)
    For i = 1 To 4
        For j = 1 To UBound(result(1))
            For k = 1 To UBound(result(1), 2)
                Debug.Print result(i)(j, k),
            Next k
            Debug.Print
        Next j
        Debug.Print
    Next i
    a = [{11, 9,24, 2; 1, 5, 2, 6; 3,17,18, 1; 2, 5, 7, 1}]
    Debug.Print "== a,l,u,p: =="
    result = lu(a)
    For i = 1 To 4
        For j = 1 To UBound(result(1))
            For k = 1 To UBound(result(1), 2)
                Debug.Print Format(result(i)(j, k), "0.#####"),
            Next k
            Debug.Print
        Next j
        Debug.Print
    Next i
End Sub




Ada: with Ada.Numerics.Generic_Real_Arrays;
generic
   with package Matrix is new Ada.Numerics.Generic_Real_Arrays (<>);
package Decomposition is

   
   procedure Decompose (A : Matrix.Real_Matrix; P, L, U : out Matrix.Real_Matrix);

end Decomposition;
Task: Optional parameters








VB: Private Sub optional_parameters(theRange As String, _
        Optional ordering As Integer = 0, _
        Optional column As Integer = 1, _
        Optional reverse As Integer = 1)
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add _
        Key:=Range(theRange).Columns(column), _
        SortOn:=SortOnValues, _
        Order:=reverse, _
        DataOption:=ordering 
    With ActiveSheet.Sort
        .SetRange Range(theRange)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Public Sub main()
    
    
    
    
    
    
    
    
    
    optional_parameters theRange:="A1:C4", ordering:=1, column:=2, reverse:=1
End Sub




Ada: package Tables is

   type Table is private;

   type Ordering is (Lexicographic, Psionic, ...); 

   procedure Sort (It               : in out Table;
                   Order_By         : in Ordering := Lexicographic;
                   Column           : in Positive := 1;
                   Reverse_Ordering : in Boolean  := False);

private
   ... 
end Tables;
Task: Trabb Pardo–Knuth algorithm








VB: Function tpk(s)
	arr = Split(s," ")
	For i = UBound(arr) To 0 Step -1
		n = fx(CDbl(arr(i)))
		If  n > 400 Then
			WScript.StdOut.WriteLine arr(i) & " = OVERFLOW"
		Else
			WScript.StdOut.WriteLine arr(i) & " = " & n
		End If
	Next
End Function

Function fx(x)
	fx = Sqr(Abs(x))+5*x^3
End Function


WScript.StdOut.Write "Please enter a series of numbers:"
list = WScript.StdIn.ReadLine
tpk(list)




Ada: with Ada.Text_IO, Ada.Numerics.Generic_Elementary_Functions;

procedure Trabb_Pardo_Knuth is

   type Real is digits 6 range -400.0 .. 400.0;

   package TIO renames Ada.Text_IO;
   package FIO is new TIO.Float_IO(Real);
   package Math is new  Ada.Numerics.Generic_Elementary_Functions(Real);

   function F(X: Real) return Real is
   begin
      return (Math.Sqrt(abs(X)) + 5.0 * X**3);
   end F;

   Values: array(1 .. 11) of Real;

begin
   TIO.Put("Please enter 11 Numbers:");
   for I in Values'Range loop
      FIO.Get(Values(I));
   end loop;

   for I in reverse Values'Range loop
      TIO.Put("f(");
      FIO.Put(Values(I), Fore => 2, Aft => 3, Exp => 0);
      TIO.Put(")=");
      begin
         FIO.Put(F(Values(I)), Fore=> 4, Aft => 3, Exp => 0);
      exception
         when Constraint_Error => TIO.Put("
      end;
      TIO.New_Line;
   end loop;

end Trabb_Pardo_Knuth;