WeixiangYan/CodeTransOcean huggingface dataset:
Task: Pentagram








VB: Sub pentagram()
    With ActiveSheet.Shapes.AddShape(msoShape5pointStar, 10, 10, 400, 400)
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Line.Weight = 3
        .Line.ForeColor.RGB = RGB(0, 0, 255)
    End With
End Sub




Ada: with Ada.Numerics.Elementary_Functions;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Video.Rectangles;
with SDL.Events.Events;

procedure Pentagram is

   Width  : constant := 600;
   Height : constant := 600;
   Offset : constant := 300.0;
   Radius : constant := 250.0;

   use SDL.Video.Rectangles;
   use SDL.C;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   type Node_Id is mod 5;
   Nodes : array (Node_Id) of Point;

   procedure Calculate is
      use Ada.Numerics.Elementary_Functions;
   begin
      for I in Nodes'Range loop
         Nodes (I) := (X => int (Offset + Radius * Sin (Float (I), Cycle => 5.0)),
                       Y => int (Offset - Radius * Cos (Float (I), Cycle => 5.0)));
      end loop;
   end Calculate;

   function Orient_2D (A, B, C : Point) return int is
      ((B.X - A.X) * (C.Y - A.Y) - (B.Y - A.Y) * (C.X - A.X));

   procedure Fill is
      Count : Natural;
   begin
      for Y in int (Offset - Radius) .. int (Offset + Radius) loop
         for X in int (Offset - Radius) .. int (Offset + Radius) loop
            Count := 0;
            for Node in Nodes'Range loop
               Count := Count +
                 (if Orient_2D (Nodes (Node), Nodes (Node + 2), (X, Y)) > 0 then 1 else 0);
            end loop;
            if Count in 4 .. 5 then
               Renderer.Draw (Point => (X, Y));
            end if;
         end loop;
      end loop;
   end Fill;

   procedure Draw_Outline is
   begin
      for Node in Nodes'Range loop
         Renderer.Draw (Line => (Nodes (Node), Nodes (Node + 2)));
      end loop;
   end Draw_Outline;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         SDL.Events.Events.Wait (Event);
         exit when Event.Common.Event_Type = SDL.Events.Quit;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Pentagram",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));

   Calculate;
   Renderer.Set_Draw_Colour ((50, 50, 150, 255));
   Fill;
   Renderer.Set_Draw_Colour ((0, 220, 0, 255));
   Draw_Outline;
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Pentagram;
Task: Verify distribution uniformity_Chi-squared test








VB: Private Function Test4DiscreteUniformDistribution(ObservationFrequencies() As Variant, Significance As Single) As Boolean
    
    Dim Total As Long, Ei As Long, i As Integer
    Dim ChiSquared As Double, DegreesOfFreedom As Integer, p_value As Double
    Debug.Print "[1] ""Data set:"" ";
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        Total = Total + ObservationFrequencies(i)
        Debug.Print ObservationFrequencies(i); " ";
    Next i
    DegreesOfFreedom = UBound(ObservationFrequencies) - LBound(ObservationFrequencies)
    
    Ei = Total / (DegreesOfFreedom + 1)
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        ChiSquared = ChiSquared + (ObservationFrequencies(i) - Ei) ^ 2 / Ei
    Next i
    p_value = 1 - WorksheetFunction.ChiSq_Dist(ChiSquared, DegreesOfFreedom, True)
    Debug.Print
    Debug.Print "   Chi-squared test for given frequencies"
    Debug.Print "X-squared ="; ChiSquared; ", ";
    Debug.Print "df ="; DegreesOfFreedom; ", ";
    Debug.Print "p-value = "; Format(p_value, "0.0000")
    Test4DiscreteUniformDistribution = p_value > Significance
End Function
Public Sub test()
    Dim O() As Variant
    O = [{199809,200665,199607,200270,199649}]
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(O, 0.05); """"
    O = [{522573,244456,139979,71531,21461}]
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(O, 0.05); """"
End Sub




Ada: package Chi_Square is
   
   type Flt is digits 18;
   type Bins_Type is array(Positive range <>) of Natural;
   
   function Distance(Bins: Bins_Type) return Flt;
   
end Chi_Square;
Task: CSV to HTML translation








VB: Public Sub CSV_TO_HTML()
    input_ = "Character,Speech\n" & _
        "The multitude,The messiah! Show us the messiah!\n" & _
        "Brians mother,<angry>Now you listen here! He
            "he
        "The multitude,Who are you?\n" & _
        "Brians mother,I
        "The multitude,Behold his mother! Behold his mother!"
     
    Debug.Print "<table>" & vbCrLf & "<tr><td>"
    For i = 1 To Len(input_)
        Select Case Mid(input_, i, 1)
            Case "\"
                If Mid(input_, i + 1, 1) = "n" Then
                    Debug.Print "</td></tr>" & vbCrLf & "<tr><td>";
                    i = i + 1
                Else
                    Debug.Print Mid(input_, i, 1);
                End If
            Case ",": Debug.Print "</td><td>";
            Case "<": Debug.Print "&lt;";
            Case ">": Debug.Print "&gt;";
            Case "&": Debug.Print "&amp;";
            Case Else: Debug.Print Mid(input_, i, 1);
        End Select
    Next i
    Debug.Print "</td></tr>" & vbCrLf & "</table>"
End Sub




Ada: with Ada.Strings.Fixed;
with Ada.Text_IO;
with Templates_Parser;

procedure Csv2Html is
   use type Templates_Parser.Vector_Tag;

   Chars : Templates_Parser.Vector_Tag;
   Speeches : Templates_Parser.Vector_Tag;

   CSV_File : Ada.Text_IO.File_Type;
begin
   
   Ada.Text_IO.Open (File => CSV_File,
                     Mode => Ada.Text_IO.In_File,
                     Name => "data.csv");

   
   while not Ada.Text_IO.End_Of_File (CSV_File) loop
      declare
         Whole_Line : String := Ada.Text_IO.Get_Line (CSV_File);
         Comma_Pos : Natural := Ada.Strings.Fixed.Index (Whole_Line, ",");
      begin
         Chars := Chars & Whole_Line (Whole_Line'First .. Comma_Pos - 1);
         Speeches := Speeches & Whole_Line (Comma_Pos + 1 .. Whole_Line'Last);
      end;
   end loop;

   Ada.Text_IO.Close (CSV_File);

   
   declare
      Translations : constant Templates_Parser.Translate_Table :=
        (1 => Templates_Parser.Assoc ("CHAR", Chars),
         2 => Templates_Parser.Assoc ("SPEECH", Speeches));
   begin
      Ada.Text_IO.Put_Line
        (Templates_Parser.Parse ("table.tmplt", Translations));
   end;
end Csv2Html;
Task: Pythagorean triples








VB: Dim total As Variant, prim As Variant, maxPeri As Variant
Private Sub newTri(s0 As Variant, s1 As Variant, s2 As Variant)
    Dim p As Variant
    p = CDec(s0) + CDec(s1) + CDec(s2)
    If p <= maxPeri Then
        prim = prim + 1
        total = total + maxPeri \ p
        newTri s0 + 2 * (-s1 + s2), 2 * (s0 + s2) - s1, 2 * (s0 - s1 + s2) + s2
        newTri s0 + 2 * (s1 + s2), 2 * (s0 + s2) + s1, 2 * (s0 + s1 + s2) + s2
        newTri -s0 + 2 * (s1 + s2), 2 * (-s0 + s2) + s1, 2 * (-s0 + s1 + s2) + s2
      End If
End Sub
Public Sub Program_PythagoreanTriples()
    maxPeri = CDec(100)
    Do While maxPeri <= 10000000#
        prim = CDec(0)
        total = CDec(0)
        newTri 3, 4, 5
        Debug.Print "Up to "; maxPeri; ": "; total; " triples, "; prim; " primitives."
        maxPeri = maxPeri * 10
    Loop
End Sub




Ada: with Ada.Text_IO;

procedure Pythagorean_Triples is

   type Large_Natural is range 0 .. 2**63-1;
     

   procedure New_Triangle(A, B, C: Large_Natural;
                          Max_Perimeter: Large_Natural;
                          Total_Cnt, Primitive_Cnt: in out Large_Natural) is
      Perimeter: constant Large_Natural := A + B + C;
   begin
      if Perimeter <= Max_Perimeter then
         Primitive_Cnt := Primitive_Cnt + 1;
         Total_Cnt     := Total_Cnt + Max_Perimeter / Perimeter;
         New_Triangle(A-2*B+2*C,     2*A-B+2*C,    2*A-2*B+3*C,   Max_Perimeter, Total_Cnt, Primitive_Cnt);
         New_Triangle(A+2*B+2*C,     2*A+B+2*C,    2*A+2*B+3*C,   Max_Perimeter, Total_Cnt, Primitive_Cnt);
         New_Triangle(2*B+2*C-A,     B+2*C-2*A,    2*B+3*C-2*A,   Max_Perimeter, Total_Cnt, Primitive_Cnt);
      end if;
   end New_Triangle;

   T_Cnt, P_Cnt: Large_Natural;

begin
   for I in 1 .. 9 loop
      T_Cnt := 0;
      P_Cnt := 0;
      New_Triangle(3,4,5, 10**I, Total_Cnt => T_Cnt, Primitive_Cnt => P_Cnt);
      Ada.Text_IO.Put_Line("Up to 10 **" & Integer'Image(I) & " :" &
                             Large_Natural'Image(T_Cnt) & " Triples," &
                             Large_Natural'Image(P_Cnt) & " Primitives");
   end loop;
end Pythagorean_Triples;
Task: Call a foreign-language function








VB:   Declare Function CreateFileW Lib "Kernel32" (FileName As WString, DesiredAccess As Integer, ShareMode As Integer, SecurityAttributes As Integer, _
        CreateDisposition As Integer, Flags As Integer, Template As Integer) As Integer
  Declare Function WriteFile Lib "Kernel32" (fHandle As Integer, writeData As Ptr, numOfBytes As Integer, ByRef numOfBytesWritten As Integer, _
        overlapped As Ptr) As Boolean
  Declare Function GetLastError Lib "Kernel32" () As Integer
  Declare Function CloseHandle Lib "kernel32" (hObject As Integer) As Boolean
  
  Const FILE_SHARE_READ = &h00000001
  Const FILE_SHARE_WRITE = &h00000002
  Const OPEN_EXISTING = 3
  
  Dim fHandle As Integer = CreateFileW("C:\foo.txt", 0,  FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
  If fHandle > 0 Then
    Dim mb As MemoryBlock = "Hello, World!"
    Dim bytesWritten As Integer
    If Not WriteFile(fHandle, mb, mb.Size, bytesWritten, Nil) Then
      MsgBox("Error Number: " + Str(GetLastError))
    End If
    Call CloseHandle(fHandle)
  Else
    MsgBox("Error Number: " + Str(GetLastError))
  End If




Ada: with Ada.Text_IO;           use Ada.Text_IO;
with Interfaces.C;          use Interfaces.C;
with Interfaces.C.Strings;  use Interfaces.C.Strings;

procedure Test_C_Interface is
   function strdup (s1 : Char_Array) return Chars_Ptr;
   pragma Import (C, strdup, "_strdup");

   S1 : constant String := "Hello World!";
   S2 : Chars_Ptr;
begin
   S2 := strdup (To_C (S1));
   Put_Line (Value (S2));
   Free (S2);
end Test_C_Interface;
Task: Gray code








VB: Function Encoder(ByVal n)
    Encoder = n Xor (n \ 2)
End Function

Function Decoder(ByVal n)
    Dim g : g = 0
    Do While n > 0
       g = g Xor n
       n = n \ 2
    Loop
    Decoder = g
End Function


Function Dec2bin(ByVal n, ByVal length)
    Dim i, strbin : strbin = ""
    For i = 1 to 5
        strbin = (n Mod 2) & strbin
        n = n \ 2
    Next
    Dec2Bin = strbin
End Function

WScript.StdOut.WriteLine("Binary -> Gray Code -> Binary")
For i = 0 to 31
    encoded = Encoder(i)
    decoded = Decoder(encoded)
    WScript.StdOut.WriteLine(Dec2Bin(i, 5) & " -> " & Dec2Bin(encoded, 5) & " -> " & Dec2Bin(decoded, 5))
Next




Ada: with Ada.Text_IO, Interfaces;
use Ada.Text_IO, Interfaces;

procedure Gray is

   Bits : constant := 5; 
   subtype Values is Unsigned_8 range 0 .. 2 ** Bits - 1;
   package Values_Io is new Ada.Text_IO.Modular_IO (Values);

   function Encode (Binary : Values) return Values is
   begin
      return Binary xor Shift_Right (Binary, 1);
   end Encode;
   pragma Inline (Encode);

   function Decode (Gray : Values) return Values is
      Binary, Bit : Values;
      Mask        : Values := 2 ** (Bits - 1);
   begin
      Bit    := Gray and Mask;
      Binary := Bit;
      for I in 2 .. Bits loop
         Bit    := Shift_Right (Bit, 1);
         Mask   := Shift_Right (Mask, 1);
         Bit    := (Gray and Mask) xor Bit;
         Binary := Binary + Bit;
      end loop;
      return Binary;
   end Decode;
   pragma Inline (Decode);

   HT : constant Character := Character'Val (9);
   J  : Values;
begin
   Put_Line ("Num" & HT & "Binary" & HT & HT & "Gray" & HT & HT & "decoded");
   for I in Values'Range loop
      J := Encode (I);
      Values_Io.Put (I, 4);
      Put (": " & HT);
      Values_Io.Put (I, Bits + 2, 2);
      Put (" =>" & HT);
      Values_Io.Put (J, Bits + 2, 2);
      Put (" => " & HT);
      Values_Io.Put (Decode (J), 4);
      New_Line;
   end loop;
end Gray;
Task: Flow-control structures








VB:   Sub bar2()
      Dim x = 0
      GoTo label
      x = 5
label:
      Console.WriteLine(x)
  End Sub




Ada: <<Top>>
   Put_Line("Hello, World");
   goto Top;
Task: Return multiple values








VB: Type Contact
    Name As String
    firstname As String
    Age As Byte
End Type

Function SetContact(N As String, Fn As String, A As Byte) As Contact
    SetContact.Name = N
    SetContact.firstname = Fn
    SetContact.Age = A
End Function


Sub Test_SetContact()
Dim Cont As Contact

    Cont = SetContact("SMITH", "John", 23)
    Debug.Print Cont.Name & " " & Cont.firstname & ", " & Cont.Age & " years old."
End Sub




Ada: with Ada.Text_IO; use Ada.Text_IO;
procedure MultiReturn is
   procedure SumAndDiff (x, y : Integer; sum, diff : out Integer) is begin
      sum := x + y;
      diff := x - y;
   end SumAndDiff;
   inta : Integer := 5;
   intb : Integer := 3;
   thesum, thediff : Integer;
begin
   SumAndDiff (inta, intb, thesum, thediff);
   Put_Line ("Sum:" & Integer'Image (thesum));
   Put_Line ("Diff:" & Integer'Image (thediff));
end MultiReturn;
Task: Change e letters to i in words








VB: with createobject("ADODB.Stream")
  .charset ="UTF-8"
  .open
  .loadfromfile("unixdict.txt")
  s=.readtext
end with  
a=split (s,vblf)
set d=createobject("scripting.dictionary")
redim b(ubound(a))
i=0
for each x in a
  s=trim(x)
  if len(s)>5 then 
    if instr(s,"i") then d.add s,""
    if instr(s,"e") then b(i)=s:  i=i+1   
  end if
next
redim preserve b(i-1)

for i=0 to ubound(b)
  s=trim(b(i))
  s2=replace(s,"e","i")
  if d.exists(s2) then 
    wscript.echo left(s& space(10),10) & "-> " & s2
  end if 
next




Ada: with Ada.Text_Io;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Containers.Indefinite_Ordered_Maps;

procedure Change_E_To_I is
   use Ada.Text_Io;
   use Ada.Strings;

   Filename : constant String := "unixdict.txt";
   Mapping  : constant Maps.Character_Mapping :=
     Maps.To_Mapping ("Ee", "Ii");

   package Dictionaries is
     new Ada.Containers.Indefinite_Ordered_Maps
       (Key_Type     => String,
        Element_Type => String);

   Dict    : Dictionaries.Map;
   File    : File_Type;
begin
   Open (File, In_File, Filename);
   while not End_Of_File (File) loop
      declare
         Word : constant String := Get_Line (File);
      begin
         Dict.Insert (Word, Word);
      end;
   end loop;
   Close (File);

   for Word of Dict loop
      declare
         Trans : constant String := Fixed.Translate (Word, Mapping);
      begin
         if Word /= Trans and Dict.Contains (Trans) and Word'Length >= 6 then
            Put (Word); Put (" -> "); Put (Trans); New_Line;
         end if;
      end;
   end loop;
end Change_E_To_I;
Task: Substring_Top and tail








VB: string = "Small Basic"
TextWindow.WriteLine(Text.GetSubTextToEnd(string, 2)) 
TextWindow.WriteLine(Text.GetSubText(string, 1, Text.GetLength(string) - 1)) 
TextWindow.WriteLine(Text.GetSubText(string, 2, Text.GetLength(string) - 2)) 




Ada: with Ada.Text_IO;

procedure Remove_Characters is
   S: String := "upraisers";
   use Ada.Text_IO;
begin
   Put_Line("Full String:   """ & S & """");
   Put_Line("Without_First: """ & S(S'First+1 .. S'Last) & """");
   Put_Line("Without_Last:  """ & S(S'First   .. S'Last-1) & """");
   Put_Line("Without_Both:  """ & S(S'First+1 .. S'Last-1) & """");
end Remove_Characters;
Task: Boolean values








VB: Dim a As Integer
Dim b As Boolean
Debug.Print b
a = b
Debug.Print a
b = True
Debug.Print b
a = b
Debug.Print a




Ada:    type Boolean is (False, True);
Task: Plot coordinate pairs








VB: Private Sub plot_coordinate_pairs(x As Variant, y As Variant)
    Dim chrt As Chart
    Set chrt = ActiveSheet.Shapes.AddChart.Chart
    With chrt
        .ChartType = xlLine
        .HasLegend = False
        .HasTitle = True
        .ChartTitle.Text = "Time"
        .SeriesCollection.NewSeries
        .SeriesCollection.Item(1).XValues = x
        .SeriesCollection.Item(1).Values = y
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "microseconds"
    End With
End Sub
Public Sub main()
    x = [{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}]
    y = [{2.7, 2.8, 31.4, 38.1, 58.0, 76.2, 100.5, 130.0, 149.3, 180.0}]
    plot_coordinate_pairs x, y
End Sub




Ada: with Gtk.Main;
with Gtk.Window;  use Gtk.Window;
with Gtk.Widget;  use Gtk.Widget;
with Gtk.Handlers;  use Gtk.Handlers;
with Glib;  use Glib;
with Gtk.Extra.Plot;  use Gtk.Extra.Plot;
with Gtk.Extra.Plot_Data;  use Gtk.Extra.Plot_Data;
with Gtk.Extra.Plot_Canvas;  use Gtk.Extra.Plot_Canvas;
with Gtk.Extra.Plot_Canvas.Plot;  use Gtk.Extra.Plot_Canvas.Plot;

procedure PlotCoords is
   package Handler is new Callback (Gtk_Widget_Record);

   Window : Gtk_Window;
   Plot : Gtk_Plot;
   PCP : Gtk_Plot_Canvas_Plot;
   Canvas : Gtk_Plot_Canvas;
   PlotData : Gtk_Plot_Data;
   x, y, dx, dy : Gdouble_Array_Access;

   procedure ExitMain (Object : access Gtk_Widget_Record'Class) is
   begin
      Destroy (Object);  Gtk.Main.Main_Quit;
   end ExitMain;

begin
   x := new Gdouble_Array'(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0);
   y := new Gdouble_Array'(2.7, 2.8, 31.4, 38.1, 58.0, 76.2, 100.5, 130.0, 149.3, 180.0);
   Gtk.Main.Init;
   Gtk_New (Window);
   Set_Title (Window, "Plot coordinate pairs with GtkAda");
   Gtk_New (PlotData);
   Set_Points (PlotData, x, y, dx, dy);
   Gtk_New (Plot);
   Add_Data (Plot, PlotData);
   Autoscale (Plot);  Show (PlotData);
   Hide_Legends (Plot);
   Gtk_New (PCP, Plot);  Show (Plot);
   Gtk_New (Canvas, 500, 500);  Show (Canvas);
   Put_Child (Canvas, PCP, 0.15, 0.15, 0.85, 0.85);
   Add (Window, Canvas);
   Show_All (Window);
   Handler.Connect (Window, "destroy",
      Handler.To_Marshaller (ExitMain'Access));
   Gtk.Main.Main;
end PlotCoords;
Task: Use another language to call a function




Go: package main



import "C"
import "unsafe"

func main() {
    C.Run()
}

const msg = "Here am I"


func Query(cbuf *C.char, csiz *C.size_t) C.int {
    if int(*csiz) <= len(msg) {
        return 0
    }
    pbuf := uintptr(unsafe.Pointer(cbuf))
    for i := 0; i < len(msg); i++ {
        *((*byte)(unsafe.Pointer(pbuf))) = msg[i]
        pbuf++
    }
    *((*byte)(unsafe.Pointer(pbuf))) = 0
    *csiz = C.size_t(len(msg) + 1)
    return 1
}
Task: Long year








VB: DEFINT A-Z

DECLARE FUNCTION p% (Yr AS INTEGER)
DECLARE FUNCTION LongYear% (Yr AS INTEGER)

DIM iYi, iYf, i

CLS
PRINT "This program calculates which are 53-week years in a range."
PRINT
INPUT "Initial year"; iYi
INPUT "Final year (could be the same)"; iYf
IF iYf >= iYi THEN
  FOR i = iYi TO iYf
    IF LongYear(i) THEN
      PRINT i; " ";
    END IF
  NEXT i
END IF
PRINT
PRINT
PRINT "End of program."
END

FUNCTION LongYear% (Yr AS INTEGER)
  LongYear% = (p%(Yr) = 4) OR (p%(Yr - 1) = 3)
END FUNCTION

FUNCTION p% (Yr AS INTEGER)
  p% = (Yr + INT(Yr / 4) - INT(Yr / 100) + INT(Yr / 400)) MOD 7
END FUNCTION
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
Task: Logistic curve fitting in epidemiology


C++: #include <cmath>
#include <functional>
#include <iostream>

constexpr double K = 7.8e9;
constexpr int n0 = 27;
constexpr double actual[] = {
    27, 27, 27, 44, 44, 59, 59, 59, 59, 59, 59, 59, 59, 60, 60,
    61, 61, 66, 83, 219, 239, 392, 534, 631, 897, 1350, 2023, 2820,
    4587, 6067, 7823, 9826, 11946, 14554, 17372, 20615, 24522, 28273,
    31491, 34933, 37552, 40540, 43105, 45177, 60328, 64543, 67103,
    69265, 71332, 73327, 75191, 75723, 76719, 77804, 78812, 79339,
    80132, 80995, 82101, 83365, 85203, 87024, 89068, 90664, 93077,
    95316, 98172, 102133, 105824, 109695, 114232, 118610, 125497,
    133852, 143227, 151367, 167418, 180096, 194836, 213150, 242364,
    271106, 305117, 338133, 377918, 416845, 468049, 527767, 591704,
    656866, 715353, 777796, 851308, 928436, 1000249, 1082054, 1174652
};

double f(double r) {
    double sq = 0;
    constexpr size_t len = std::size(actual);
    for (size_t i = 0; i < len; ++i) {
        double eri = std::exp(r * i);
        double guess = (n0 * eri)/(1 + n0 * (eri - 1)/K);
        double diff = guess - actual[i];
        sq += diff * diff;
    }
    return sq;
}

double solve(std::function<double(double)> fn, double guess=0.5, double epsilon=0) {
    for (double delta = guess ? guess : 1, f0 = fn(guess), factor = 2;
             delta > epsilon && guess != guess - delta;
             delta *= factor) {
        double nf = fn(guess - delta);
        if (nf < f0) {
            f0 = nf;
            guess -= delta;
        } else {
            nf = fn(guess + delta);
            if (nf < f0) {
                f0 = nf;
                guess += delta;
            } else
                factor = 0.5;
        }
    }
    return guess;
}

int main() {
    double r = solve(f);
    double R0 = std::exp(12 * r);
    std::cout << "r = " << r << ", R0 = " << R0 << '\n';
    return 0;
}
Task: Call a foreign-language function






PHP: $ffi = FFI::cdef("char *_strdup(const char *strSource);", "msvcrt.dll");

$cstr = $ffi->_strdup("success");
$str = FFI::string($cstr);
echo $str;
FFI::free($cstr);




COBOL:        identification division.
       program-id. foreign.

       data division.
       working-storage section.
       01 hello.
          05 value z"Hello, world".
       01 duplicate    usage pointer.
       01 buffer       pic x(16) based.
       01 storage      pic x(16).

       procedure division.
       call "strdup" using hello returning duplicate
           on exception
               display "error calling strdup" upon syserr
       end-call
       if duplicate equal null then
           display "strdup returned null" upon syserr
       else
           set address of buffer to duplicate
           string buffer delimited by low-value into storage
           display function trim(storage)
           call "free" using by value duplicate
               on exception
                   display "error calling free" upon syserr
       end-if
       goback.
Task: Flow-control structures






PHP: <?php
goto a;
echo 'Foo';
 
a:
echo 'Bar';
?>




COBOL:        PROGRAM-ID. Go-To-Example.

       PROCEDURE DIVISION.
       Foo.
           DISPLAY "Just a reminder: GO TOs are evil."

           GO TO Foo
           .