(() => {
    'use strict';

    // main :: IO ()
    const main = () => {

        const
            f90 = dct => x2 => dct[x2],
            f60 = dct => (x2, ab) => dct[x2 - ab],
            f120 = dct => (x2, ab) => dct[x2 + ab],
            f60unequal = dct => (x2, ab, a, b) =>
            (a !== b) ? (
                dct[x2 - ab]
            ) : undefined;

        // triangles :: Dict -> (Int -> Int -> Int -> Int -> Maybe Int)
        //                   -> [String]
        const triangles = (f, n) => {
            const
                xs = enumFromTo(1, n),
                fr = f(xs.reduce((a, x) => (a[x * x] = x, a), {})),
                gc = xs.reduce((a, _) => a, {}),
                setSoln = new Set();
            return (
                xs.forEach(
                    a => {
                        const a2 = a * a;
                        enumFromTo(1, 1 + a).forEach(
                            b => {
                                const
                                    suma2b2 = a2 + b * b,
                                    c = fr(suma2b2, a * b, a, b);
                                if (undefined !== c) {
                                    setSoln.add([a, b, c].sort())
                                };
                            }
                        );
                    }
                ),
                Array.from(setSoln.keys())
            );
        };

        const
            result = 'Triangles of maximum side 13:\n\n' +
            unlines(
                zipWith(
                    (s, f) => {
                        const ks = triangles(f, 13);
                        return ks.length.toString() + ' solutions for ' + s +
                            ' degrees:\n' + unlines(ks) + '\n';
                    },
                    ['120', '90', '60'],
                    [f120, f90, f60]
                )
            ) + '\nUneven triangles of maximum side 10000. Total:\n' +
            triangles(f60unequal, 10000).length

        return (
            //console.log(result),
            result
        );
    };

    // GENERIC FUNCTIONS ----------------------------

    // concatMap :: (a -> [b]) -> [a] -> [b]
    const concatMap = (f, xs) =>
        xs.reduce((a, x) => a.concat(f(x)), []);

    // enumFromTo :: Int -> Int -> [Int]
    const enumFromTo = (m, n) =>
        m <= n ? iterateUntil(
            x => n <= x,
            x => 1 + x,
            m
        ) : [];

    // iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
    const iterateUntil = (p, f, x) => {
        const vs = [x];
        let h = x;
        while (!p(h))(h = f(h), vs.push(h));
        return vs;
    };

    // Returns Infinity over objects without finite length
    // this enables zip and zipWith to choose the shorter
    // argument when one non-finite like cycle, repeat etc

    // length :: [a] -> Int
    const length = xs => xs.length || Infinity;

    // take :: Int -> [a] -> [a]
    // take :: Int -> String -> String
    const take = (n, xs) =>
        xs.constructor.constructor.name !== 'GeneratorFunction' ? (
            xs.slice(0, n)
        ) : [].concat.apply([], Array.from({
            length: n
        }, () => {
            const x = xs.next();
            return x.done ? [] : [x.value];
        }));

    // unlines :: [String] -> String
    const unlines = xs => xs.join('\n');

    // Use of `take` and `length` here allows zipping with non-finite lists
    // i.e. generators like cycle, repeat, iterate.

    // Use of `take` and `length` here allows zipping with non-finite lists
    // i.e. generators like cycle, repeat, iterate.

    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    const zipWith = (f, xs, ys) => {
        const
            lng = Math.min(length(xs), length(ys)),
            as = take(lng, xs),
            bs = take(lng, ys);
        return Array.from({
            length: lng
        }, (_, i) => f(as[i], bs[i], i));
    };

    // MAIN ---
    return main();
})();


@(do (defvar h (hash :equal-based)))
@(repeat)
@(coll :vars ())@\
  @{letter /[A-Za-z]/}@(filter :upcase letter)@\
  @(do (inc [h letter 0]))@\
@(end)
@(end)
@(do (dohash (key value h)
       (format t "~a: ~a\n" key value)))


using Gee;

void main(string[] args){
    string filename = args[1];
    var file = FileStream.open(filename, "r");

    var	counter	= new HashMap<char, int>();

    string line = file.read_line();
    while (line != null){
        for (int x = 0;	x < line.length; x++){
            counter[line[x]] = counter[line[x]] + 1;
	}
        line = file.read_line();
    }

    foreach (var elem in counter.entries){
	stdout.printf("%c occured %d times\n", elem.key, elem.value);
    }
}


fcn reducedLatinSquare(n,write=False){
   if(n<=1) return(n);
   rlatin:=n.pump(List(), List.createLong(n,0).copy);  // matrix of zeros
   foreach i in (n){ rlatin[0][i]=i+1 }  // first row: (1,2,3..n)

   count:=Ref(0);
   // recursive closure to compute reduced latin squares and count or print them
   rows,rsz := derangements(n), rows.len();
   recurse:='wrap(i){
      foreach r in (rsz){	      // top
         if(rows[r][0]!=i) continue;  // filter by first column, ignore all but i
         rlatin[i-1]=rows[r].copy();
	 foreach k,j in ([0..i-2],[1..n-1]){	// nested loop: foreach foreach
	    if(rlatin[k][j] == rlatin[i-1][j]){
	       if(r < rsz-1) continue(3);	// -->top
	       if(i>2) return();
	    }
	 }
	 if(i<n) self.fcn(i + 1, vm.pasteArgs(1));  // 'wrap hides local data (ie count, rows, etc)
	 else{
	    count.inc();
	    if(write) printSquare(rlatin,n);
	 }
      }
   };
   recurse(2);   // remaining rows
   return(count.value);
}
fcn derangements(n,i){
   enum:=[1..n].pump(List);
   Utils.Helpers.permuteW(enum).tweak('wrap(perm){
      if(perm.zipWith('==,enum).sum(0)) Void.Skip
      else perm
   }).pump(List);
}
fcn printSquare(matrix,n){
   matrix.pump(Console.println,fcn(l){ l.concat(", ","[","]") });
   println();
}
fcn fact(n){ ([1..n]).reduce('*,1) }


def squares(n):
  reduce range(1; 1+n) as $i ({}; .[$i*$i|tostring] = $i);

# if count, then just count
def solve(angle; maxLen; allowSame; count):
  squares(maxLen) as $squares

  | def qsqrt($n):
    $squares[$n|tostring] as $sqrt
    | if $sqrt then $sqrt else null end;

  reduce range(1; maxLen+1) as $a ({};
      reduce range($a; maxLen+1) as $b (.;
        .lhs = $a*$a + $b*$b
        | if angle != 90
          then if angle == 60
               then .lhs += ( - $a*$b)
               elif angle == 120
               then .lhs +=  $a*$b
               else "Angle must be 60, 90 or 120 degrees" | error
               end
          else .
          end
        | qsqrt(.lhs) as $c
        | if $c != null
          then if allowSame or $a != $b or $b != $c
               then .solutions += if count then 1 else [[$a, $b, $c]] end
               else .
               end
           else .
           end
        )
    )
  | .solutions ;

def task1($angles):
  "For sides in the range [1, 13] where they can all be of the same length:\n",
  ($angles[]
   | . as $angle
   | solve($angle; 13; true; false)
   | "  For an angle of \($angle) degrees, there are \(length) solutions, namely:", .);

def task2(degrees; n):
  "For sides in the range [1, \(n)] where they cannot ALL be of the same length:",
  (solve(degrees; n; false; true)
   | "  For an angle of \(degrees) degrees, there are \(.) solutions.") ;

task1([90, 60, 120]), "", task2(60; 10000)


sqdict(n) = Dict([(x*x, x) for x in 1:n])
numnotsame(arrarr) = sum(map(x -> !all(y -> y == x[1], x), arrarr))

function filtertriangles(N)
    sqd = sqdict(N)
    t60 = Vector{Vector{Int}}()
    t90 = Vector{Vector{Int}}()
    t120 = Vector{Vector{Int}}()
    for x in 1:N, y in 1:x
        xsq, ysq, xy = (x*x, y*y, x*y)
        if haskey(sqd, xsq + ysq - xy)
            push!(t60, sort([x, y, sqd[xsq + ysq - xy]]))
        elseif haskey(sqd, xsq + ysq)
            push!(t90, sort([x, y, sqd[xsq + ysq]]))
        elseif haskey(sqd, xsq + ysq + xy)
            push!(t120, sort([x, y, sqd[xsq + ysq + xy]]))
        end
    end
    t60, t90, t120
end

tri60, tri90, tri120 = filtertriangles(13)
println("Integer triples for 1 <= side length <= 13:\n")
println("Angle 60:"); for t in tri60 println(t) end
println("Angle 90:"); for t in tri90 println(t) end
println("Angle 120:"); for t in tri120 println(t) end
println("\nFor sizes N through 10000, there are $(numnotsame(filtertriangles(10000)[1])) 60 degree triples with nonequal sides.")


// Version 1.2.70

val squares13 = mutableMapOf<Int, Int>()
val squares10000 = mutableMapOf<Int, Int>()

class Trio(val a: Int, val b: Int, val c: Int) {
    override fun toString() = "($a $b $c)"
}

fun init() {
    for (i in 1..13) squares13.put(i * i, i)
    for (i in 1..10000) squares10000.put(i * i, i)
}

fun solve(angle :Int, maxLen: Int, allowSame: Boolean): List<Trio> {
    val solutions = mutableListOf<Trio>()
    for (a in 1..maxLen) {
        inner@ for (b in a..maxLen) {
            var lhs = a * a + b * b
            if (angle != 90) {
                when (angle) {
                    60   -> lhs -= a * b
                    120  -> lhs += a * b
                    else -> throw RuntimeException("Angle must be 60, 90 or 120 degrees")
                }
            }
            when (maxLen) {
                13 -> {
                    val c = squares13[lhs]
                    if (c != null) {
                        if (!allowSame && a == b && b == c) continue@inner
                        solutions.add(Trio(a, b, c))
                    }
                }

                10000 -> {
                    val c = squares10000[lhs]
                    if (c != null) {
                        if (!allowSame && a == b && b == c) continue@inner
                        solutions.add(Trio(a, b, c))
                    }
                }

                else -> throw RuntimeException("Maximum length must be either 13 or 10000")
            }
        }
    }
    return solutions
}

fun main(args: Array<String>) {
    init()
    print("For sides in the range [1, 13] ")
    println("where they can all be of the same length:-\n")
    val angles = intArrayOf(90, 60, 120)
    lateinit var solutions: List<Trio>
    for (angle in angles) {
        solutions = solve(angle, 13, true)
        print("  For an angle of ${angle} degrees")
        println(" there are ${solutions.size} solutions, namely:")
        println("  ${solutions.joinToString(" ", "[", "]")}\n")
    }
    print("For sides in the range [1, 10000] ")
    println("where they cannot ALL be of the same length:-\n")
    solutions = solve(60, 10000, false)
    print("  For an angle of 60 degrees")
    println(" there are ${solutions.size} solutions.")
}


Public Sub LetterFrequency(fname)
'count number of letters in text file "fname" (ASCII-coded)
'note: we count all characters but print only the letter frequencies

Dim Freqs(255) As Long
Dim abyte As Byte
Dim ascal as Byte 'ascii code for lowercase a
Dim ascau as Byte 'ascii code for uppercase a

'try to open the file
On Error GoTo CantOpen
Open fname For Input As #1
On Error GoTo 0

'initialize
For i = 0 To 255
  Freqs(i) = 0
Next i

'process file byte-per-byte
While Not EOF(1)
 abyte = Asc(Input(1, #1))
 Freqs(abyte) = Freqs(abyte) + 1
Wend
Close #1

'add lower and upper case together and print result
Debug.Print "Frequencies:"
ascal = Asc("a")
ascau = Asc("A")
For i = 0 To 25
  Debug.Print Chr$(ascal + i), Freqs(ascal + i) + Freqs(ascau + i)
Next i
Exit Sub

CantOpen:
  Debug.Print "can't find or read the file "; fname
  Close
End Sub


filepath = "SPECIFY FILE PATH HERE"

Set objfso = CreateObject("Scripting.FileSystemObject")
Set objdict = CreateObject("Scripting.Dictionary")
Set objfile = objfso.OpenTextFile(filepath,1)

txt = objfile.ReadAll

For i = 1 To Len(txt)
	char = Mid(txt,i,1)
	If objdict.Exists(char) Then
		objdict.Item(char) = objdict.Item(char) + 1
	Else
		objdict.Add char,1
	End If
Next

For Each key In objdict.Keys
	WScript.StdOut.WriteLine key & " = " & objdict.Item(key)
Next

objfile.Close
Set objfso = Nothing
Set objdict = Nothing


function solve(angle, maxlen, filter)
  local squares, roots, solutions = {}, {}, {}
  local cos2 = ({[60]=-1,[90]=0,[120]=1})[angle]
  for i = 1, maxlen do squares[i], roots[i^2] = i^2, i end
  for a = 1, maxlen do
    for b = a, maxlen do
      local lhs = squares[a] + squares[b] + cos2*a*b
      local c = roots[lhs]
      if c and (not filter or filter(a,b,c)) then
        solutions[#solutions+1] = {a=a,b=b,c=c}
      end
    end
  end
  print(angle.."° on 1.."..maxlen.." has "..#solutions.." solutions")
  if not filter then
    for i,v in ipairs(solutions) do print("",v.a,v.b,v.c) end
  end
end
solve(90, 13)
solve(60, 13)
solve(120, 13)
function fexcr(a,b,c) return a~=b or b~=c end
solve(60, 10000, fexcr)  -- extra credit
solve(90, 10000, fexcr)  -- more extra credit
solve(120, 10000, fexcr) -- even more extra credit


import strformat
import tables

# Generate tables at compile time. This eliminates the initialization at
# the expense of a bigger executable.

const square13 = block:
  var tmp = newSeq[tuple[a, b: int]]()
  for i in 1..13:
    tmp.add((i * i, i))
  toTable(tmp)

const square10000 = block:
  var tmp = newSeq[tuple[a, b: int]]()
  for i in 1..10000:
    tmp.add((i * i, i))
  toTable(tmp)

proc solve(angle, maxLen: int, allowSame: bool): seq[tuple[a, b, c: int]] =
  result = newSeq[tuple[a, b, c: int]]()
  for a in 1..maxLen:
    for b in a..maxLen:
      var lhs = a * a + b * b
      if angle != 90:
        case angle
        of 60:
          dec lhs, a * b
        of 120:
          inc lhs, a * b
        else:
          raise newException(IOError, "Angle must be 60, 90 or 120 degrees")
      case maxLen
      of 13:
        var c = square13.getOrDefault(lhs)
        if (not allowSame and a == b and b == c) or c == 0:
          continue
        result.add((a, b, c))
      of 10000:
        var c = square10000.getOrDefault(lhs)
        if (not allowSame and a == b and b == c) or c == 0:
          continue
        result.add((a, b, c))
      else:
        raise newException(IOError, "Maximum length must be either 13 or 10000")

echo "For sides in the range [1, 13] where they can all be the same length:\n"
let angles = [90, 60, 120]
for angle in angles:
  var solutions = solve(angle, 13, true)
  echo fmt"    For an angle of {angle} degrees there are {len(solutions)} solutions, to wit:"
  write(stdout, "    ")
  for i in 0..<len(solutions):
    write(stdout, fmt"{solutions[i]:25}")
    if i mod 3 == 2:
      write(stdout, "\n    ")
  write(stdout, "\n")
echo "\nFor sides in the range [1, 10000] where they cannot ALL be of the same length:\n"
var solutions = solve(60, 10000, false)
echo fmt"    For an angle of 60 degrees there are {len(solutions)} solutions."


File_Open("c:\txt\a_text_file.txt")
Update()

for (#1='A'; #1<='Z'; #1++) {
    Out_Reg(103) Char_Dump(#1,NOCR) Out_Reg(CLEAR)
    #2 = Search(@103, BEGIN+ALL+NOERR)
    Message(@103) Num_Type(#2)
}


import os
struct LetterFreq {
    rune int
    freq int
}

fn main(){
    file := os.read_file('unixdict.txt')?
    mut freq := map[rune]int{}
    for c in file {
        freq[c]++
    }
    mut lf := []LetterFreq{}
    for k,v in freq {
        lf << LetterFreq{u8(k),v}
    }
    lf.sort_with_compare(fn(a &LetterFreq, b &LetterFreq)int{
        if a.freq > b.freq {
            return -1
        }
        if a.freq < b.freq {
            return 1
        }
        return 0
    })
    for f in lf {
        println('${u8(f.rune).ascii_str()} ${f.rune} $f.freq')
    }
}


use utf8;
binmode STDOUT, "utf8:";
use Sort::Naturally;

sub triples {
    my($n,$angle) = @_;
    my(@triples,%sq);
    $sq{$_**2}=$_ for 1..$n;
    for $a (1..$n-1) {
      for $b ($a+1..$n) {
        my $ab = $a*$a + $b*$b;
        my $cos = $angle == 60  ? $ab - $a * $b :
                  $angle == 120 ? $ab + $a * $b :
                                  $ab;
        if ($angle == 60) {
            push @triples, "$a $sq{$cos} $b" if exists $sq{$cos};
        } else {
            push @triples, "$a $b $sq{$cos}" if exists $sq{$cos};
        }
      }
    }
    @triples;
}

$n = 13;
print "Integer triangular triples for sides 1..$n:\n";
for my $angle (120, 90, 60) {
   my @itt = triples($n,$angle);
   if ($angle == 60) { push @itt, "$_ $_ $_" for 1..$n }
   printf "Angle %3d° has %2d solutions: %s\n", $angle, scalar @itt,
         join ', ', nsort @itt;
}

printf "Non-equilateral n=10000/60°: %d\n", scalar triples(10000,60);


import "io" for File
import "/fmt" for Fmt

var text = File.read("mit10000.txt")
var freqs = List.filled(26, 0)
for (c in text.codePoints) {
    if (c >= 97 && c <= 122) {
        freqs[c-97] = freqs[c-97] + 1
    }
}
var totalFreq = freqs.reduce { |sum, f| sum + f }
System.print("Frequencies of letters in mit10000.txt:")
System.print("\n    freq     \%")
System.print("----------------")

for (i in 0..25) {
    Fmt.print("$c  $5d  $6.2f", i+97, freqs[i], freqs[i]/totalFreq * 100)
}
System.print("   -----  ------")
Fmt.print("   $5d  100.00", totalFreq)

Fmt.print("\nTotal characters in text file = $d minus 10000 \\n's = $d", text.count, totalFreq)


include c:\cxpl\codes;          \intrinsic 'code' declarations
int A(256), C, I;
[for C:= 0 to 256-1 do A(C):= 0;
repeat  C:= ChIn(1);            \device 1 doesn't buffer nor echo chars
        A(C):= A(C)+1;          \count character
until   C=\EOF\$1A;
C:= 0;
for I:= 0 to 128-1 do           \only show 7-bit ASCII
        [ChOut(0, \tab\9);
        case C of
          $0A: ChOut(6, $19);   \line feed = down arrow
          $0D: ChOut(6, $1B)    \carriage return = left arrow
        other  ChOut(6, C);     \all other characters display on device 6
        ChOut(0, ^ );
        IntOut(0, A(C));        \show count
        C:= C+16;               \columnar order
        if (I&7) = 7 then [CrLf(0);  C:= C-8*16+1];
        ];
]


with javascript_semantics
--constant lim = iff(platform()=JS?13:10000)
constant lim = 10000
--sequence squares = repeat(0,lim*lim)
sequence squares = iff(platform()=JS?{}:repeat(0,lim*lim))
for c=1 to lim do
    squares[c*c] = c
end for

function solve(integer angle, maxlen, bool samelen=true)
    sequence res = {}
    for a=1 to maxlen do
        integer a2 = a*a
        for b=a to maxlen do
            integer c2 = a2+b*b
            if angle!=90 then
                if    angle=60  then c2 -= a*b
                elsif angle=120 then c2 += a*b
                else crash("angle must be 60/90/120")
                end if
            end if
            integer c = iff(c2>length(squares)?0:squares[c2])
            if c!=0 and c<=maxlen then
                if samelen or a!=b or b!=c then
                    res = append(res,{a,b,c})
                end if
            end if
        end for
    end for
    return res
end function

procedure show(string fmt,sequence res, bool full=true)
    printf(1,fmt,{length(res),iff(full?sprint(res):"")})
end procedure

puts(1,"Integer triangular triples for sides 1..13:\n")
show("Angle  60 has %2d solutions: %s\n",solve( 60,13))
show("Angle  90 has %2d solutions: %s\n",solve( 90,13))
show("Angle 120 has %2d solutions: %s\n",solve(120,13))
--if platform()!=JS then
    show("Non-equilateral angle 60 triangles for sides 1..10000: %d%s\n",solve(60,10000,false),false)
--end if


find_solutions(Limit, Solutions):-
    find_solutions(Limit, Solutions, Limit, []).

find_solutions(_, S, 0, S):-
    !.
find_solutions(Limit, Solutions, A, S):-
    find_solutions1(Limit, A, A, S1, S),
    A_next is A - 1,
    find_solutions(Limit, Solutions, A_next, S1).

find_solutions1(Limit, _, B, Triples, Triples):-
    B > Limit,
    !.
find_solutions1(Limit, A, B, [Triple|Triples], T):-
    is_solution(Limit, A, B, Triple),
    !,
    B_next is B + 1,
    find_solutions1(Limit, A, B_next, Triples, T).
find_solutions1(Limit, A, B, Triples, T):-
    B_next is B + 1,
    find_solutions1(Limit, A, B_next, Triples, T).

is_solution(Limit, A, B, t(Angle, A, B, C)):-
    X is A * A + B * B,
    Y is A * B,
    (
        Angle = 90, C is round(sqrt(X)), X is C * C
        ;
        Angle = 120, C2 is X + Y, C is round(sqrt(C2)), C2 is C * C
        ;
        Angle = 60, C2 is X - Y, C is round(sqrt(C2)), C2 is C * C
    ),
    C =< Limit,
    !.

write_triples(Angle, Solutions):-
    find_triples(Angle, Solutions, List, 0, Count),
    writef('There are %w solutions for gamma = %w:\n', [Count, Angle]),
    write_triples1(List),
    nl.

find_triples(_, [], [], Count, Count):-
    !.
find_triples(Angle, [Triple|Triples], [Triple|Result], C, Count):-
    Triple = t(Angle, _, _, _),
    !,
    C1 is C + 1,
    find_triples(Angle, Triples, Result, C1, Count).
find_triples(Angle, [_|Triples], Result, C, Count):-
    find_triples(Angle, Triples, Result, C, Count).

write_triples1([]):-!.
write_triples1([t(_, A, B, C)]):-
    writef('(%w,%w,%w)\n', [A, B, C]),
    !.
write_triples1([t(_, A, B, C)|Triples]):-
    writef('(%w,%w,%w) ', [A, B, C]),
    write_triples1(Triples).

main:-
    find_solutions(13, Solutions),
    write_triples(60, Solutions),
    write_triples(90, Solutions),
    write_triples(120, Solutions).


dim ascCodes(255)

f = open("unixdict.txt", "r")

if f then
    while(not eof(#f))
        line input #f a$
        for i = 1 to len(a$)
            c = asc(mid$(a$, i, 1))
            ascCodes(c) = ascCodes(c) + 1
        next
    wend
    for i = 1 to 255
        c = ascCodes(i)
        if c print chr$(i), " = ", c
    next
    close #f
end if


fcn ccnt(textInBitBucket){
   letters:=["a".."z"].pump(List().write,0); // array of 26 zeros
   textInBitBucket.howza(0).pump(Void,'wrap(c){  // pump text as ints
      if(97<=c<=122)     c-=97;
      else if(65<=c<=90) c-=65;
      else return(Void.Skip);
      letters[c]+=1
   });
   sum:=letters.sum(); println(sum," letters");
   letters.enumerate().pump(List,'wrap([(c,n)]){
      "%s(%d:%d%)".fmt((c+65).toChar(),n,n*100/sum)})
   .concat(",").println();
}

ccnt(Data(0,Int,"This is a test"));
ccnt(File("dict.txt").read());


program: letter_frequency
  input: 'cbcacb'                  # can be literal value, stdin or file url at runtime
  derive: [[a,1],[b,2],[c,3]]
  output: 'a : 1\nb : 2\nc : 3\n'


N = 13

def method1(N=N):
    squares = [x**2 for x in range(0, N+1)]
    sqrset = set(squares)
    tri90, tri60, tri120 = (set() for _ in range(3))
    for a in range(1, N+1):
        a2 = squares[a]
        for b in range(1, a + 1):
            b2 = squares[b]
            c2 = a2 + b2
            if c2 in sqrset:
                tri90.add(tuple(sorted((a, b, int(c2**0.5)))))
            ab = a * b
            c2 -= ab
            if c2 in sqrset:
                tri60.add(tuple(sorted((a, b, int(c2**0.5)))))
            c2 += 2 * ab
            if c2 in sqrset:
                tri120.add(tuple(sorted((a, b, int(c2**0.5)))))
    return  sorted(tri90), sorted(tri60), sorted(tri120)
#%%
if __name__ == '__main__':
    print(f'Integer triangular triples for sides 1..{N}:')
    for angle, triples in zip([90, 60, 120], method1(N)):
        print(f'  {angle:3}° has {len(triples)} solutions:\n    {triples}')
    _, t60, _ = method1(10_000)
    notsame = sum(1 for a, b, c in t60 if a != b or b != c)
    print('Extra credit:', notsame)


inputs <- cbind(combn(1:13, 2), rbind(seq_len(13), seq_len(13)))
inputs <- cbind(A = inputs[1, ], B = inputs[2, ])[sort.list(inputs[1, ]),]
Pythagoras <- inputs[, "A"]^2 + inputs[, "B"]^2
AtimesB <- inputs[, "A"] * inputs[, "B"]
CValues <- sqrt(cbind("C (90º)" = Pythagoras,
                      "C (60º)" = Pythagoras - AtimesB,
                      "C (120º)" = Pythagoras + AtimesB))
CValues[!t(apply(CValues, MARGIN = 1, function(x) x %in% 1:13))] <- NA
output <- cbind(inputs, CValues)[!apply(CValues, MARGIN = 1, function(x) all(is.na(x))),]
rownames(output) <- paste0("Solution ", seq_len(nrow(output)), ":")
print(output, na.print = "")
cat("There are",
    sum(!is.na(output[, 3])), "solutions in the 90º case,",
    sum(!is.na(output[, 4])), "solutions in the 60º case, and",
    sum(!is.na(output[, 5])), "solutions in the 120º case.")


multi triples (60, $n) {
    my %sq = (1..$n).map: { .² => $_ };
    my atomicint $i = 0;
    my @triples[2*$n];
    (1..^$n).race(:8degree).map: -> $a {
        for $a^..$n -> $b {
            my $cos = $a * $a + $b * $b - $a * $b;
            @triples[$i⚛++] = $a, %sq{$cos}, $b if %sq{$cos}:exists;
        }
    }
    @triples.grep: so *;
}

multi triples (90, $n) {
    my %sq = (1..$n).map: { .² => $_ };
    my atomicint $i = 0;
    my @triples[2*$n];
    (1..^$n).race(:8degree).map: -> $a {
        for $a^..$n -> $b {
            my $cos = $a * $a + $b * $b;
            @triples[$i⚛++] = $a, $b, %sq{$cos} and last if %sq{$cos}:exists;
        }
    }
    @triples.grep: so *;
}

multi triples (120, $n) {
    my %sq = (1..$n).map: { .² => $_ };
    my atomicint $i = 0;
    my @triples[2*$n];
    (1..^$n).race(:8degree).map: -> $a {
        for $a^..$n -> $b {
            my $cos = $a * $a + $b * $b + $a * $b;
            @triples[$i⚛++] = $a, $b, %sq{$cos} and last if %sq{$cos}:exists;
        }
    }
    @triples.grep: so *;
}

use Sort::Naturally;

my $n = 13;
say "Integer triangular triples for sides 1..$n:";
for 120, 90, 60 -> $angle {
    my @itt = triples($angle, $n);
    if $angle == 60 { push @itt, "$_ $_ $_" for 1..$n }
    printf "Angle %3d° has %2d solutions: %s\n", $angle, +@itt, @itt.sort(&naturally).join(', ');
}

my ($angle, $count) = 60, 10_000;
say "\nExtra credit:";
say "$angle° integer triples in the range 1..$count where the sides are not all the same length: ", +triples($angle, $count);


/*REXX pgm finds integer sided triangles that satisfy Law of cosines for 60º, 90º, 120º.*/
parse arg os1 os2 os3 os4 .                      /*obtain optional arguments from the CL*/
if os1=='' | os1==","  then os1= 13; s1=abs(os1) /*Not specified?  Then use the default.*/
if os2=='' | os2==","  then os2= 13; s2=abs(os2) /* "      "         "   "   "     "    */
if os3=='' | os3==","  then os3= 13; s3=abs(os3) /* "      "         "   "   "     "    */
if os4=='' | os4==","  then os4= -0; s4=abs(os4) /* "      "         "   "   "     "    */
@.=                                              /*@:  array holds squares, max of sides*/
                      do j=1  for max(s1, s2, s3, s4);  @.j= j * j    /*use memoization.*/
                      end   /*j*/
if s1>0  then call s1                            /*handle the triangle case for   120º. */
if s2>0  then call s2                            /*handle the triangle case for    90º. */
if s3>0  then call s3                            /*handle the triangle case for    60º. */
if s4>0  then call s4                            /*handle the case for unique sides.    */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
dAng: w= length(s); ang= ' 'd"º " uq' ';  ss= s * s;  @sol= " solutions found for"; return
foot: say right(commas(#) @sol ang  "(sides up to" commas(arg(1) +0)')', 65);  say; return
head: #= 0;  parse arg d,uq,s;  @= ',';   call dAng;      say center(ang, 65, '═'); return
show: #=#+1; arg p; if p>0  then say '     ('right(a,w)@ right(b,w)@ right(c,w)")"; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
s1:   call head 120,,s1                          /*────────── 120º:  a² + b² + ab  ≡ c² */
             do     a=1    for s1;         ap1= a + 1
               do   b=ap1  for s1-ap1+1;   x= @.a + @.b + a*b;     if x>ss  then iterate a
                 do c=b+1  for s1-b+1  until @.c>x
                 if [email protected].c  then do;  call show os1;  iterate b;  end
                 end   /*c*/
               end     /*b*/
             end       /*a*/
      call foot s1;                        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
s2:   call head  90,,s2                          /*────────── 90º:   a² + b²       ≡ c² */
             do     a=1    for s2;         ap1= a + 1
               do   b=ap1  for s2-ap1+1;   x= @.a + @.b;           if x>ss  then iterate a
                 do c=b+1  for s2-b+2  until @.c>x
                 if [email protected].c  then do;  call show os2;  iterate b;  end
                 end   /*c*/
               end     /*b*/
             end       /*a*/
      call foot s2;                        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
s3:   call head  60,,s3                          /*────────── 60º:   a² + b² ─ ab  ≡ c² */
             do     a=1   for s3;          s3ma= s3 - a + 1
               do   b=a   for s3ma;        x= @.a + @.b - a*b;     if x>ss  then iterate a
                 do c=a   for s3ma  until @.c>x
                 if [email protected].c  then do;  call show os3;  iterate b;  end
                 end   /*c*/
               end     /*b*/
             end       /*a*/
      call foot s2;                        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
s4:   call head  60, 'unique', os4               /*────────── 60º:  a² + b² ─ ab   ≡ c² */
             do     a=1    for s4;         ap1= a + 1;    s4map1= s4 - ap1 + 1
               do   b=ap1  for s4map1;     x= @.a + @.b - a*b;     if x>ss  then iterate a
                 do c=ap1  for s4map1  until @.c>x
                 if [email protected].c  then do;  call show os4;  iterate b;  end
                 end   /*c*/
               end     /*b*/
             end       /*a*/
      call foot s4;                        return


grouped =  (1..13).to_a.repeated_permutation(3).group_by do |a,b,c|
  sumaabb, ab = a*a + b*b, a*b
  case c*c
    when sumaabb      then 90
    when sumaabb - ab then 60
    when sumaabb + ab then 120
  end
end

grouped.delete(nil)
res = grouped.transform_values{|v| v.map(&:sort).uniq }

res.each do |k,v|
  puts "For an angle of #{k} there are #{v.size} solutions:"
  puts v.inspect, "\n"
end


var squares13 = {}
var squares10000 = {}

var initMaps = Fn.new {
    for (i in 1..13) squares13[i*i] = i
    for (i in 1..10000) squares10000[i*i] = i
}

var solve = Fn.new { |angle, maxLen, allowSame|
    var solutions = []
    for (a in 1..maxLen) {
        for (b in a..maxLen) {
            var lhs = a*a + b*b
            if (angle != 90) {
                if (angle == 60) {
                    lhs = lhs - a*b
                } else if (angle == 120) {
                    lhs = lhs + a*b
                } else {
                    Fiber.abort("Angle must be 60, 90 or 120 degrees")
                }
            }
            if (maxLen == 13) {
                var c = squares13[lhs]
                if (c != null) {
                    if (allowSame || a != b || b != c) {
                        solutions.add([a, b, c])
                    }
                }
            } else if (maxLen == 10000) {
                var c = squares10000[lhs]
                if (c != null) {
                    if (allowSame || a != b || b != c) {
                        solutions.add([a, b, c])
                    }
                }
            } else {
                Fiber.abort("Maximum length must be either 13 or 10000")
            }
        }
    }
    return solutions
}

initMaps.call()
System.write("For sides in the range [1, 13] ")
System.print("where they can all be of the same length:-\n")
var angles = [90, 60, 120]
var solutions = []
for (angle in angles) {
    solutions = solve.call(angle, 13, true)
    System.write("  For an angle of %(angle) degrees")
    System.print(" there are %(solutions.count) solutions, namely:")
    System.print("  %(solutions)")
    System.print()
}
System.write("For sides in the range [1, 10000] ")
System.print("where they cannot ALL be of the same length:-\n")
solutions = solve.call(60, 10000, false)
System.write("  For an angle of 60 degrees")
System.print(" there are %(solutions.count) solutions.")


proc LawCos(Eqn);
int  Eqn;
int  Cnt, A, B, C;

    proc Show;
    [Cnt:= Cnt+1;
    IntOut(0, A);  ChOut(0, ^ );
    IntOut(0, B);  ChOut(0, ^ );
    IntOut(0, C);  CrLf(0);
    ];

[Cnt:= 0;
for A:= 1 to 13 do
    for B:= 1 to A do
        for C:= 1 to 13 do
            case Eqn of
             1: if A*A + B*B       = C*C then Show;
             2: if A*A + B*B - A*B = C*C then Show;
             3: if A*A + B*B + A*B = C*C then Show
            other [];
IntOut(0, Cnt);  Text(0, " results^m^j");
];

proc ExtraCredit;
int  Cnt, A, B, C, C2;
[Cnt:= 0;
for A:= 1 to 10_000 do
    for B:= 1 to A-1 do
        [C2:= A*A + B*B - A*B;
        C:= sqrt(C2);
        if C*C = C2 then Cnt:= Cnt+1;
        ];
Text(0, "Extra credit: ");
IntOut(0, Cnt);
CrLf(0);
];

int Case;
[for Case:= 1 to 3 do LawCos(Case);
ExtraCredit;
]


fcn tritri(N=13){
   sqrset:=[0..N].pump(Dictionary().add.fp1(True),fcn(n){ n*n });
   tri90, tri60, tri120 := List(),List(),List();
   foreach a,b in ([1..N],[1..a]){
      aa,bb := a*a,b*b;
      ab,c  := a*b, aa + bb - ab;	// 60*
      if(sqrset.holds(c)){ tri60.append(abc(a,b,c)); continue; }

      c=aa + bb;			// 90*
      if(sqrset.holds(c)){ tri90.append(abc(a,b,c)); continue; }

      c=aa + bb + ab;			// 120*
      if(sqrset.holds(c))  tri120.append(abc(a,b,c));
   }
   List(tri60,tri90,tri120)
}
fcn abc(a,b,c){ List(a,b).sort().append(c.toFloat().sqrt().toInt()) }
fcn triToStr(tri){	// ((c,d,e),(a,b,c))-->"(a,b,c),(c,d,e)"
   tri.sort(fcn(t1,t2){ t1[0]<t2[0] })
      .apply("concat",",").apply("(%s)".fmt).concat(",")
}


F is_leap_year(year)
   I year % 100 == 0
      R year % 400 == 0
   R year % 4 == 0


 (1) a 4-digit year (CCYY)
 (2) an 8-byte work area


;Example
        move.l  #2018,d0
        bsr     leap_year
        addi.l  #28,d1      ; # days in February 2018
        rts
; Leap Year
;
; Input
;   d0=year
;
; Output
;   d1=1 if leap year, 0 if not leap year
;   zero flag clear if leap year, set if not
;
leap_year:
        cmpi.l  #1752,d0
        ble.s   not_leap_year

        move.l  d0,d1
        lsr.l   #1,d1
        bcs.s   not_leap_year
        lsr.l   #1,d1
        bcs.s   not_leap_year

; If we got here, year is divisible by 4.
        move.l  d0,d1
        divu    #100,d1
        swap    d1
        tst.w   d1
        bne.s   is_leap_year

; If we got here, year is divisible by 100.
        move.l  d0,d1
        divu    #400,d1
        swap    d1
        tst.w   d1
        bne.s   not_leap_year

is_leap_year:
        moveq.l #1,d1
        rts
not_leap_year:
        moveq.l #0,d1
        rts


		org	100h
		jmp	test
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Check if a year is a leap year.
		;; Input: HL = year.
		;; Output: Carry flag set if HL is a leap year.
		;; Registers used: all.
leap:		mvi	a,3		; Divisible by 4?
		ana	l		; If not, not a leap year,
		rnz			; Return w/carry cleared
		mvi	b,2		; Divide by 4 (shift right 2)
leapdiv4:	mov	a,h
		rar
		mov	h,a
		mov 	a,l
		rar
		mov	l,a
		dcr 	b
		jnz	leapdiv4
		lxi	b,-1		; Divide by 25 using subtraction
		lxi	d,-25
leapdiv25:	inx	b		; Keep quotient in BC
		dad	d
		jc	leapdiv25
		mov	a,e		; If so, L==E afterwards.
		xra	l 		; (High byte is always FF.)
		stc			; Set carry, and
		rnz			; return if not divisible.
		mvi	a,3		; Is this divisble by 4?
		ana	c
		sui	1		; Set carry if so.
		ret
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Test code: get year from CP/M command line and see
		;; if it is a leap year.
test:		lxi	b,5Dh		; First char of "file name"
		lxi	h,0		; Accumulator
digit:		ldax	b		; Get character
		sui	'0'		; ASCII digit
		jc	getleap		; Not valid digit = done
		cpi	10
		jnc	getleap		; Not valid digit = done
		dad	h		; HL *= 10
		mov	d,h
		mov	e,l
		dad	h
		dad	h
		dad	d
		mvi	d,0		; Plus digit
		mov	e,a
		dad	d
		inx	b		; Next character
		jmp	digit
getleap:	call	leap		; Is HL a leap year?
		lxi	d,no		; No,
		jnc	out		; unless carry is set,
		lxi	d,yes		; then it is a leap year.
out:		mvi	c,9
		jmp	5
no:		db	'NOT '
yes:		db	'LEAP YEAR.$'


BYTE FUNC IsLeapYear(CARD year)
  IF year MOD 100=0 THEN
    IF year MOD 400=0 THEN
      RETURN (1)
    ELSE
      RETURN (0)
    FI
  FI

  IF year MOD 4=0 THEN
    RETURN (1)
  FI
RETURN (0)

PROC Main()
  CARD ARRAY t=[1900 1901 2000 2001 2004 2020 2021]
  BYTE i,leap
  CARD year

  FOR i=0 TO 6
  DO
    year=t(i)
    leap=IsLeapYear(year)
    IF leap=0 THEN
      PrintF("%U is not a leap year%E",year)
    ELSE
      PrintF("%U is a leap year%E",year)
    FI
  OD
RETURN


public function isLeapYear(year:int):Boolean {
    if (year % 100 == 0) {
        return (year % 400 == 0);
    }
    return (year % 4 == 0);
}


-- Incomplete code, just a sniplet to do the task. Can be used in any package or method.
-- Adjust the type of Year if you use a different one.
function Is_Leap_Year (Year : Integer) return Boolean is
begin
   if Year rem 100 = 0 then
      return Year rem 400 = 0;
   else
      return Year rem 4 = 0;
   end if;
end Is_Leap_Year;

-- An enhanced, more efficient version:
-- This version only does the 2 bit comparison (rem 4) if false.
-- It then checks rem 16 (a 4 bit comparison), and only if those are not
-- conclusive, calls rem 100, which is the most expensive operation.
-- I failed to be convinced of the accuracy of the algorithm at first,
-- so I rephrased it below.
-- FYI: 400 is evenly divisible by 16 whereas 100,200 and 300 are not. Ergo, the
-- set of integers evenly divisible by 16 and 100 are all evenly divisible by 400.
-- 1. If a year is not divisible by 4 => not a leap year. Skip other checks.
-- 2. If a year is evenly divisible by 16, it is either evenly divisible by 400 or
--    not evenly divisible by 100 => leap year. Skip further checks.
-- 3. If a year evenly divisible by 100 => not a leap year.
-- 4. Otherwise a leap year.

function Is_Leap_Year (Year : Integer) return Boolean is
begin
   return (Year rem 4 = 0) and then ((Year rem 16 = 0) or else (Year rem 100 /= 0));
end Is_Leap_Year;

-- To improve speed a bit more, use with
pragma Inline (Is_Leap_Year);


begin
	integer year;

	integer procedure mod(i,j); value i,j; integer i,j;
	mod:=i-(i div j)*j;

	boolean procedure isLeapYear(year); value year; integer year;
	isLeapYear:=mod(year,400)=0 or (mod(year,4)=0 and mod(year,100) notequal 0);

	for year := 1899, 1900, 1901, 1902, 1903, 1904, 1905, 1999, 2000, 2001, 2002, 2003, 2004 do begin
		outinteger(1,year);
		if isLeapYear(year) then outstring(1,"True\n") else outstring(1, "False\n")
	end for year
end


MODE YEAR = INT, MONTH = INT, DAY = INT;

PROC year days = (YEAR year)DAY: # Ignore 1752 CE for the moment #
  ( month days(year, 2) = 28 | 365 | 366 );

PROC month days = (YEAR year, MONTH month) DAY:
  ( month | 31,
            28 + ABS (year MOD 4 = 0 AND year MOD 100 /= 0 OR year MOD 400 = 0),
            31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

PROC is leap year = (YEAR year)BOOL: year days(year)=366;

test:(
  []INT test cases = (1900, 1994, 1996, 1997, 2000);
  FOR i TO UPB test cases DO
    YEAR year = test cases[i];
    printf(($g(0)" is "b("","not ")"a leap year."l$, year, is leap year(year)))
  OD
)


begin
    % returns true if year is a leap year, false otherwise %
    % assumes year is in the Gregorian Calendar            %
    logical procedure isLeapYear ( integer value year ) ;
        year rem 400 = 0 or ( year rem 4 = 0 and year rem 100 not = 0 );

    % some test cases                                      %
    for year := 1899, 1900, 1901, 1902, 1903, 1904, 1905, 1999, 2000, 2001, 2002, 2003, 2004 do begin
        write( i_w := 1, s_w := 0
             , year
             , " is "
             , if isLeapYear( year ) then "" else "not "
             , " a leap year"
             )
    end for_year
end.


BEGIN

% COMPUTE P MOD Q %
INTEGER FUNCTION MOD(P, Q);
INTEGER P, Q;
BEGIN
  MOD := P - Q * (P / Q);
END;

% RETURN 1 IF Y IS A LEAP YEAR, OTHERWISE 0 %
INTEGER FUNCTION ISLEAP(Y);
INTEGER Y;
BEGIN
  IF MOD(Y,4) <> 0 THEN    % QUICK EXIT IN MOST CASES %
     ISLEAP := 0
  ELSE IF MOD(Y,400) = 0 THEN
     ISLEAP := 1
  ELSE IF MOD(Y,100) = 0 THEN
     ISLEAP := 0
  ELSE                     % NON-CENTURY DIVISIBLE BY 4 %
     ISLEAP := 1;
END;

% EXERCISE THE FUNCTION %
INTEGER Y;
WRITE("TEST OF CENTURY YEARS");
FOR Y := 1600 STEP 100 UNTIL 2000 DO
  BEGIN
    IF ISLEAP(Y) <> 0 THEN
      WRITE(Y, " IS A LEAP YEAR")
    ELSE
      WRITE(Y, " IS NOT A LEAP YEAR");
  END;
WRITE("TEST OF CURRENT DECADE");
FOR Y := 2010 STEP 1 UNTIL 2020 DO
  BEGIN
    IF ISLEAP(Y) <> 0 THEN
      WRITE(Y, " IS A LEAP YEAR")
    ELSE
      WRITE(Y, " IS NOT A LEAP YEAR");
  END;

END


∇ z←Leap year
Z←(0=4|year)∧(0=400|year)∨~0=100|year
∇


on leap_year(y)
    return y mod 4 is equal to 0 and (y mod 100 is not equal to 0 or y mod 400 is equal to 0)
end leap_year

leap_year(1900)


(= leap? (fn (year)
  (if (and (is 0 (mod year 4)) (isnt 0 (mod year 100))) year
      (unless (< 0 (+ (mod year 100) (mod year 400))) year))))


leapyear(year)
{
    if (Mod(year, 100) = 0)
        return (Mod(year, 400) = 0)
    return (Mod(year, 4) = 0)
}

MsgBox, % leapyear(1604)


; AutoIt Version: 3.3.8.1
$Year = 2012
$sNot = " not"

If IsLeapYear($Year) Then $sNot = ""
ConsoleWrite ($Year & " is" & $sNot & " a leap year." & @LF)

Func IsLeapYear($_year)
	Return Not Mod($_year, 4) And (Mod($_year, 100) Or Not Mod($_year, 400))
EndFunc

; == But it exists the standard UDF "Date.au3" with this function: "_IsLeapYear($Year)"


function leapyear( year )
{
    if ( year % 100 == 0 )
        return ( year % 400 == 0 )
    else
        return ( year % 4 == 0 )
}


#!/bin/bash

is_leap_year ()  # Define function named is_leap_year
{

declare -i year=$1      # declare integer variable "year" and set it to function parm 1

echo -n "$year ($2)-> " # print the year passed in, but do not go to the next line

if (( $year % 4 == 0 )) # if year not dividable by 4, then not a leap year, % is the modulus operator
then
        if (( $year % 400 == 0 ))       # if century dividable by 400, is a leap year
        then
                echo "This is a leap year"
        else
                if (( $year % 100 == 0 )) # if century not divisible by 400, not a leap year
                then
                        echo "This is not a leap year"
                else
                        echo "This is a leap year" # not a century boundary, but dividable by 4, is a leap year
                fi
        fi
else
        echo "This is not a leap year"
fi

}

# test all cases
# call the function is_leap_year several times with two parameters... year and test's expectation for 'is/not leap year.
is_leap_year 1900 not # a leap year
is_leap_year 2000 is  # a leap year
is_leap_year 2001 not # a leap year
is_leap_year 2003 not # a leap year
is_leap_year 2004 is  # a leap year

# Save the above to a file named is_leap_year.sh, then issue the following command to run the 5 tests of the function
# bash is_leap_year.sh


@echo off

::The Main Thing...
for %%x in (1900 2046 2012 1600 1800 2031 1952) do (
	call :leap %%x
)
echo.
pause
exit/b
::/The Main Thing...

::The Function...
:leap
set year=%1
set /a op1=%year%%%4
set /a op2=%year%%%100
set /a op3=%year%%%400
if not "%op1%"=="0" (goto :no)
if not "%op2%"=="0" (goto :yes)
if not "%op3%"=="0" (goto :no)
:yes
echo.
echo %year% is a leap year.
goto :EOF
:no
echo.
echo %year% is NOT a leap year.
goto :EOF
::/The Function...


  ( leap-year
  =
    .     mod$(!arg.100):0
        & `(mod$(!arg.400):0) { The backtick skips the remainder of the OR operation,
                                even if the tested condition fails. }
      | mod$(!arg.4):0
  )
& 1600 1700 1899 1900 2000 2006 2012:?tests
&   whl
  ' ( !tests:%?test ?tests
    & ( leap-year$!test&out$(!test " is a leap year")
      | out$(!test " is not a leap year")
      )
    )
& ;


#include <stdio.h>

int is_leap_year(int year)
{
    return (!(year % 4) && year % 100 || !(year % 400)) ? 1 : 0;
}

int main()
{
    int test_case[] = {1900, 1994, 1996, 1997, 2000}, key, end, year;
    for (key = 0, end = sizeof(test_case)/sizeof(test_case[0]); key < end; ++key) {
        year = test_case[key];
        printf("%d is %sa leap year.\n", year, (is_leap_year(year) == 1 ? "" : "not "));
    }
}


using System;

class Program
{
    static void Main()
    {
        foreach (var year in new[] { 1900, 1994, 1996, DateTime.Now.Year })
        {
            Console.WriteLine("{0} is {1}a leap year.",
                              year,
                              DateTime.IsLeapYear(year) ? string.Empty : "not ");
        }
    }
}


Function IsLeapYear( nYear )
Return Iif( nYear%100 == 0, (nYear%400 == 0), (nYear%4 == 0) )


(defn leap-year? [y]
  (and (zero? (mod y 4)) (or (pos? (mod y 100)) (zero? (mod y 400)))))


is_leap_year = proc (year: int) returns (bool)
    return(year//400 =0 cor (year//4 = 0 cand year//100 ~= 0))
end is_leap_year

start_up = proc ()
    po: stream := stream$primary_output()
    years: sequence[int] := sequence[int]$
        [1899, 1900, 1901, 1902, 1903, 1904, 1905, 1999,
         2000, 2001, 2002, 2003, 2004, 2021, 2022]

    for year: int in sequence[int]$elements(years) do
        stream$puts(po, int$unparse(year) || " is ")
        if ~is_leap_year(year) then stream$puts(po, "not ") end
        stream$putl(po, "a leap year.")
    end
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. leap-year.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  examples VALUE "19001994199619972000".
           03  year PIC 9(4) OCCURS 5 TIMES
               INDEXED BY year-index.

       01  remainders.
           03 400-rem   PIC 9(4).
           03 100-rem   PIC 9(4).
           03 4-rem     PIC 9(4).

       PROCEDURE DIVISION.
           PERFORM VARYING year-index FROM 1 BY 1 UNTIL 5 < year-index
               MOVE FUNCTION MOD(year (year-index), 400) TO 400-rem
               MOVE FUNCTION MOD(year (year-index), 100) TO 100-rem
               MOVE FUNCTION MOD(year (year-index), 4) TO 4-rem

               IF 400-rem = 0 OR ((100-rem NOT = 0) AND 4-rem = 0)
                   DISPLAY year (year-index) " is a leap year."
               ELSE
                   DISPLAY year (year-index) " is not a leap year."
               END-IF
           END-PERFORM

           GOBACK
           .


(defun leap-year-p (year)
  (destructuring-bind (fh h f)
      (mapcar #'(lambda (n) (zerop (mod year n))) '(400 100 4))
    (or fh (and (not h) f))))


MODULE LeapYear;
IMPORT StdLog, Strings, Args;

PROCEDURE IsLeapYear(year: INTEGER): BOOLEAN;
BEGIN
	IF year MOD 4 # 0 THEN
    	RETURN FALSE
	ELSE
		IF year MOD 100 = 0 THEN
			IF year MOD 400  = 0 THEN RETURN TRUE ELSE RETURN FALSE END
		ELSE
			RETURN TRUE
		END
	END
END IsLeapYear;

PROCEDURE Do*;
VAR
	p: Args.Params;
	year,done,i: INTEGER;
BEGIN
	Args.Get(p);
	FOR i := 0 TO p.argc - 1 DO
		Strings.StringToInt(p.args[i],year,done);
		StdLog.Int(year);StdLog.String(":>");StdLog.Bool(IsLeapYear(year));StdLog.Ln
	END;

END Do;
END LeapYear.


p Time.leap_year?(2020)
p Time.leap_year?(2021)
p Time.leap_year?(2022)


class Leap {
  bool leapYear(num year) {
    return (year % 400 == 0) || (( year % 100 != 0) && (year % 4 == 0));

  bool isLeapYear(int year) =>
    (year % 4 == 0) && ((year % 100 != 0) || (year % 400 == 0));
  // Source: https://api.flutter.dev/flutter/quiver.time/isLeapYear.html
  }
}


[0q]s0
[1q]s1

[ S. [  l.   4% 0!=0    ## if y %   4:  return 0
        l. 100% 0!=1    ## if y % 100:  return 1
        l. 400% 0!=0    ## if y % 400:  return 0
        1               ##              return 1
     ]x s.L.
]sL                     ## L = isleapYear()

[   Sy
    lyn [ is ]P
    ly lLx
    [not ] 0:y
    [    ] 1:y
    ;yP
    [a leap year]P AP
    OsyLyo
]sT                     ## T = testYear()

1988 lTx
1989 lTx
1900 lTx
2000 lTx


program TestLeapYear;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  Year: Integer;

begin
  Write('Enter the year: ');
  Readln(Year);
  if IsLeapYear(Year) then
    Writeln(Year, ' is a Leap year')
  else
    Writeln(Year, ' is not a Leap year');
  Readln;
end.


proc nonrec leap_year(word year) bool:
    year%400=0 or (year%4=0 and year%100/=0)
corp

proc nonrec main() void:
    [15]word years = (1899, 1900, 1901, 1902, 1903, 1904, 1905, 1999,
                      2000, 2001, 2002, 2003, 2004, 2021, 2022);
    word i;

    for i from 0 upto 14 do
        writeln(years[i],
                if leap_year(years[i]) then " is " else " is not " fi,
                "a leap year.")
    od
corp


function IsLeapYear(y : Integer) : Boolean;
begin
   Result:=    (y mod 4 = 0)
           and (   ((y mod 100) <> 0)
                or ((y mod 400) = 0) );
end;

const good : array [0..13] of Integer =
   [1600,1660,1724,1788,1848,1912,1972,2032,2092,2156,2220,2280,2344,2348];
const bad : array [0..13] of Integer =
   [1698,1699,1700,1750,1800,1810,1900,1901,1973,2100,2107,2200,2203,2289];

var i : Integer;

PrintLn('Checking leap years');
for i in good do
   if not IsLeapYear(i) then PrintLn(i);

PrintLn('Checking non-leap years');
for i in bad do
   if IsLeapYear(i) then PrintLn(i);


leap_year? = fn(year) -> :calendar.is_leap_year(year) end
IO.inspect for y <- 2000..2020, leap_year?.(y), do: y


(defun leap-year-p (year)
  (apply (lambda (a b c) (or a (and (not b) c)))
	 (mapcar (lambda (n) (zerop (mod year n)))
		 '(400 100 4))))


-module(gregorian).
-export([leap/1]).

leap( Year ) -> calendar:is_leap_year( Year ).


PROGRAM LEAP_YEAR

FUNCTION LEAP(YR%)
     LEAP=(YR% MOD 4=0) AND ((YR% MOD 400=0) OR (YR% MOD 100<>0))
END FUNCTION

BEGIN
     LOOP
        INPUT("Enter a year: ",year%)
        EXIT IF YEAR%=0
        IF LEAP(year%) THEN
            PRINT(year%;" is a leap year")
          ELSE
            PRINT(year%;" is not a leap year")
        END IF
     END LOOP
END PROGRAM


function isLeapYear(integer year)
    return remainder(year,4)=0 and remainder(year,100)!=0 or remainder(year,400)=0
end function


=IF(OR(NOT(MOD(A1,400)),AND(NOT(MOD(A1,4)),MOD(A1,100))),"Leap Year","Not a Leap Year")


let isLeapYear = System.DateTime.IsLeapYear
assert isLeapYear 1996
assert isLeapYear 2000
assert not (isLeapYear 2001)
assert not (isLeapYear 1900)


USING: calendar prettyprint ;
2011 leap-year? .


Function IsLeap(y) = if y|4>0 then 0 else if y|100=0 and y|400>0 then 0 else 1 fi fi.


: leap-year? ( y -- ? )
  dup 400 mod 0= if drop true  exit then
  dup 100 mod 0= if drop false exit then
        4 mod 0= ;


program leap
 implicit none

 write(*,*) leap_year([1900, 1996, 1997, 2000])

 contains

	pure elemental function leap_year(y) result(is_leap)
	implicit none
	logical :: is_leap
	integer,intent(in) :: y

	is_leap = (mod(y,4)==0 .and. .not. mod(y,100)==0) .or. (mod(y,400)==0)

	end function leap_year

end program leap


' version 23-06-2015
' compile with: fbc -s console

#Ifndef TRUE        ' define true and false for older freebasic versions
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

Function leapyear(Year_ As Integer) As Integer

    If (Year_ Mod 4) <> 0 Then Return FALSE
    If (Year_ Mod 100) = 0 AndAlso (Year_ Mod 400) <> 0 Then Return FALSE
    Return TRUE

End Function

' ------=< MAIN >=------

' year is a FreeBASIC keyword
Dim As Integer Year_

For Year_ = 1800 To 2900 Step 100
    Print Year_; IIf(leapyear(Year_), " is a leap year", " is not a leap year")
Next

Print : Print

For Year_ = 2012 To 2031
    Print Year_;
    If leapyear(Year_) = TRUE Then
        Print " = leap",
    Else
        Print " = no",
    End If
    If year_ Mod 4 = 3 Then Print ' lf/cr
Next

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


window 1

// In-line C function to generate random number in range
BeginCFunction
  long randomInRange( long min, long max ) {
  int i = (arc4random()%(max-min+1))+min;
  return (long)i;
  }
EndC
toolbox fn randomInRange( long min, long max  ) = long

// Leap year test function
local fn LeapYear( year as long ) as BOOL
  BOOL result : result = _false

  if year mod 400 == 0 then result = _true  : exit fn
  if year mod 100 == 0 then result = _false : exit fn
  if year mod   4 == 0 then result = _true  : exit fn
  if year mod   4 != 0 then result = _false : exit fn
end fn = result

long i, y, knownLeapYear(10)

// Array of known leap years from 1980 through 2020 for control
knownLeapYear(0) = 1980 : knownLeapYear(1)  = 1984 : knownLeapYear(2) = 1988
knownLeapYear(3) = 1992 : knownLeapYear(4)  = 1996 : knownLeapYear(5) = 2000
knownLeapYear(6) = 2004 : knownLeapYear(7)  = 2008 : knownLeapYear(8) = 2012
knownLeapYear(9) = 2016 : knownLeapYear(10) = 2020

print "Known leap years:"
for i = 0 to 9
  if ( fn LeapYear( knownLeapYear(i) ) == _true )
    print knownLeapYear(i); " is a leap year."
  else
    print knownLeapYear(i); " is a not leap year."
  end if
next

print

// Random years from 1980 to 2020 to test
print "Check random years:"
for i = 0 to 20
  y = fn randomInRange( 1980, 2020  )
  if ( fn LeapYear( y ) == _true )
    print y; " is a leap year."
  else
    print y; " is a not leap year."
  end if
next

HandleEvents


Public Sub Form_Open()
Dim dDate As Date
Dim siYear As Short = InputBox("Enter a year", "Leap year test")
Dim sMessage As String = " is a leap year."

Try dDate = Date(siYear, 02, 29)
If Error Then sMessage = " is not a leap year."

Message(siYear & sMessage)

End


IsLeapYear := function(n)
  return (n mod 4 = 0) and ((n mod 100 <> 0) or (n mod 400 = 0));
end;

# alternative using built-in function
IsLeapYear := function(n)
  return DaysInYear(n) = 366;
end;


[indent=4]
/*
   Leap year, in Genie

   valac leapYear.gs
   ./leapYear
*/
init
    years:array of DateYear = {1900, 1994, 1996, 1997, 2000, 2100}

    for year in years
        status:string = year.is_leap_year() ? "" : "not "
        stdout.printf("%d is %sa leap year.\n", year, status)


func isLeap(year int) bool {
    return year%400 == 0 || year%4 == 0 && year%100 != 0
}


(1900..2012).findAll {new GregorianCalendar().isLeapYear(it)}.each {println it}


10  ' Leap year
20  DEF FN ISLEAPYEAR(Y%) = ((Y% MOD 4 = 0) AND (Y% MOD 100 <> 0)) OR (Y% MOD 400 = 0)
95  ' *** Test ***
100 FOR I% = 1 TO 5
110  READ YEAR%
120  PRINT YEAR%; "is ";
130  IF FN ISLEAPYEAR(YEAR%) = 0 THEN PRINT "not "; ELSE PRINT "";
140  PRINT "a leap year."
150 NEXT I%
160 END
200 DATA 1900, 1994, 1996, 1997, 2000


FUNCTION IsLeapYear( nYear )
   RETURN iif( nYear % 100 == 0, nYear % 400 == 0, nYear % 4 == 0 )


import Data.List
import Control.Monad
import Control.Arrow

leaptext x b | b = show x ++ " is a leap year"
	     | otherwise = show x ++  " is not a leap year"

isleapsf j | 0==j`mod`100 = 0 == j`mod`400
	   | otherwise    = 0 == j`mod`4


procedure main(arglist)
every y := !([2000,1900,2012]|||arglist) do
  write("The year ",y," is ", leapyear(y) | "not ","a leap year.")
end

procedure leapyear(year)		#: determine if year is leap
   if (numeric(year) % 4 = 0 & year % 100 ~= 0) | (numeric(year) % 400 = 0) then return
end


import java.util.GregorianCalendar;
import java.text.MessageFormat;

public class Leapyear{
        public static void main(String[] argv){
                int[] yrs = {1800,1900,1994,1998,1999,2000,2001,2004,2100};
                GregorianCalendar cal = new GregorianCalendar();
                for(int year : yrs){
                        System.err.println(MessageFormat.format("The year {0,number,#} is leaper: {1} / {2}.",
                                                                 year, cal.isLeapYear(year), isLeapYear(year)));
                }

        }
        public static boolean isLeapYear(int year){
                return (year % 100 == 0) ? (year % 400 == 0) : (year % 4 == 0);
        }
}


var isLeapYear = function (year) { return (year % 100 === 0) ? (year % 400 === 0) : (year % 4 === 0); };


fun isLeapYear(year: Int) = year % 400 == 0 || (year % 100 != 0 && year % 4 == 0)


define isLeapYear(y::integer) => {
	#y % 400 == 0 ? return true
	#y % 100 == 0 ? return false
	#y % 4 == 0 ? return true
	return false
}

with test in array(2012,2016,1933,1900,1999,2000) do => {^
	isLeapYear(#test)
	'\r'
^}


if leap(1996)then
    print "leap"
else
    print "ordinary"
end if
wait

function leap(n)
    leap=date$("2/29/";n)
end function


on isLeapYear (year)
  return date(year, 2, 29).month=2
end


function isLeapYear year
    return (year MOD 4 is 0) AND ((year MOD 400 is 0) OR (year MOD 100 is not 0))
end isLeapYear

command testLeapYear
    set itemDelimiter to comma
    put  "1900,1994,1996,1997,2000" into years
    repeat for each item y in years
        put y && "is" && isLeapYear(y) && return after tyears
    end repeat
    put tyears
end testLeapYear

1900 is false
1994 is false
1996 is true
1997 is false
2000 is true


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

$"EMPTY_STR" = comdat any
$"NOT_STR" = comdat any
$"IS_A_LEAP_YEAR" = comdat any

@main.test_case = private unnamed_addr constant [5 x i32] [i32 1900, i32 1994, i32 1996, i32 1997, i32 2000], align 16
@"EMPTY_STR" = linkonce_odr unnamed_addr constant [1 x i8] zeroinitializer, comdat, align 1
@"NOT_STR" = linkonce_odr unnamed_addr constant [5 x i8] c"not \00", comdat, align 1
@"IS_A_LEAP_YEAR" = linkonce_odr unnamed_addr constant [22 x i8] c"%d is %sa leap year.\0A\00", comdat, align 1

;--- The declaration for the external C printf function.
declare i32 @printf(i8*, ...)

; Function Attrs: noinline nounwind optnone uwtable
define i32 @is_leap_year(i32) #0 {
  %2 = alloca i32, align 4              ;-- allocate a local copy of year
  store i32 %0, i32* %2, align 4        ;-- store a copy of year

  %3 = load i32, i32* %2, align 4       ;-- load the year
  %4 = srem i32 %3, 4                   ;-- year % 4
  %5 = icmp ne i32 %4, 0                ;-- (year % 4) != 0
  br i1 %5, label %c1false, label %c1true

c1true:
  %6 = load i32, i32* %2, align 4       ;-- load the year
  %7 = srem i32 %6, 100                 ;-- year % 100
  %8 = icmp ne i32 %7, 0                ;-- (year % 100) != 0
  br i1 %8, label %c2true, label %c1false

c1false:
  %9 = load i32, i32* %2, align 4       ;-- load the year
  %10 = srem i32 %9, 400                ;-- year % 400
  %11 = icmp ne i32 %10, 0              ;-- (year % 400) != 0
  %12 = xor i1 %11, true
  br label %c2true

c2true:
  %13 = phi i1 [ true, %c1true ], [ %12, %c1false ]
  %14 = zext i1 %13 to i64
  %15 = select i1 %13, i32 1, i32 0
  ret i32 %15
}

; Function Attrs: noinline nounwind optnone uwtable
define i32 @main() #0 {
  %1 = alloca [5 x i32], align 16       ;-- allocate test_case
  %2 = alloca i32, align 4              ;-- allocate key
  %3 = alloca i32, align 4              ;-- allocate end
  %4 = alloca i32, align 4              ;-- allocate year
  %5 = bitcast [5 x i32]* %1 to i8*
  call void @llvm.memcpy.p0i8.p0i8.i64(i8* %5, i8* bitcast ([5 x i32]* @main.test_case to i8*), i64 20, i32 16, i1 false)
  store i32 0, i32* %2, align 4         ;-- store 0 in key
  store i32 5, i32* %3, align 4         ;-- store 5 in end
  br label %loop

loop:
  %6 = load i32, i32* %2, align 4       ;-- load key
  %7 = load i32, i32* %3, align 4       ;-- load end
  %8 = icmp slt i32 %6, %7              ;-- key < end
  br i1 %8, label %loop_body, label %exit

loop_body:
  %9 = load i32, i32* %2, align 4       ;-- load key
  %10 = sext i32 %9 to i64              ;-- sign extend key
  %11 = getelementptr inbounds [5 x i32], [5 x i32]* %1, i64 0, i64 %10
  %12 = load i32, i32* %11, align 4     ;-- load test_case[key]
  store i32 %12, i32* %4, align 4       ;-- store test_case[key] as year

  %13 = load i32, i32* %4, align 4      ;-- load year
  %14 = call i32 @is_leap_year(i32 %13) ;-- is_leap_year(year)
  %15 = icmp eq i32 %14, 1              ;-- is_leap_year(year) == 1
  %16 = zext i1 %15 to i64              ;-- zero extend
  %17 = select i1 %15, i8* getelementptr inbounds ([1 x i8], [1 x i8]* @"EMPTY_STR", i32 0, i32 0), i8* getelementptr inbounds ([5 x i8], [5 x i8]* @"NOT_STR", i32 0, i32 0)

  %18 = load i32, i32* %4, align 4      ;-- load year
  %19 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([22 x i8], [22 x i8]* @"IS_A_LEAP_YEAR", i32 0, i32 0), i32 %18, i8* %17)

  %20 = load i32, i32* %2, align 4      ;-- load key
  %21 = add nsw i32 %20, 1              ;-- increment key
  store i32 %21, i32* %2, align 4       ;-- store key
  br label %loop

exit:
  ret i32 0
}

; Function Attrs: argmemonly nounwind
declare void @llvm.memcpy.p0i8.p0i8.i64(i8* nocapture writeonly, i8* nocapture readonly, i64, i32, i1) #1

attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
attributes #1 = { argmemonly nounwind }


to multiple? :n :d
  output equal? 0 modulo :n :d
end
to leapyear? :y
  output ifelse multiple? :y 100 [multiple? :y 400] [multiple? :y 4]
end


BTW  Determine if a Gregorian calendar year is leap
HAI 1.3
HOW IZ I Leap YR Year
  BOTH SAEM 0 AN MOD OF Year AN 4
  O RLY?
    YA RLY
      BOTH SAEM 0 AN MOD OF Year AN 100
      O RLY?
        YA RLY
          BOTH SAEM 0 AN MOD OF Year AN 400
          O RLY?
            YA RLY
              FOUND YR WIN
            NO WAI
              FOUND YR FAIL
          OIC
        NO WAI
          FOUND YR WIN
        OIC
    NO WAI
      FOUND YR FAIL
    OIC
IF U SAY SO

I HAS A Yearz ITZ A BUKKIT
Yearz HAS A SRS 0 ITZ 1900
Yearz HAS A SRS 1 ITZ 1904
Yearz HAS A SRS 2 ITZ 1994
Yearz HAS A SRS 3 ITZ 1996
Yearz HAS A SRS 4 ITZ 1997
Yearz HAS A SRS 5 ITZ 2000

IM IN YR LOOP UPPIN YR Index WILE DIFFRINT Index AN 6
  I HAS A YR ITZ Yearz'Z SRS Index
  I HAS A NOT
  I IZ Leap YR YR MKAY
  O RLY?
  YA RLY
   NOT R ""
  NO WAI
   NOT R " NOT"
  OIC
  VISIBLE YR " is" NOT " a leap year"
IM OUTTA YR LOOP

KTHXBYE


function isLeapYear(year)
  return year%4==0 and (year%100~=0 or year%400==0)
end


isLeapYear := proc(year)
	if not year mod 4 = 0 or (year mod 100 = 0 and not year mod 400 = 0) then
		return false;
	else
		return true;
	end if;
end proc:


function TrueFalse = isLeapYear(year)
    TrueFalse = (eomday(year,2) == 29);
end


leapyearp(year) := is(mod(year, 4) = 0 and
   (mod(year, 100) # 0 or mod(year, 400) = 0))$


:- pred is_leap_year(int::in) is semidet.

is_leap_year(Year) :-
   ( if Year mod 100 = 0 then Year mod 400 = 0 else Year mod 4 = 0 ).


(mod 0 ==) :divisor?
(((400 divisor?) (4 divisor?) (100 divisor? not)) cleave and or) :leap-year?


isLeapYear = function(year)
  return year%4==0 and (year % 100 or not year % 400)
end function


IsLeap:	andi $a1, $a0, 3 #a0 is year to test
	bnez $a1 NotLeap
	li $a1, 100
	div $a0, $a1
	mfhi $a1
	bnez $a1, Leap
	mflo $a1
	andi $a1, $a1, 3
	bnez $a1, NotLeap
Leap:	li $v0, 1
	jr $ra
NotLeap:li $v0, 0
	jr $ra


MODULE LeapYear;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,ReadChar;

PROCEDURE IsLeapYear(year : INTEGER) : BOOLEAN;
BEGIN
    IF year MOD 100 = 0 THEN
        RETURN year MOD 400 = 0;
    END;
    RETURN year MOD 4 = 0
END IsLeapYear;

PROCEDURE Print(year : INTEGER);
VAR
    buf : ARRAY[0..63] OF CHAR;
    leap : BOOLEAN;
BEGIN
    leap := IsLeapYear(year);
    FormatString("Is %i a leap year? %b\n", buf, year, leap);
    WriteString(buf)
END Print;

BEGIN
    Print(1900);
    Print(1994);
    Print(1996);
    Print(1997);
    Print(2000);
    ReadChar
END LeapYear.


def isLeapYear(year)
	if (year % 100 = 0)
		return (year % 400 = 0)
	else
		return (year % 4 = 0)
	end
end


/**
 <doc>
Leap year, in Neko
</doc>
**/

var leapyear = function(y) return ($not(y % 4) && $istrue(y % 100) || $not(y % 400))

var tests = $array(2000, 1997, 1996, 1994, 1990, 1980, 1900)
var cnt = $asize(tests)
while (cnt -= 1) >= 0 $print(tests[cnt], if leapyear(tests[cnt]) " is" else " is not", " a leapyear", "\n")


using System;
using System.Console;
using Nemerle.Assertions;
using Nemerle.Imperative;

module LeapYear
{
    IsLeapYear(year : int) : bool
      requires year >= 1582 otherwise throw ArgumentOutOfRangeException("year must be in Gregorian calendar.")
      // without the contract enforcement would work for proleptic Gregorian Calendar
      // in that case we might still want to require year > 0
    {
        when (year % 400 == 0) return true;
        when (year % 100 == 0) return false;
        when (year % 4   == 0) return true;
        false

    }

    Main() : void
    {
        WriteLine("2000 is a leap year: {0}", IsLeapYear(2000));
        WriteLine("2100 is a leap year: {0}", IsLeapYear(2100));
        try {
            WriteLine("1500 is a leap year: {0}", IsLeapYear(1500));
        }
        catch {
            |e is ArgumentOutOfRangeException => WriteLine(e.Message)
        }
        WriteLine("1500 is a leap year: {0}", DateTime.IsLeapYear(1500)); // is false, indicating use of proleptic
                                                                          // Gregorian calendar rather than reverting to
                                                                          // Julian calendar
        WriteLine("{0} is a leap year: {1}", DateTime.Now.Year,
                                             DateTime.IsLeapYear(DateTime.Now.Year));
    }
}


/* NetRexx */

options replace format comments java crossref savelog symbols nobinary

years = '1500 1580 1581 1582 1583 1584 1600 1700 1800 1900 1994 1996 1997 2000 2004 2008 2009 2010 2011 2012 2100 2200 2300 2400 2500 2600'
years['l-a'] = ''
years['n-a'] = ''
years['l-j'] = ''
years['n-j'] = ''

loop y_ = 1 to years.words
  year = years.word(y_)
  if isLeapyear(year) then years['l-a'] = years['l-a'] year
                      else years['n-a'] = years['n-a'] year
  if GregorianCalendar().isLeapYear(year) then years['l-j'] = years['l-j'] year
                                          else years['n-j'] = years['n-j'] year
  end y_

years['l-a'] = years['l-a'].strip
years['n-a'] = years['n-a'].strip
years['l-j'] = years['l-j'].strip
years['n-j'] = years['n-j'].strip

say ' Sample years:' years['all'].changestr(' ', ',')
say '     Leap years (algorithmically):' years['l-a'].changestr(' ', ',')
say '     Leap years (Java library)   :' years['l-j'].changestr(' ', ',')
say ' Non-leap years (algorithmically):' years['n-a'].changestr(' ', ',')
say ' Non-leap years (Java library)   :' years['n-j'].changestr(' ', ',')

return

-- algorithmically
method isLeapyear(year = int) public constant binary returns boolean
  select
    when year // 400 = 0 then ly = isTrue
    when year // 100 \= 0 & year // 4 = 0 then ly = isTrue
    otherwise ly = isFalse
    end
  return ly

method isTrue public constant binary returns boolean
  return 1 == 1

method isFalse public constant binary returns boolean
  return \isTrue


import times
let year = 1980
echo isLeapYear(year)

# or

proc isLeapYear2(year: Natural): bool =
  if year mod 100 == 0:
    year mod 400 == 0
  else: year mod 4 == 0

echo isLeapYear2(year)


10 INPUT "ENTER A NUMBER, AND I'LL DETECT IF IT'S A LEAP YEAR OR NOT. ",A
20 IF A-(A/100)*100=0 AND A-(A/400)*400<>0 THEN RESULT$="NOT "
30 PRINT "THAT'S "RESULT$"A LEAP YEAR."


PROCEDURE IsLeapYear(year: INTEGER): BOOLEAN;
BEGIN
  IF year MOD 4 # 0 THEN
    RETURN FALSE
  ELSE
    IF year MOD 100 = 0 THEN
      IF year MOD 400  = 0 THEN
	RETURN TRUE
      ELSE
	RETURN FALSE
      END
    ELSE
      RETURN TRUE
    END
 END
END IsLeapYear;


bundle Default {
  class LeapYear {
    function : Main(args : String[]) ~ Nil {
      test_case := [1900, 1994, 1996, 1997, 2000];
      each(i : test_case) {
        test_case[i]->Print();
        if(IsLeapYear(test_case[i])) {
          " is a leap year."->PrintLine();
        }
        else {
          " is not a leap year."->PrintLine();
        };
      };
    }

    function : native : IsLeapYear(year : Int) ~ Bool {
      if(year % 4 = 0 & year % 100 <> 0) {
        return true;
      }
      else if(year % 400 = 0) {
        return true;
      };

      return false;
    }
  }
}


let is_leap_year ~year =
  if (year mod 100) = 0
  then (year mod 400) = 0
  else (year mod 4) = 0


::routine isLeapYear
  use arg year
  d = .datetime~new(year, 1, 1)
  return d~isLeapYear


FUNCTION isLeapYear RETURNS LOGICAL (
   i_iyear AS INTEGER
):

   DATE( 2, 29, i_iyear ) NO-ERROR.
   RETURN NOT ERROR-STATUS:ERROR.

END FUNCTION. /* isLeapYear */

MESSAGE
   1900 isLeapYear( 1900 ) SKIP
   1994 isLeapYear( 1994 ) SKIP
   1996 isLeapYear( 1996 ) SKIP
   1997 isLeapYear( 1997 ) SKIP
   2000 isLeapYear( 2000 )
VIEW-AS ALERT-BOX.


declare
  fun {IsLeapYear Year}
     case Year mod 100 of 0 then
	Year mod 400 == 0
     else
	Year mod 4 == 0
     end
  end
in
  for Y in [1900 1996 1997 2000] do
     if {IsLeapYear Y} then
	{System.showInfo Y#" is a leap year."}
     else
	{System.showInfo Y#" is NOT a leap year."}
     end
  end


program LeapYear;
uses
  sysutils;//includes isLeapYear

procedure TestYear(y: word);
begin
  if IsLeapYear(y) then
    writeln(y,' is a leap year')
  else
    writeln(y,' is NO leap year');
end;
Begin
  TestYear(1900);
  TestYear(2000);
  TestYear(2100);
  TestYear(1904);
end.


sub isleap {
    my $year = shift;
    if ($year % 100 == 0) {
        return ($year % 400 == 0);
    }
    return ($year % 4 == 0);
}


global function is_leap_year(integer y)
    return remainder(y,4)=0 and (remainder(y,100)!=0 or remainder(y,400)=0)
end function


<?php
function isLeapYear($year) {
    if ($year % 100 == 0) {
        return ($year % 400 == 0);
    }
    return ($year % 4 == 0);
}


go =>
  foreach(Y in [1600,1700,1899,1900,2000,2006,2012])
     println(Y=cond(leap_year(Y),leap_year,not_leap_year))
  end,
  nl.

leap_year(Year) =>
  (Year mod 4 == 0, Year mod 100 != 0)
  ;
  Year mod 400 == 0.


(de isLeapYear (Y)
   (bool (date Y 2 29)) )


dcl mod  builtin;
dcl year fixed bin (31);

do year = 1900, 1996 to 2001;
  if mod(year, 4)    = 0 &
    (mod(year, 100) ^= 0 |
     mod(year, 400)  = 0) then
    put skip edit(year, 'is a leap year') (p'9999b', a);
  else
    put skip edit(year, 'is not a leap year') (p'9999b', a);
end;


100H: /* DETERMINE WHETHER SOME YEARS ARE LEAP YEARS OR NOT */

   /* CP/M BDOS SYSTEM CALL */
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5;END;
   /* CONSOLE OUTPUT ROUTINES */
   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C ); END;
   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
   PR$NL:     PROCEDURE; CALL PR$STRING( .( 0DH, 0AH, '$' ) );      END;
   PR$NUMBER: PROCEDURE( N );
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR( 6 ) BYTE INITIAL( '.....$' ), W BYTE;
      N$STR( W := LAST( N$STR ) - 1 ) = '0' + ( ( V := N ) MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL PR$STRING( .N$STR( W ) );
   END PR$NUMBER;

   /* TASK */
   /* RETURNS TRUE IF YEAR IS A LEAP YEAR, FALSE OTHERWISE  */
   /*         ASSUMES YEAR IS IN THE GREGORIAN CALENDAR     */
   IS$LEAP$YEAR: PROCEDURE( YEAR )BYTE;
      DECLARE YEAR ADDRESS;
      RETURN (  YEAR MOD 400 = 0
             OR ( YEAR MOD 4 = 0 AND YEAR MOD 100 <> 0 )
             );
   END IS$LEAPYEAR ;
   /* TEST CASES */
   DECLARE TEST$YEAR ( 15 )ADDRESS INITIAL( 1899, 1900, 1901, 1902, 1903
                                          , 1904, 1905, 1999, 2000, 2001
                                          , 2002, 2003, 2004, 2021, 2022
                                          );
   DECLARE Y$POS BYTE;
   DO Y$POS = 0 TO LAST( TEST$YEAR );
      CALL PR$NUMBER( TEST$YEAR( Y$POS ) );
      CALL PR$STRING( .' IS $' );
      IF NOT IS$LEAP$YEAR( TEST$YEAR( Y$POS ) ) THEN DO;
         CALL PR$STRING( .'NOT $' );
      END;
      CALL PR$STRING( .'A LEAP YEAR$' );
      CALL PR$NL;
   END;

EOF


/isleapyear {
    dup dup
    4 mod 0 eq     % needs to be divisible by 4
    exch
    100 mod 0 ne   % but not by 100
    and
    exch
    400 mod 0 eq   % or by 400
    or
} def


$Year = 2016
[System.DateTime]::IsLeapYear( $Year )


leap_year(L) :-
	partition(is_leap_year, L, LIn, LOut),
	format('leap years : ~w~n', [LIn]),
	format('not leap years : ~w~n', [LOut]).

is_leap_year(Year) :-
	R4 is Year mod 4,
	R100 is Year mod 100,
	R400 is Year mod 400,
	(   (R4 = 0, R100 \= 0); R400 = 0).


Procedure isLeapYear(Year)
  If (Year%4=0 And Year%100) Or Year%400=0
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure


ly:{((0<>x mod 100) | 0=x mod 400) & 0=x mod 4}    / Return 1b if x is a leap year; 0b otherwise


  [ dup 400 mod 0 = iff [ drop true  ] done
    dup 100 mod 0 = iff [ drop false ] done
          4 mod 0 = ]                       is leap? ( n --> b )


isLeapYear <- function(year) {
    ifelse(year%%100==0, year%%400==0, year%%4==0)
}

for (y in c(1900, 1994, 1996, 1997, 2000)) {
  cat(y, ifelse(isLeapYear(y), "is", "isn't"), "a leap year.\n")
}


(define (leap-year? y)
  (and (zero? (modulo y 4)) (or (positive? (modulo y 100)) (zero? (modulo y 400)))))


say "$year is a {Date.is-leap-year($year) ?? 'leap' !! 'common'} year."


define is_leap_year use $year
    $year 100 % 0 = if
        $year 400 % 0 =
    $year 4 % 0 =


leap-year?: func [
    {Returns true if the specified year is a leap year; false otherwise.}
    year [date! integer!]
    /local div?
][
    either date? year [year: year/year] [
        if negative? year [throw make error! join [script invalid-arg] year]
    ]
    ; The key numbers are 4, 100, and 400, combined as follows:
    ;   1) If the year is divisible by 4, it’s a leap year.
    ;   2) But, if the year is also divisible by 100, it’s not a leap year.
    ;   3) Double but, if the year is also divisible by 400, it is a leap year.
    div?: func [n] [zero? year // n]
    to logic! any [all [div? 4  not div? 100] div? 400]
]


:isLeapYear? (y-f)
    dup #400 mod n:zero? [ drop #-1 #0 ] [ #1 ] choose 0; drop
    dup #100 mod n:zero? [ drop  #0 #0 ] [ #1 ] choose 0; drop
    #4 mod n:zero? ;


leapyear:  procedure;    parse arg yr
return  yr//400==0  |  (yr//100\==0  &  yr//4==0)


give year
leap = isLeapYear(year)
if leap true see year + " is leap year."
else see year + " is not leap year." ok

Func isLeapYear year
     if (year % 400) = 0 return true
        but (year % 100) = 0 return false
        but (year % 4) = 0 return true
        else return false ok


     C*0N01N02N03Factor1+++OpcdeFactor2+++ResultLenDHHiLoEqComments+++++++
     C           *ENTRY    PLIST
     C                     PARM           YEAR    40       input (year)
     C                     PARM           ISLEAP  1        output (Y/N)
     C*
     C                     MOVE 'N'       ISLEAP
     C           YEAR      CABLE1752      DONE             not Gregorian
     C*
     C           YEAR      DIV  4         RESULT  40
     C                     MVR            REMAIN  40
     C           REMAIN    CABNE0         DONE
     C*
     C* If we got here, year is divisible by 4.
     C           YEAR      DIV  100       RESULT
     C                     MVR            REMAIN
     C           REMAIN    CABNE0         LEAPYR
     C*
     C* If we got here, year is divisible by 100.
     C           YEAR      DIV  400       RESULT
     C                     MVR            REMAIN
     C           REMAIN    CABNE0         DONE
     C*
     C           LEAPYR    TAG
     C                     MOVE 'Y'       ISLEAP
     C*
     C           DONE      TAG
     C                     SETON                     LR


if date$("02/29/" + mid$(date$("mm/dd/yyyy"),7,4)) then print "leap year" else print "not"


fn is_leap(year: i32) -> bool {
    let factor = |x| year % x == 0;
    factor(4) && (!factor(100) || factor(400))
}


rem  - compute p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)

rem - return true (-1) if y is a leap year, otherwise 0
function isleapyear(y = integer) = integer
end = mod(y,4)=0 and mod(y,100)<>0 or mod(y,400)=0

rem - exercise the function
var y = integer

print "Test of century years"
for y = 1600 to 2000 step 100
   if isleapyear(y) then
     print y;" is a leap year"
   else
     print y;" is NOT a leap year"
next y

print "Test of current half-decade"
for y = 2015 to 2020
   if isleapyear(y) then
     print y; " is a leap year"
   else
     print y; " is NOT a leap year"
next y

end


//use Java's calendar class
new java.util.GregorianCalendar().isLeapYear(year)


(define (leap-year? n)
(apply (lambda (a b c) (or a (and (not b) c)))
       (map (lambda (m) (zero? (remainder n m)))
            '(400 100 4))))


const func boolean: isLeapYear (in integer: year) is
  return (year rem 4 = 0 and year rem 100 <> 0) or year rem 400 = 0;


func isleap(year) {
    if (year %% 100) {
        return (year %% 400);
    }
    return (year %% 4);
}


        define('leap(yr)')  :(end_leap)
leap    eq(remdr(yr,400),0) :s(return)
        eq(remdr(yr,100),0) :s(freturn)
    	eq(remdr(yr,4),0)   :s(return)f(freturn)
end_leap

*       # Test and display (with ?: kluge)
        test = "output = ('10' ? (*leap(yr) 1 | 0)) ': ' yr"
        yr = '1066'; eval(test)
        yr = '1492'; eval(test)
        yr = '1900'; eval(test)
        yr = '2000'; eval(test)
end


fun isLeapYear y =
  y mod (if y mod 100 = 0 then 400 else 4) = 0


F minimumEditDistance(=s1, =s2)
   I s1.len > s2.len
      (s1, s2) = (s2, s1)

   V distances = Array(0 .. s1.len)

   L(char2) s2
      V newDistances = [L.index + 1]
      L(char1) s1
         I char1 == char2
            newDistances.append(distances[L.index])
         E
            newDistances.append(1 + min((distances[L.index], distances[L.index + 1], newDistances.last)))
      distances = newDistances
   R distances.last

print(minimumEditDistance(‘kitten’, ‘sitting’))
print(minimumEditDistance(‘rosettacode’, ‘raisethysword’))


gen leap = mod(year,400)==0 | mod(year,4)==0 & mod(year,100)!=0


func isLeapYear(year: Int) -> Bool {
    return year.isMultiple(of: 100) ? year.isMultiple(of: 400) : year.isMultiple(of: 4)
}

[1900, 1994, 1996, 1997, 2000].forEach { year in
    print("\(year): \(isLeapYear(year: year) ? "YES" : "NO")")
}


*        Levenshtein distance      - 22/04/2020
LEVENS   CSECT
         USING  LEVENS,R13         base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R8,1               ii=1
       DO WHILE=(C,R8,LE,NN)       do ii=1 to nn
         LR     R1,R8                ii
         SLA    R1,5                 *32
         LA     R4,SS-32(R1)         @ss(ii,1)
         MVC    S1,0(R4)             s1=ss(ii,1)
         LR     R1,R8                ii
         SLA    R1,1                 *2
         LA     R1,1(R1)             +1
         SLA    R1,4                 *16
         LA     R4,SS-32(R1)         @ss(ii,2)
         MVC    S2,0(R4)             s2=ss(ii,2)
         LA     R1,S1                @s1
         BAL    R14,LENGTHST         call length
         AH     R0,=H'1'             +1
         ST     R0,N1                n1=length(s1)+1
         LA     R1,S2                @s2
         BAL    R14,LENGTHST         call length
         AH     R0,=H'1'             +1
         ST     R0,N2                n2=length(s2)+1
         L      R4,N1                n1
       IF     C,R4,EQ,=F'1' THEN     if n1=1 then
         L      R3,N2                  n2
         BCTR   R3,0                   lev=n2-1
         B      RET                    goto ret
       ENDIF    ,                    endif
         L      R4,N2                n2
       IF     C,R4,EQ,=F'1' THEN     if n2=1 then
         L      R3,N1                  n1
         BCTR   R3,0                   lev=n1-1
         B      RET                    goto ret
       ENDIF    ,                    endif
         LA     R6,1                 i=1
       DO WHILE=(C,R6,LE,N1)         do i=1 to n1
         LR     R2,R6                  i
         BCTR   R2,0                   -1
         LR     R1,R6                  i
         SLA    R1,6                   *64
         ST     R2,D-64(R1)            d(i,1)=i-1
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         LA     R7,1                 j=1
       DO WHILE=(C,R7,LE,N2)         do j=1 to n2
         LR     R2,R7                  j
         BCTR   R2,0                   j-1
         LR     R1,R7                  j
         SLA    R1,2                   *4
         ST     R2,D-4(R1)             d(1,j)=j-1
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LA     R6,2                 i=2
       DO WHILE=(C,R6,LE,N1)         do i=2 to n1
         LA     R4,S1-2                @s1-2
         AR     R4,R6                  +i
         MVC    C1(1),0(R4)            c1=substr(s1,i-1,1)
         LA     R7,2                   j=2
       DO WHILE=(C,R7,LE,N2)           do j=2 to n2
         LA     R4,S2-2                  @s2-2
         AR     R4,R7                    +j
         MVC    C2(1),0(R4)              c2=substr(s2,j-1,1)
         LR     R1,R6                    i
         SH     R1,=H'2'                 -2
         SLA    R1,4                     *16
         AR     R1,R7                    +j
         SLA    R1,2                     *4
         L      R2,D-4(R1)               d(i-1,j)
         LA     R2,1(R2)                 +1
         ST     R2,D1                    d1=d(i-1,j)+1
         LR     R2,R7                    j
         BCTR   R2,0                     -1
         LR     R1,R6                    i
         BCTR   R1,0                     -1
         SLA    R1,4                     *16
         AR     R1,R2                    +(j-1)
         SLA    R1,2                     *4
         L      R2,D-4(R1)               d(i,j-1)
         LA     R2,1(R2)                 +1
         ST     R2,D2                    d2=d(i,j-1)+1
       IF   CLC,C1,NE,C2 THEN            if c1<>c2 then
         LA     R9,1                       x=1
       ELSE     ,                        else
         SR     R9,R9                      x=0
       ENDIF    ,                        endif
         LR     R1,R6                    i
         SH     R1,=H'2'                 i-2
         LR     R2,R7                    j
         BCTR   R2,0                     j-1
         SLA    R1,4                     *16
         AR     R1,R2                    +(j-1)
         SLA    R1,2                     *4
         L      R2,D-4(R1)               d(i-1,j-1)
         AR     R2,R9                    +x
         ST     R2,D3                    d3=d(i-1,j-1)+x
         L      R4,D1                    d1
       IF     C,R4,LT,D2 THEN            if d1<d2 then
       IF     C,R4,LT,D3 THEN              if d1<d3 then
         L      R10,D1                       dd=d1
       ELSE     ,                          else
         L      R10,D3                       dd=d3
       ENDIF    ,                          endif
       ELSE     ,                        else
         L      R4,D2                      d2
       IF     C,R4,LT,D3 THEN              if d2<d3 then
         L      R10,D2                       dd=d2
       ELSE     ,                          else
         L      R10,D3                       dd=d3
       ENDIF    ,                          endif
       ENDIF    ,                        endif
         LR     R1,R6                    i
         BCTR   R1,0                     i-1
         SLA    R1,4                     *16
         AR     R1,R7                    +j
         SLA    R1,2                     *4
         ST     R10,D-4(R1)              d(i,j)=dd
         LA     R7,1(R7)                 j++
       ENDDO    ,                      enddo j
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         L      R1,N1                n1
         BCTR   R1,0                 -1
         SLA    R1,4                 *16
         A      R1,N2                +n2
         SLA    R1,2                 *4
         L      R3,D-4(R1)           lev=d(n1,n2)
RET      MVC    PG,=CL80' '          clear buffer
         MVC    PG(16),S1            output s1
         MVC    PG+17(16),S2         output s2
         XDECO  R3,XDEC              edit lev
         MVC    PG+34(5),XDEC+7      output lev
         XPRNT  PG,L'PG              print bufffer
         LA     R8,1(R8)             ii++
       ENDDO    ,                  enddo ii
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
LENGTHST CNOP   0,4                function lengthst(c)
         LA     R0,16              i=16
         LA     R1,15(R1)          @ci
LENGTHS1 LTR    R0,R0              while i>0
         BZ     LENGTHS2           ..
         CLI    0(R1),C' '           if Mid(c,i,1)=" "
         BNE    LENGTHS2             then  exit while
         BCTR   R1,0                 @ci--
         BCTR   R0,0                 i--
         B      LENGTHS1           endwhile
LENGTHS2 BR     R14                return to caller
SS       DC     CL16'kitten',CL16'sitting'
         DC     CL16'rosettacode',CL16'raisethysword'
         DC     CL16'saturday',CL16'sunday'
         DC     CL16'sleep',CL16'fleeting'
NN       DC     A((NN-SS)/(2*L'SS))
N1       DS     F                  n1
N2       DS     F                  n2
S1       DS     CL16               s1
S2       DS     CL16               s2
D        DS     256F               d(16,16)
D1       DS     F                  d1
D2       DS     F                  d2
D3       DS     F                  d3
C1       DS     CL1                c1
C2       DS     CL1                c2
PG       DS     CL80               buffer
XDEC     DS     CL12               temp fo xdeco
         REGEQU
         END    LEVENS


DEFINE STRING="CHAR ARRAY" ; sys.act
DEFINE width="15" ; max characters 14
DEFINE MatrixSize="225" ; 15*15

PROC Set2Dm(INT ARRAY matrix, INT x,y, val)
  matrix(x+y*width)=val
RETURN

INT FUNC Get2Dm(INT ARRAY matrix, INT x,y)
  INT res
  res=matrix(x+y*width)
RETURN(res)

INT FUNC DamerauLevenshteinDistance(STRING str1, str2)
  INT ARRAY matrix(MatrixSize)
  BYTE Result, tmp, Min, K, L, I, J, M, N

  Result=0
  M=str1(0)
  N=str2(0)

  FOR I=0 TO MatrixSize-1 DO matrix(I)=0 OD
  FOR I=0 TO M DO Set2Dm(matrix, I,0, I) OD
  FOR J=0 TO N DO Set2Dm(matrix, 0,J, J) OD

  FOR J=1 TO N DO
    FOR I=1 TO M DO
      IF str1(I) = str2(J) THEN
        tmp=Get2Dm(matrix, I-1, J-1)
        Set2Dm(matrix, I,J, tmp) ; no operation required
      ELSE
        Min = Get2Dm(matrix, I-1,J)+1  ; REM delete
        K = Get2Dm(matrix, I,J-1)+1    ; REM insert
        L = Get2Dm(matrix, I-1, J-1)+1 ; REM substitution
        IF K < Min THEN Min=K FI
        IF L < Min THEN Min=L FI
        Set2Dm(matrix, I,J, Min)

        ;transposition for Damerau Levenshtein Distance
        ;IF I>1 AND J>1 THEN
        ;  IF str1(I) = str2(J-1) AND str1(I-1) = str2(J) THEN
        ;    Min=Get2Dm(matrix, I,J)
        ;    tmp=Get2Dm(matrix, I-2,J-2)+1
        ;    IF Min>tmp THEN Min=tmp FI
        ;    Set2Dm(matrix, I,J, Min) ; REM transposition
        ;  FI
        ;FI

      FI
    OD
  OD
  Result=Get2Dm(matrix, M,N)
RETURN(Result)

PROC MAIN()
  INT result
  STRING Word_1(15), Word_2(15)
  PUT(125)
  PUTE()

  SCopy(Word_1,"kitten") SCopy(Word_2,"sitting")
  PrintF("%S - %S%E",Word_1,Word_2)
  result=DamerauLevenshteinDistance(Word_1,Word_2)
  PrintF("Levenshtein Distance=%U%E%E",result)
  ;PrintF("Damerau Levenshtein Distance=%U%E%E",result)

  SCopy(Word_1,"rosettacode") SCopy(Word_2,"raisethysword")
  PrintF("%S - %S%E",Word_1,Word_2)
  result=DamerauLevenshteinDistance(Word_1,Word_2)
  PrintF("Levenshtein Distance=%U%E%E",result)
  ;PrintF("Damerau Levenshtein Distance=%U%E%E",result)

  SCopy(Word_1,"qwerty") SCopy(Word_2,"qweryt")
  PrintF("%S - %S%E",Word_1,Word_2)
  result=DamerauLevenshteinDistance(Word_1,Word_2)
  PrintF("Levenshtein Distance=%U%E%E",result)
  ;PrintF("Damerau Levenshtein Distance=%U%E%E",result)
RETURN


$$ MODE TUSCRIPT
LOOP year="1900'1994'1996'1997'2000",txt=""
SET dayoftheweek=DATE(number,29,2,year,number)
IF (dayoftheweek==0) SET txt="not "
PRINT year," is ",txt,"a leap year"
ENDLOOP


DO
  INPUT "Enter a year: "; y
  IF FUNC(_FNleap(y)) THEN
    PRINT y; " is a leap year"
  ELSE
    PRINT y; " is not a leap year"
  ENDIF
LOOP
END

_FNleap Param (1)
RETURN (([email protected] % 4 = 0) * (([email protected] % 400 = 0) + ([email protected] % 100 # 0)))


leap() {
  if expr $1 % 4 >/dev/null; then return 1; fi
  if expr $1 % 100 >/dev/null; then return 0; fi
  if expr $1 % 400 >/dev/null; then return 1; fi
  return 0;
}


decl int year
set year (int args<1>)
if (= (mod year 4) 0)
        if (and (= (mod year 100) 0) (not (= (mod year 400) 0)))
                out year " is not a leap year" endl console
        else
                out year " is a leap year" endl  console
        end if
else
        out year " is not a leap year" endl console
end if


with Ada.Text_IO;

procedure Main is
   function Levenshtein_Distance (S, T : String) return Natural is
      D : array (0 .. S'Length, 0 .. T'Length) of Natural;
   begin
      for I in D'Range (1) loop
         D (I, 0) := I;
      end loop;
      for I in D'Range (2) loop
         D (0, I) := I;
      end loop;
      for J in T'Range loop
         for I in S'Range loop
            if S (I) = T (J) then
               D (I, J) := D (I - 1, J - 1);
            else
               D (I, J) :=
                  Natural'Min
                    (Natural'Min (D (I - 1, J) + 1, D (I, J - 1) + 1),
                     D (I - 1, J - 1) + 1);
            end if;
         end loop;
      end loop;
      return D (S'Length, T'Length);
   end Levenshtein_Distance;
begin
   Ada.Text_IO.Put_Line
     ("kitten -> sitting:" &
      Integer'Image (Levenshtein_Distance ("kitten", "sitting")));
   Ada.Text_IO.Put_Line
     ("rosettacode -> raisethysword:" &
      Integer'Image (Levenshtein_Distance ("rosettacode", "raisethysword")));
end Main;


integer
dist(data s, t, integer i, j, list d)
{
    integer x;

    x = d[i * (~t + 1) + j];
    if (x == -1) {
        if (i == ~s) {
            x = ~t - j;
        } elif (j == ~t) {
            x = ~s - i;
        } elif (s[i] == t[j]) {
            x = dist(s, t, i + 1, j + 1, d);
        } else {
            x = dist(s, t, i + 1, j + 1, d)
                .min(dist(s, t, i, j + 1, d))
                .min(dist(s, t, i + 1, j, d));
            x += 1;
        }

        d[i * (~t + 1) + j] = x;
    }

    x;
}

levenshtein(data s, t)
{
    list d;

    d.pn_integer(0, (~s + 1) * (~t + 1), -1);
    dist(s, t, 0, 0, d);
}

main(void)
{
    text s1, s2;

    o_form("`~' to `~' is ~\n", s1 = "rosettacode", s2 = "raisethysword",
           levenshtein(s1, s2));
    o_form("`~' to `~' is ~\n", s1 = "kitten", s2 = "sitting",
           levenshtein(s1, s2));

    0;
}


void main() {
  DateYear[] years = { 1900, 1994, 1996, 1997, 2000 };
  foreach ( DateYear year in years ) {
    string status = year.is_leap_year() ? "" : "not ";
    print (@"$year is $(status)a leap year.\n");
  }
}


Public Function Leap_year(year As Integer) As Boolean
    Leap_year = (Month(DateSerial(year, 2, 29)) = 2)
End Function


Function IsLeapYear(yr)
	IsLeapYear = False
	If yr Mod 4 = 0 And (yr Mod 400 = 0 Or yr Mod 100 <> 0) Then
		IsLeapYear = True
	End If
End Function

'Testing the function.
arr_yr = Array(1900,1972,1997,2000,2001,2004)

For Each yr In arr_yr
	If IsLeapYear(yr) Then
		WScript.StdOut.WriteLine yr & " is leap year."
	Else
		WScript.StdOut.WriteLine yr & " is NOT leap year."
	End If
Next


# Calculate Levenshtein distance between strings - translated from the Action! sample #
BEGIN

PROC damerau levenshtein distance = (STRING str1, str2)INT:
BEGIN

  INT m=UPB str1;
  INT n=UPB str2;

  (0:m,0:n)INT matrix;

  FOR i FROM 0 TO m DO FOR j FROM 0 TO n DO matrix(i,j):=0 OD OD;
  FOR i TO m DO matrix(i,1):=i OD;
  FOR j TO n DO matrix(1,j):=j OD;

  FOR j FROM 1 TO n DO
    FOR i FROM 1 TO m DO
      IF str1(i) = str2(j) THEN
        matrix(i,j):=matrix(i-1, j-1) # no operation required #
      ELSE
        INT min := matrix(i-1,j)+1    ; # REM delete       #
        INT k    = matrix(i,j-1)+1    ; # REM insert       #
        INT l    = matrix(i-1, j-1)+1 ; # REM substitution #
        IF k < min THEN min:=k FI;
        IF l < min THEN min:=l FI;
        matrix(i,j):=min
COMMENT
        ;
        # transposition for Damerau Levenshtein Distance #
        IF i>1 AND j>1 THEN
          IF str1(i) = str2(j-1) AND str1(i-1) = str2(j) THEN
            INT min:=matrix(i,j);
            INT tmp=matrix(i-2,j-2)+1;
            IF min>tmp THEN min=tmp FI;
            matrix(i,j):=min  # REM transposition #
          FI
        FI
COMMENT
      FI
    OD
  OD;
  matrix(m,n)
END;

  STRING word 1, word 2;

  word 1 :="kitten"; word 2 := "sitting";
  print((word 1," - ",word 2,newline));
  print(("Levenshtein Distance=",whole(damerau levenshtein distance(word 1,word 2),0),newline));

  word 1 := "rosettacode"; word 2 := "raisethysword";
  print((word 1," - ",word 2,newline));
  print(("Levenshtein Distance=",whole(damerau levenshtein distance(word 1,word 2),0),newline));

  word 1 := "qwerty"; word 2 := "qweryt";
  print((word 1," - ",word 2,newline));
  print(("Levenshtein Distance=",whole(damerau levenshtein distance(word 1,word 2),0),newline))
END


Public Function IsLeapYear1(ByVal theYear As Integer) As Boolean
'this function utilizes documented behaviour of the built-in DateSerial function
IsLeapYear1 = (VBA.Day(VBA.DateSerial(theYear, 2, 29)) = 29)
End Function

Public Function IsLeapYear2(ByVal theYear As Integer) As Boolean
'this function uses the well-known formula
IsLeapYear2 = IIf(theYear Mod 100 = 0, theYear Mod 400 = 0, theYear Mod 4 = 0)
End Function


Module Module1

    Sub Main()
        For Each y In {1900, 1994, 1996, Date.Now.Year}
            Console.WriteLine("{0} is {1}a leap year.", y, If(Date.IsLeapYear(y), String.Empty, "not "))
        Next
    End Sub

End Module


set dist to findLevenshteinDistance for "sunday" against "saturday"
to findLevenshteinDistance for s1 against s2
    script o
        property l : s1
        property m : s2
    end script
    if s1 = s2 then return 0
    set ll to length of s1
    set lm to length of s2
    if ll = 0 then return lm
    if lm = 0 then return ll

    set v0 to {}

    repeat with i from 1 to (lm + 1)
        set end of v0 to (i - 1)
    end repeat
    set item -1 of v0 to 0
    copy v0 to v1

    repeat with i from 1 to ll
        -- calculate v1 (current row distances) from the previous row v0

        -- first element of v1 is A[i+1][0]
        --   edit distance is delete (i+1) chars from s to match empty t
        set item 1 of v1 to i
        --  use formula to fill in the rest of the row
        repeat with j from 1 to lm
            if item i of o's l = item j of o's m then
                set cost to 0
            else
                set cost to 1
            end if
            set item (j + 1) of v1 to min3 for ((item j of v1) + 1) against ((item (j + 1) of v0) + 1) by ((item j of v0) + cost)
        end repeat
        copy v1 to v0
    end repeat
    return item (lm + 1) of v1
end findLevenshteinDistance

to min3 for anInt against anOther by theThird
    if anInt < anOther then
        if theThird < anInt then
            return theThird
        else
            return anInt
        end if
    else
        if theThird < anOther then
            return theThird
        else
            return anOther
        end if
    end if
end min3


fn is_leap(year int) bool {
    return year %400 ==0 || (year%4 ==0 && year%100!=0)
}

fn main() {
    for y in 1950..2012 {
        if is_leap(y) {
            println(y)
        }
    }
}


let str => import 'strings';

let multiple of n => == (% n of) 0;

let leap year => str.format '{} is{} a leap year.' year (switch year {
  multiple 400 => '';
  multiple 100 => ' not';
  multiple 4 => '';
  default => ' not';
}) -- io.writeln io.stdout;


(module
  ;; function isLeapYear: returns 1 if its argument (e.g. 2004) is a leap year, 0 otherwise.
  ;; Returns year%4==0 and (year%100!=0 or year%400==0)
  (func $isLeapYear (param $year i32) (result i32)
    (i32.and
      (i32.eqz (i32.rem_u (get_local $year) (i32.const 4)))  ;; year%4 == 0
      (i32.or
        (i32.ne (i32.rem_u (get_local $year) (i32.const 100)) (i32.const 0))   ;; year%100 != 0
        (i32.eqz (i32.rem_u (get_local $year) (i32.const 400)))  ;; yaer%400 == 0
      )
    )
  )
  (export "isLeapYear" (func $isLeapYear))
)


var isLeapYear = Fn.new { |y|
    return ((y % 4 == 0) && (y % 100!= 0)) || (y % 400 == 0)
}

System.print("Leap years between 1900 and 2020 inclusive:")
var c = 0
for (i in 1900..2020) {
    if (isLeapYear.call(i)) {
        System.write("%(i) ")
        c = c + 1
        if (c % 15 == 0) System.print()
    }
}


(def levenshtein (str1 str2)
  (withs l1  len.str1
         l2  len.str2
         row range0:inc.l1

    (times j l2
      (let next list.j
        (times i l1
          (push
            (inc:min
              car.next
              ((if (is str1.i str2.j) dec id) car.row)
              (car:zap cdr row))
            next))
        (= row nrev.next)))
    row.l1))


    align 16
; Input year as signed dword in EAX
IsLeapYear:
    test eax,11b
    jz .4
    retn ; 75% : ZF=0, not a leap year
.4:
    mov ecx,100
    cdq
    idiv ecx
    test edx,edx
    jz .100
    cmp edx,edx
    retn ; 24% : ZF=1, leap year
.100:
    test eax,11b
    retn ; 1% : ZF=?, leap year if EAX%400=0


func LeapYear(Y);       \Return 'true' if Y is a leap year
int Y;
[if rem(Y/100)=0 then return rem(Y/400)=0;
return rem(Y/4)=0;
];


sub leapyear(year)
    if mod(year, 4) <> 0 then return false : fi
    if mod(year, 100) = 0 and mod(year, 400) <> 0 then return false : fi
    return TRUE
end sub

for year = 1800 to 2900 step 100
    print year;
	if leapyear(year) then print " is a leap year" else print " is not a leap year" : fi
next year

print

for year = 2012 to 2031
    print year;
    if leapyear(year) = TRUE then print " = leap"; else print " = no"; : fi
    if mod(year, 4) = 3 then print : fi
next year
end


levenshtein(s, t){
	If s =
		return StrLen(t)
	If t =
		return strLen(s)
	If SubStr(s, 1, 1) = SubStr(t, 1, 1)
		return levenshtein(SubStr(s, 2), SubStr(t, 2))
	a := Levenshtein(SubStr(s, 2), SubStr(t, 2))
	b := Levenshtein(s,            SubStr(t, 2))
	c := Levenshtein(SubStr(s, 2), t           )
	If (a > b)
		a := b
	if (a > c)
		a := c
	return a + 1
}
s1 := "kitten"
s2 := "sitting"
MsgBox % "distance between " s1 " and " s2 ": " levenshtein(s1, s2)