WeixiangYan/CodeTransOcean huggingface dataset:
Task: ABC words



C#: class Program {
    static void Main(string[] args) { int bi, i = 0; string chars = args.Length < 1 ? "abc" : args[0];
        foreach (var item in System.IO.File.ReadAllLines("unixdict.txt")) {
            int ai = -1; foreach (var ch in chars)
                if ((bi = item.IndexOf(ch)) > ai) ai = bi; else goto skip;
            System.Console.Write("{0,3} {1,-18} {2}", ++i, item, i % 5 == 0 ? "\n" : "");
        skip: ; } }
}









Ada: with Ada.Text_Io;
with Ada.Strings.Fixed;

procedure Abc_Words is
   use Ada.Text_Io;

   function Is_Abc_Word (Word : String) return Boolean is
      use Ada.Strings.Fixed;
      Pos_A : constant Natural := Index (Word, "a");
      Pos_B : constant Natural := Index (Word, "b");
      Pos_C : constant Natural := Index (Word, "c");
   begin
      return
        Pos_B > Pos_A and Pos_C > Pos_B and
        Pos_A /= 0 and Pos_B /= 0 and Pos_C /= 0;
   end Is_Abc_Word;

   Filename : constant String := "unixdict.txt";
   File     : File_Type;
   Column   : Ada.Text_Io.Count := 0;
begin
   Open (File, In_File, Filename);
   while not End_Of_File (File) loop
      declare
         Word : constant String := Get_Line (File);
      begin
         if Is_Abc_Word (Word) then
            Set_Col (1 + Column);
            Column := (Column + 15) mod 120;
            Put (Word);
         end if;
      end;
   end loop;
   Close (File);
end Abc_Words;
Task: Two identical strings



C#: using System; using static System.Console;
class Program { static void Main() { int c = 0, lmt = 1000;
    for (int n = 1, p = 2, k; n <= lmt; n++)
      if ((k = n + n * (p += n >= p ? p : 0)) > lmt) break;
      else Console.Write("{0,3} ({1,-10})  {2}", k,
          Convert.ToString(k, 2), ++c % 5 == 0 ? "\n" : "");
    Write("\nFound {0} numbers whose base 2 representation is the " +
      "concatenation of two identical binary strings.", c); } }









Ada: with Ada.Text_Io;        use Ada.Text_Io;
with Ada.Strings.Fixed;  use Ada.Strings.Fixed;

procedure Two_Identical is
   package Integer_Io is
     new Ada.Text_Io.Integer_Io (Integer);
   use Integer_Io;

   Image : String (1 .. 16);
   Pos_1, Pos_2 : Natural;
   Mid  : Natural;
begin
   for N in 1 .. 1000 loop
      Put (Image, N, Base => 2);
      Pos_1 := Index (Image, "#");
      Pos_2 := Index (Image, "#", Pos_1 + 1);
      Mid := (Pos_1 + Pos_2) / 2;
      if Image (Pos_1 + 1 .. Mid) = Image (Mid + 1 .. Pos_2 - 1) then
         Put (N, Width => 3); Put ("  "); Put (Image); New_Line;
      end if;
   end loop;
end Two_Identical;
Task: Sum of first n cubes



C#: using System; using static System.Console;
class Program { static void Main(string[] args) {
    for (int i=0,j=-6,k=1,c=0,s=0;s<1600000;s+=c+=k+=j+=6)
      Write("{0,-7}{1}",s, (i+=i==3?-4:1)==0?"\n":" "); } }









Ada: with Ada.Text_Io;

procedure Sum_Of_First_N_Cubes is

   Columns : constant := 10;
   Width   : constant := 8;

   package Natural_Io is new Ada.Text_Io.Integer_Io (Natural);
   use Ada.Text_Io, Natural_Io;

   Sum : Natural := 0;
begin
   for N in 0 .. 49 loop
      Sum := Sum + N ** 3;
      Put (Sum, Width => Width);
      if N mod Columns = Columns - 1 then
         New_Line;
      end if;
   end loop;
   New_Line;
end Sum_Of_First_N_Cubes;
Task: Append numbers at same position in strings




Go: package main

import "fmt"

func main() {
    list1 := [9]int{1, 2, 3, 4, 5, 6, 7, 8, 9}
    list2 := [9]int{10, 11, 12, 13, 14, 15, 16, 17, 18}
    list3 := [9]int{19, 20, 21, 22, 23, 24, 25, 26, 27}
    var list [9]int
    for i := 0; i < 9; i++ {
        list[i] = list1[i]*1e4 + list2[i]*1e2 + list3[i]
    }
    fmt.Println(list)
}
Task: Call a function







Python: def no_args():
    pass

no_args()

def fixed_args(x, y):
    print('x=%r, y=%r' % (x, y))

fixed_args(1, 2)        


fixed_args(y=2, x=1)


myargs=(1,2) 
fixed_args(*myargs)

def opt_args(x=1):
    print(x)

opt_args()              
opt_args(3.141)         

def var_args(*v):
    print(v)

var_args(1, 2, 3)       
var_args(1, (2,3))      
var_args()              


fixed_args(y=2, x=1)    


if 1:
    no_args()


assert no_args() is None

def return_something():
    return 1
x = return_something()

def is_builtin(x):
	print(x.__name__ in dir(__builtins__))

is_builtin(pow)         
is_builtin(is_builtin)  



def takes_anything(*args, **kwargs):
    for each in args:
        print(each)
    for key, value in sorted(kwargs.items()):
        print("%s:%s" % (key, value))
    
    wrapped_fn(*args, **kwargs)
Task: Image convolution







Python: 
from PIL import Image, ImageFilter

if __name__=="__main__":
	im = Image.open("test.jpg")

	kernelValues = [-2,-1,0,-1,1,1,0,1,2] 
	kernel = ImageFilter.Kernel((3,3), kernelValues)

	im2 = im.filter(kernel)

	im2.show()
Task: Copy a string







Python: >>> src = "hello"
>>> a = src
>>> b = src[:]
>>> import copy
>>> c = copy.copy(src)
>>> d = copy.deepcopy(src)
>>> src is a is b is c is d
True
Task: Include a file







Python: import one
Task: String comparison







Python: fun compare(a, b):
    print("\n$a is of type ${typeof(a)} and $b is of type ${typeof(b)}")
    if a < b: print("$a is strictly less than $b")
    if a <= b: print("$a is less than or equal to $b")
    if a >  b: print("$a is strictly greater than $b")
    if a >= b: print("$a is greater than or equal to $b")
    if a == b: print("$a is equal to $b")
    if a != b: print("$a is not equal to $b")
    if a is b: print("$a has object identity with $b")
    if a is not b: print("$a has negated object identity with $b")

compare("YUP", "YUP")
compare('a', 'z')
compare("24", "123")
compare(24, 123)
compare(5.0, 5)
Task: Waveform analysis_Top and tail

C: #include <stdio.h>
#include <stdio_ext.h>
#include <stdlib.h>
#include <string.h>
#include "wren.h"

void C_getInput(WrenVM* vm) {
    int maxSize = (int)wrenGetSlotDouble(vm, 1) + 2;
    char input[maxSize];
    fgets(input, maxSize, stdin);
    __fpurge(stdin);
    input[strcspn(input, "\n")] = 0;
    wrenSetSlotString(vm, 0, (const char*)input);
}

void C_sox(WrenVM* vm) {
    const char *args = wrenGetSlotString(vm, 1);
    char command[strlen(args) + 4];
    strcpy(command, "sox ");
    strcat(command, args);
    system(command);
}

void C_removeFile(WrenVM* vm) {
    const char *name = wrenGetSlotString(vm, 1);
    if (remove(name) != 0) perror("Error deleting file.");
}

WrenForeignMethodFn bindForeignMethod(
    WrenVM* vm,
    const char* module,
    const char* className,
    bool isStatic,
    const char* signature) {
    if (strcmp(module, "main") == 0) {
        if (strcmp(className, "C") == 0) {
            if (isStatic && strcmp(signature, "getInput(_)") == 0)   return C_getInput;
            if (isStatic && strcmp(signature, "sox(_)") == 0)        return C_sox;
            if (isStatic && strcmp(signature, "removeFile(_)") == 0) return C_removeFile;
        }
    }
    return NULL;
}

static void writeFn(WrenVM* vm, const char* text) {
    printf("%s", text);
}

void errorFn(WrenVM* vm, WrenErrorType errorType, const char* module, const int line, const char* msg) {
    switch (errorType) {
        case WREN_ERROR_COMPILE:
            printf("[%s line %d] [Error] %s\n", module, line, msg);
            break;
        case WREN_ERROR_STACK_TRACE:
            printf("[%s line %d] in %s\n", module, line, msg);
            break;
        case WREN_ERROR_RUNTIME:
            printf("[Runtime Error] %s\n", msg);
            break;
    }
}

char *readFile(const char *fileName) {
    FILE *f = fopen(fileName, "r");
    fseek(f, 0, SEEK_END);
    long fsize = ftell(f);
    rewind(f);
    char *script = malloc(fsize + 1);
    fread(script, 1, fsize, f);
    fclose(f);
    script[fsize] = 0;
    return script;
}

int main(int argc, char **argv) {
    WrenConfiguration config;
    wrenInitConfiguration(&config);
    config.writeFn = &writeFn;
    config.errorFn = &errorFn;
    config.bindForeignMethodFn = &bindForeignMethod;
    WrenVM* vm = wrenNewVM(&config);
    const char* module = "main";
    const char* fileName = "waveform_analysis_top_and_tail.wren";
    char *script = readFile(fileName);
    WrenInterpretResult result = wrenInterpret(vm, module, script);
    switch (result) {
        case WREN_RESULT_COMPILE_ERROR:
            printf("Compile Error!\n");
            break;
        case WREN_RESULT_RUNTIME_ERROR:
            printf("Runtime Error!\n");
            break;
        case WREN_RESULT_SUCCESS:
            break;
    }
    wrenFreeVM(vm);
    free(script);
    return 0;
}
Task: Air mass







Python: 

from math import sqrt, cos, exp

DEG = 0.017453292519943295769236907684886127134  
RE = 6371000                                     
dd = 0.001      
FIN = 10000000  
 
def rho(a):
    
    return exp(-a / 8500.0)
 
def height(a, z, d):
     
    return sqrt((RE + a)**2 + d**2 - 2 * d * (RE + a) * cos((180 - z) * DEG)) - RE
 
def column_density(a, z):
    
    dsum, d = 0.0, 0.0
    while d < FIN:
        delta = max(dd, (dd)*d)  
        dsum += rho(height(a, z, d + 0.5 * delta)) * delta
        d += delta
    return dsum

def airmass(a, z):
    return column_density(a, z) / column_density(a, 0)

print('Angle           0 m          13700 m\n', '-' * 36)
for z in range(0, 91, 5):
    print(f"{z: 3d}      {airmass(0, z): 12.7f}    {airmass(13700, z): 12.7f}")
Task: Deceptive numbers







Python: from itertools import count, islice
from math import isqrt

def is_deceptive(n):
    if n & 1 and n % 3 and n % 5 and pow(10, n - 1, n * 9) == 1:
        for d in range(7, isqrt(n) + 1, 6):
            if not (n % d and n % (d + 4)): return True
    return False

print(*islice(filter(is_deceptive, count()), 100))
Task: Bitmap_Bézier curves_Cubic






PHP: <?

$image = imagecreate(200, 200);

imagecolorallocate($image, 255, 255, 255);
$color = imagecolorallocate($image, 255, 0, 0);
cubicbezier($image, $color, 160, 10, 10, 40, 30, 160, 150, 110);
imagepng($image);

function cubicbezier($img, $col, $x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3, $n = 20) {
	$pts = array();

	for($i = 0; $i <= $n; $i++) {
		$t = $i / $n;
		$t1 = 1 - $t;
		$a = pow($t1, 3);
		$b = 3 * $t * pow($t1, 2);
		$c = 3 * pow($t, 2) * $t1;
		$d = pow($t, 3);

		$x = round($a * $x0 + $b * $x1 + $c * $x2 + $d * $x3);
		$y = round($a * $y0 + $b * $y1 + $c * $y2 + $d * $y3);
		$pts[$i] = array($x, $y);
	}

	for($i = 0; $i < $n; $i++) {
		imageline($img, $pts[$i][0], $pts[$i][1], $pts[$i+1][0], $pts[$i+1][1], $col);
	}
}





Fortran: subroutine cubic_bezier(img, p1, p2, p3, p4, color)
  type(rgbimage), intent(inout) :: img
  type(point), intent(in) :: p1, p2, p3, p4
  type(rgb), intent(in) :: color

  integer :: i, j
  real :: pts(0:N_SEG,0:1), t, a, b, c, d, x, y

  do i = 0, N_SEG
     t = real(i) / real(N_SEG)
     a = (1.0 - t)**3.0
     b = 3.0 * t * (1.0 - t)**2
     c = 3.0 * (1.0 - t) * t**2
     d = t**3.0
     x = a * p1%x + b * p2%x + c * p3%x + d * p4%x
     y = a * p1%y + b * p2%y + c * p3%y + d * p4%y
     pts(i,0) = x
     pts(i,1) = y
  end do

  do i = 0, N_SEG-1
     j = i + 1
     call draw_line(img, point(pts(i,0), pts(i,1)), &
                    point(pts(j,0), pts(j,1)), color)
  end do

end subroutine cubic_bezier
Task: Hello world_Line printer






PHP: <?php
file_put_contents('/dev/lp0', 'Hello world!');
?>





Fortran:       WRITE (6,1)
    1 FORMAT ("+HELLO WORLD
      END
Task: Count occurrences of a substring






PHP: <?php
echo substr_count("the three truths", "th"), PHP_EOL; // prints "3"
echo substr_count("ababababab", "abab"), PHP_EOL; // prints "2"





Fortran: program Example
  implicit none
  integer :: n
  
  n = countsubstring("the three truths", "th")
  write(*,*) n
  n = countsubstring("ababababab", "abab")
  write(*,*) n
  n = countsubstring("abaabba*bbaba*bbab", "a*b")
  write(*,*) n
 
contains

function countsubstring(s1, s2) result(c)
  character(*), intent(in) :: s1, s2
  integer :: c, p, posn
 
  c = 0
  if(len(s2) == 0) return
  p = 1
  do 
    posn = index(s1(p:), s2)
    if(posn == 0) return
    c = c + 1
    p = p + posn + len(s2) - 1
  end do
end function
end program
Task: Rock-paper-scissors






PHP: <?php
echo "<h1>" . "Choose: ROCK - PAPER - SCISSORS" . "</h1>";
echo "<h2>";
echo "";

$player = strtoupper( $_GET["moves"] );
$wins = [
    'ROCK' => 'SCISSORS',
    'PAPER' => 'ROCK',
    'SCISSORS' => 'PAPER'
  ];
$a_i = array_rand($wins);
echo "<br>";
echo "Player chooses " . "<i style=\"color:blue\">" . $player . "</i>";
echo "<br>";
echo "<br>" . "A.I chooses " . "<i style=\"color:red\">"  . $a_i . "</i>";

$results = "";
if ($player == $a_i){
$results = "Draw";
} else if($wins[$a_i] == $player ){
  $results = "A.I wins";
} else {
  $results = "Player wins";
}

echo "<br>" . $results;
?>





Fortran: 


















program rpsgame

  integer, parameter :: COMPUTER=1, HAPLESSUSER=2
  integer, dimension(3) :: rps = (/1,1,1/)
  real, dimension(3) :: p
  character :: answer, cc 
  integer :: exhaustion, i
  real, dimension(2) :: score = (/0, 0/)
  character(len=8), dimension(3) :: choices = (/'rock    ','paper   ','scissors'/)
  real :: harvest
  do exhaustion = 1, 30
    p = rps/real(sum(rps))
    p(2) = p(2) + p(1)
    p(3) = p(3) + p(2)
    call random_number(harvest)
    i = sum(merge(1,0,harvest.le.p)) 
    cc = 'rsp'(i:i)
    write(6, "(2(A,', '),A,'?  ')", advance='no')(trim(choices(i)),i=1,size(choices))
    read(5, *) answer
    write(6, "('scoring computer choice (',A,') and your choice (',A,')')")cc,answer
    if (answer.eq.cc) then
      score = score + 0.5
    else
      i = HAPLESSUSER
      if (answer.eq.'r') then
        if (cc.eq.'p') i = COMPUTER
      else if (answer.eq.'p') then
        if (cc.eq.'s') i = COMPUTER
      else if (answer.eq.'s') then
        if (cc.eq.'r') i = COMPUTER
      else
        exit
      endif
      score(i) = score(i) + 1
    end if
    i = scan('rps',answer)
    rps(i) = rps(i) + 1
  end do
  if (25 .lt. exhaustion) write(6, *) "I'm bored out of my skull"
  write(6, *)"Who's keeping score anyway???"
  write(6, '(2f5.1)') score
  if (score(COMPUTER) .lt. score(HAPLESSUSER)) print*,'you won
end program rpsgame
Task: Case-sensitivity of identifiers






PHP: <?php



$dog = 'Benjamin';
$Dog = 'Samba';
$DOG = 'Bernie';

echo "There are 3 dogs named {$dog}, {$Dog} and {$DOG}\n";


function DOG() { return 'Bernie'; }

echo 'There is only 1 dog named ' . dog() . "\n";





Fortran: program Example
  implicit none

  character(8) :: dog, Dog, DOG

  dog = "Benjamin"
  Dog = "Samba"
  DOG = "Bernie"

  if (dog == DOG) then
    write(*,*) "There is just one dog named ", dog
  else
    write(*,*) "The three dogs are named ", dog, Dog, " and ", DOG
  end if

end program Example
Task: Sorting algorithms_Stooge sort






PHP: function stoogeSort(&$arr, $i, $j)
{
	if($arr[$j] < $arr[$i])
	{
		list($arr[$j],$arr[$i]) = array($arr[$i], $arr[$j]);
	}
	if(($j - $i) > 1)
	{
		$t = ($j - $i + 1) / 3;
		stoogesort($arr, $i, $j - $t);
		stoogesort($arr, $i + $t, $j);
		stoogesort($arr, $i, $j - $t);
	}
}





Fortran: program Stooge
  implicit none

  integer :: i
  integer :: array(50) = (/ (i, i = 50, 1, -1) /) 
  
  call Stoogesort(array)
  write(*,"(10i5)") array

contains

recursive subroutine Stoogesort(a)
  integer, intent(in out) :: a(:)
  integer :: j, t, temp
 
   j = size(a)
   if(a(j) < a(1)) then
     temp = a(j)
     a(j) = a(1)
     a(1) = temp
   end if

  if(j > 2) then
    t = j / 3
    call Stoogesort(a(1:j-t))
    call Stoogesort(a(1+t:j))
    call Stoogesort(a(1:j-t)) 
  end if

end subroutine
end program
Task: Sorting algorithms_Shell sort






PHP: function shellSort($arr)
{
	$inc = round(count($arr)/2);
	while($inc > 0)
	{
		for($i = $inc; $i < count($arr);$i++){
			$temp = $arr[$i];
			$j = $i;
			while($j >= $inc && $arr[$j-$inc] > $temp)
			{
				$arr[$j] = $arr[$j - $inc];
				$j -= $inc;
			}
			$arr[$j] = $temp;
		}
		$inc = round($inc/2.2);
	}
	return $arr;
}





Fortran: MODULE sort

CONTAINS

SUBROUTINE Shell_Sort(a)

  IMPLICIT NONE
  INTEGER :: i, j, increment
  REAL :: temp
  REAL, INTENT(in out) :: a(:)
	
  increment = SIZE(a) / 2
  DO WHILE (increment > 0)
      DO i = increment+1, SIZE(a)
         j = i
         temp = a(i)
         DO WHILE (j >= increment+1 .AND. a(j-increment) > temp)
            a(j) = a(j-increment)
            j = j - increment
         END DO
         a(j) = temp
      END DO
      IF (increment == 2) THEN
   	  increment = 1
      ELSE
         increment = increment * 5 / 11
      END IF      
  END DO
 
END SUBROUTINE Shell_Sort

END MODULE sort

PROGRAM Shellsort

USE sort

  IMPLICIT NONE
  REAL :: array(1000)
     
  CALL RANDOM_SEED
  CALL RANDOM_NUMBER(array)
 
  WRITE (*,*) "Unsorted array"
  WRITE (*,*) array
  WRITE (*,*) 
  CALL Shell_Sort(array)
  WRITE (*,*) "Sorted array"
  WRITE (*,*) array
  
END PROGRAM Shellsort
Task: Trabb Pardo–Knuth algorithm






PHP: <?php



function f($n)
{
    return sqrt(abs($n)) + 5 * $n * $n * $n;
}

$sArray = [];
echo "Enter 11 numbers.\n";
for ($i = 0; $i <= 10; $i++) {
    echo $i + 1, " - Enter number: "; 
    array_push($sArray, (float)fgets(STDIN)); 
}
echo PHP_EOL;

$sArray = array_reverse($sArray);

foreach ($sArray as $s) {
    $r = f($s);
    echo "f(", $s, ") = ";
    if ($r > 400) 
        echo "overflow\n";
    else
        echo $r, PHP_EOL;
}
?>





Fortran: program tpk
  implicit none
  
  real, parameter :: overflow = 400.0
  real :: a(11), res
  integer :: i
 
  write(*,*) "Input eleven numbers:"
  read(*,*) a
 
  a = a(11:1:-1)
  do i = 1, 11
    res = f(a(i))
    write(*, "(a, f0.3, a)", advance = "no") "f(", a(i), ") = "
    if(res > overflow) then
      write(*, "(a)") "overflow
    else
       write(*, "(f0.3)") res
    end if
  end do  
      
contains

real function f(x)
  real, intent(in) :: x
  
  f = sqrt(abs(x)) + 5.0*x**3

end function  
end program
Task: Odd word problem






PHP: $odd = function ($prev) use ( &$odd ) {
	$a = fgetc(STDIN);
	if (!ctype_alpha($a)) {
		$prev();
		fwrite(STDOUT, $a);
		return $a != '.';
	}
	$clos = function () use ($a , $prev) {
		fwrite(STDOUT, $a);
		$prev();
	};
	return $odd($clos);
};
$even = function () {
	while (true) {
		$c = fgetc(STDIN);
		fwrite(STDOUT, $c);
		if (!ctype_alpha($c)) {
			return $c != ".";
		}
	}
};
$prev = function(){};
$e = false;
while ($e ? $odd($prev) : $even()) {
	$e = !$e;
}





Fortran:       MODULE ELUDOM	
       INTEGER MSG,INF	
       LOGICAL DEFER	
       CONTAINS
        CHARACTER*1 RECURSIVE FUNCTION GET(IN)	
         INTEGER IN	
         CHARACTER*1 C	
          READ (IN,1,ADVANCE="NO",EOR=3,END=4) C	
    1     FORMAT (A1,$)	
    2     IF (("A"<=C .AND. C<="Z").OR.("a"<=C .AND. C<="z")) THEN	
            IF (DEFER) THEN	
              GET = GET(IN)	
              WRITE (MSG,1) C	
              RETURN		
            END IF		
           ELSE		
            DEFER = .NOT. DEFER	
          END IF	
    3     GET = C	
          RETURN	
    4     GET = CHAR(0)	
        END FUNCTION GET
      END MODULE ELUDOM	

      PROGRAM CONFUSED	
      USE ELUDOM	
      CHARACTER*1 C	
      MSG = 6	
      INF = 10	
      OPEN (INF,NAME = "Confused.txt",STATUS="OLD",ACTION="READ")	

Chew through the input. A full stop marks the end.
   10 DEFER = .FALSE.	
   11 C = GET(INF)		
      IF (ICHAR(C).LE.0) STOP		
      IF (C.NE." ") WRITE (MSG,12) C	
   12 FORMAT (A1,$)			
      IF (C.NE.".") GO TO 11	
      WRITE (MSG,"('')")	
      GO TO 10		
      END
Task: Matrix with two diagonals






PHP: <?php

$n = 9; // the number of rows

for ($i = 1; $i <= $n; $i++) {
    for ($j = 1; $j <= $n; $j++) {
        echo ($i == $j || $i == $n - $j + 1) ? ' 1' : ' 0';
    }
    echo "\n";
}





Fortran: program prog

    dimension a(100, 100)

    n = 7
	
    j1 = 1
    j2 = n
    do i = 1, n
        do j = 1, n
            a(i, j) = 0.
        end do
        a(i, j1) = 1
        a(i, j2) = 1
        j1 = j1 + 1
        j2 = j2 - 1
    end do

    do i = 1, n
        print *, (a(i, j), j=1,n)
    end do

end
Task: Words containing _the_ substring






PHP: <?php foreach(file("unixdict.txt") as $w) echo (strstr($w, "the") && strlen(trim($w)) > 11) ? $w : "";





Fortran: program main
implicit none
integer :: lun
character(len=256) :: line
integer :: ios
   open(file='unixdict.txt',newunit=lun)
   do
      read(lun,'(a)',iostat=ios)line
      if(ios /= 0)exit
      if( index(line,'the') /= 0 .and. len_trim(line) > 11 ) then
         write(*,'(a)')trim(line)
      endif
   enddo
end program main
Task: Here document






PHP: $address = <<<END
1, High Street,
$town_name,
West Midlands.
WM4 5HD.
END;





Fortran:       INTEGER I         
      CHARACTER*666 I AM    
      I AM =                                                           "<col72
C              111111111122222222223333333333444444444455555555556666666666
C     123456789012345678901234567890123456789012345678901234567890123456789
     1                                                                  <col72
     2              I AM                                                <col72
     3                                                                  <col72
     4           THAT I AM                                              <col72
     5"

Chug through the text blob.
      DO I = 0,600,66   
        WRITE (6,1) I AM(I + 1:I + 66)  
    1   FORMAT (A66)            
      END DO                
      END
Task: Sorting algorithms_Bead sort






PHP: <?php
function columns($arr) {
    if (count($arr) == 0)
        return array();
    else if (count($arr) == 1)
        return array_chunk($arr[0], 1);

    array_unshift($arr, NULL);

    $transpose = call_user_func_array('array_map', $arr);
    return array_map('array_filter', $transpose);
}

function beadsort($arr) {
    foreach ($arr as $e)
        $poles []= array_fill(0, $e, 1);
    return array_map('count', columns(columns($poles)));
}

print_r(beadsort(array(5,3,1,7,4,1,1)));
?>





Fortran: program BeadSortTest
  use iso_fortran_env 
  
  
  
  

  integer, dimension(7) :: a = (/ 7, 3, 5, 1, 2, 1, 20 /)

  call beadsort(a)
  print *, a

contains

  subroutine beadsort(a)
    integer, dimension(:), intent(inout) :: a

    integer, dimension(maxval(a), maxval(a)) :: t
    integer, dimension(maxval(a)) :: s
    integer :: i, m

    m = maxval(a)
    
    if ( any(a < 0) ) then
       write(ERROR_UNIT,*) "can't sort"
       return
    end if

    t = 0
    forall(i=1:size(a)) t(i, 1:a(i)) = 1  
    forall(i=1:m)             
       s(i) = sum(t(:, i))    
       t(:, i) = 0            
       t(1:s(i), i) = 1       
    end forall
    
    forall(i=1:size(a)) a(i) = sum(t(i,:))
    
  end subroutine beadsort

end program BeadSortTest
Task: Execute HQ9+






PHP: 
$accumulator = 0;
echo 'HQ9+: ';
$program = trim(fgets(STDIN));

foreach (str_split($program) as $chr) {
    switch ($chr) {
        case 'H':
        case 'h':
            printHelloWorld();
            break;
        case 'Q':
        case 'q':
            printSource($program);
            break;
        case '9':
            print99Bottles();
            break;
        case '+':
            $accumulator = incrementAccumulator($accumulator);
            break;
        default:
            printError($chr);
    }
}

function printHelloWorld() {
    echo 'Hello, world!'. PHP_EOL;
}

function printSource($program) {
    echo var_export($program, true) . PHP_EOL;
}

function print99Bottles() {
    $n = 99;
    while($n >= 1) {
        echo $n;
        echo ' Bottles of Beer on the Wall ';
        echo $n;
        echo ' bottles of beer, take one down pass it around ';
        echo $n-1;
        echo ' bottles of beer on the wall.'. PHP_EOL;
        $n--;
    }
}

function incrementAccumulator($accumulator) {
    return ++$accumulator;
}

function printError($chr) {
    echo "Invalid input: ". $chr;
}





Fortran: "bottle" // IF (B.NE.1) THEN "s" FI // " of beer"
Task: Find the last Sunday of each month






PHP: <?php


function printLastSundayOfAllMonth($year)
{
    $months = array(
        'January', 'February', 'March', 'April', 'June', 'July',
        'August', 'September', 'October', 'November', 'December');

    foreach ($months as $month) {
        echo $month . ': ' . date('Y-m-d', strtotime('last sunday of ' . $month . ' ' . $year)) . "\n";
    }
}

printLastSundayOfAllMonth($argv[1]);





Fortran:       D = DAYNUM(Y,M,D)    
      DAYNUM(Y,M,D) = D