def grey_encode(n) -> int:
    return n ^ (n >> 1)

def grey_decode(n) -> int:
    var p = n
    n = n >> 1
    while n != 0:
        p = p ^ n
        n = n >> 1
    return p

for(32) i:
    let g = grey_encode(i)
    let b = grey_decode(g)
    print(number_to_string(i, 10, 2) + " : " +
          number_to_string(i,  2, 5) + " ⇾ " +
          number_to_string(g,  2, 5) + " ⇾ " +
          number_to_string(b,  2, 5) + " : " +
          number_to_string(b, 10, 2))


to gray_encode :number
  output bitxor :number lshift :number -1
end

to gray_decode :code
  local "value
  make "value 0
  while [:code > 0] [
    make "value bitxor :code :value
    make "code lshift :code -1
  ]
  output :value
end


local _M = {}

local bit  = require('bit')
local math = require('math')

_M.encode = function(number)
  return bit.bxor(number, bit.rshift(number, 1));
end

_M.decode = function(gray_code)
  local value = 0
  while gray_code > 0 do
    gray_code, value = bit.rshift(gray_code, 1), bit.bxor(gray_code, value)
  end
  return value
end

return _M


var BN=Import("zklBigNum");  // only needed for large N
fcn hamming(N){
   h:=List.createLong(N+1); (0).pump(N+1,h.write,Void); // fill list with stuff
   h[0]=1;
#if 1  // regular (64 bit) ints
   x2:=2; x3:=3; x5:=5; i:=j:=k:=0;
#else  // big ints
   x2:=BN(2); x3:=BN(3); x5:=BN(5); i:=j:=k:=0;
#endif
   foreach n in ([1..N]){
      z:=(x2<x3) and x2 or x3; z=(z<x5) and z or x5; h[n]=z;
      if (h[n] == x2) { x2 = h[i+=1]*2 }
      if (h[n] == x3) { x3 = h[j+=1]*3 }
      if (h[n] == x5) { x5 = h[k+=1]*5 }
   }
   return(h[N-1])
}
[1..20].apply(hamming).println();
hamming(1691).println();


function sumt(t, start, last) return start <= last and t[start] + sumt(t, start+1, last) or 0 end
function maxsub(ary, idx)
  local idx = idx or 1
  if not ary[idx] then return {} end
  local maxsum, last = 0, idx
  for i = idx, #ary do
    if sumt(ary, idx, i) > maxsum then maxsum, last = sumt(ary, idx, i), i end
  end
  local v = maxsub(ary, idx + 1)
  if maxsum < sumt(v, 1, #v) then return v end
  local ret = {}
  for i = idx, last do ret[#ret+1] = ary[i] end
  return ret
end


divert(-1)
define(`setrange',`ifelse(`$3',`',$2,`define($1[$2],$3)`'setrange($1,
   incr($2),shift(shift(shift([email protected]))))')')
define(`asize',decr(setrange(`a',1,-1,-2,3,5,6,-2,-1,4,-4,2,-1)))
define(`get',`defn(`$1[$2]')')
define(`for',
   `ifelse($#,0,``$0'',
   `ifelse(eval($2<=$3),1,
   `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')
define(`maxsum',0)
for(`x',1,asize,
   `define(`sum',0)`'for(`y',x,asize,
      `define(`sum',eval(sum+get(`a',y)))`'ifelse(eval(sum>maxsum),1,
         `define(`maxsum',sum)`'define(`xmax',x)`'define(`ymax',y)')')')
divert
for(`x',xmax,ymax,`get(`a',x) ')


-- demo\rosetta\Bitmap_Greyscale.exw  (runnable version)

function to_grey(sequence image)
    integer dimx = length(image),
            dimy = length(image[1])
    for x=1 to dimx do
        for y=1 to dimy do
            integer pixel = image[x][y]          -- red,green,blue
            sequence r_g_b  =  sq_and_bits(pixel,{#FF0000,#FF00,#FF})
            integer {r,g,b} = sq_floor_div(r_g_b,{#010000,#0100,#01})
            image[x][y] = floor(0.2126*r + 0.7152*g + 0.0722*b)*#010101
        end for
    end for
    return image
end function

--include ppm.e   -- read_ppm(), write_ppm(), to_grey()  (as distributed, instead of the above)

sequence img = read_ppm("Lena.ppm")
img = to_grey(img)
write_ppm("LenaGray.ppm",img)


class BitmapGrayscale extends Bitmap {
  public function toGrayscale(){
    for ($i = 0; $i < $this->h; $i++){
      for ($j = 0; $j < $this->w; $j++){
        $l = ($this->data[$j][$i][0] * 0.2126)
           + ($this->data[$j][$i][1] * 0.7152)
           + ($this->data[$j][$i][2] * 0.0722);
        $l = round($l);
        $this->data[$j][$i] = array($l,$l,$l);
      }
    }
  }
}

$b = new BitmapGrayscale(16,16);
$b->fill(0,0,null,null, array(255,255,0));
$b->setPixel(0, 15, array(255,0,0));
$b->setPixel(0, 14, array(0,255,0));
$b->setPixel(0, 13, array(0,0,255));
$b->toGrayscale();
$b->writeP6('p6-grayscale.ppm');


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Go_Fish
use warnings;
use List::Util qw( first shuffle );

my $pat = qr/[atjqk2-9]/; # ranks
my $deck = join '', shuffle map { my $rank = $_; map "$rank$_", qw( S H C D ) }
  qw( a t j q k ), 2 .. 9;

my $mebooks = my $youbooks = 0;

my $me = substr $deck, 0, 2 * 9, '';
my $mepicks = join '', $me =~ /$pat/g;
arrange($me);
$mebooks++ while $me =~ s/($pat).\1.\1.\1.//;
my $you = substr $deck, 0, 2 * 9, '';
my $youpicks = join '', $you =~ /$pat/g;
arrange($you);
$youbooks++ while $you =~ s/($pat).\1.\1.\1.//;

while( $mebooks + $youbooks < 13 )
  {
  play( \$you, \$youbooks, \$youpicks, \$me, \$mebooks, 1 );
  $mebooks + $youbooks == 13 and last;
  play( \$me, \$mebooks, \$mepicks, \$you, \$youbooks, 0 );
  }
print "me $mebooks you $youbooks\n";

sub arrange { $_[0] = join '', sort $_[0] =~ /../g }

sub human
  {
  my $have = shift =~ s/($pat).\K(?!\1)/ /gr;
  local $| = 1;
  my $pick;
  do
    {
    print "You have $have, enter request: ";
    ($pick) = lc(<STDIN>) =~ /$pat/g;
    } until $pick and $have =~ /$pick/;
  return $pick;
  }

sub play
  {
  my ($me, $mb, $lastpicks, $you, $yb, $human) = @_;
  my $more = 1;
  while( arrange( $$me ), $more and $$mb + $$yb < 13 )
    {
#   use Data::Dump 'dd'; dd \@_, "deck $deck";
    if( $$me =~ s/($pat).\1.\1.\1.// )
      {
      print "book of $&\n";
      $$mb++;
      }
    elsif( $$me )
      {
      my $pick = $human ? do { human($$me) } : do
        {
        my %picks;
        $picks{$_}++ for my @picks = $$me =~ /$pat/g;
        my $pick = first { $picks{$_} } split(//, $$lastpicks), shuffle @picks;
        print "pick $pick\n";
        $$lastpicks =~ s/$pick//g;
        $$lastpicks .= $pick;
        $pick;
        };
      if( $$you =~ s/(?:$pick.)+// )
        {
        $$me .= $&;
        }
      else
        {
        print "GO FISH !!\n";
        $$me .= substr $deck, 0, 2, '';
        $more = 0;
        }
      }
    elsif( $deck )
      {
      $$me .= substr $deck, 0, 2, '';
      }
    else
      {
      $more = 0;
      }
    }
  arrange( $$me );
  }


<Cfset theList = '1, 1000, 250, 13'>
<Cfparam name="maxNum" default=0>
<Cfloop list="#theList#" index="i">
  <Cfif i gt maxNum><Cfset maxNum = i></Cfif>
</Cfloop>
<Cfoutput>#maxNum#</Cfoutput>


(max 1 2 3 4)
(reduce #'max values) ; find max of a list
(loop for x in values
      maximize x) ; alternative way to find max of a list


Module Code32  (&code(), &decode()){
      Const d$="{0::-2} {1:-6} {2:-6} {3:-6} {4::-2}"
      For i=0 to 32
            g=code(i)
            b=decode(g)
            Print format$(d$, i, @bin$(i), @bin$(g), @bin$(b), b)
      Next
      // static function
      Function bin$(a)
            a$=""
            Do n= a mod 2 : a$=if$(n=1->"1", "0")+a$ : a|div 2 : Until a==0
            =a$
      End Function
}
Module GrayCode {
      Module doit (&a(), &b()) { }
      Function GrayEncode(a) {
            =binary.xor(a, binary.shift(a,-1))
      }
      Function GrayDecode(a) {
            b=0
            Do b=binary.xor(a, b) : a=binary.shift(a,-1) : Until a==0
            =b
      }
      // pass 2 functions to Code32
      doit &GrayEncode(), &GrayDecode()
}
// pass Code32 to GrayCode in place of doit
GrayCode ; doit as  Code32


%% Gray Code Generator
% this script generates gray codes of n bits
% total 2^n -1 continuous gray codes will be generated.
% this code follows a recursive approach. therefore,
% it can be slow for large n

clear all;
clc;

bits = input('Enter the number of bits: ');
if (bits<1)
    disp('Sorry, number of bits should be positive');
elseif (mod(bits,1)~=0)
    disp('Sorry, number of bits can only be positive integers');
else
    initial_container = [0;1];
    if bits == 1
        result = initial_container;
    else
        previous_container = initial_container;
        for i=2:bits
            new_gray_container = zeros(2^i,i);
            new_gray_container(1:(2^i)/2,1) = 0;
            new_gray_container(((2^i)/2)+1:end,1) = 1;

            for j = 1:(2^i)/2
                new_gray_container(j,2:end) = previous_container(j,:);
            end

            for j = ((2^i)/2)+1:2^i
                new_gray_container(j,2:end) = previous_container((2^i)+1-j,:);
            end

            previous_container = new_gray_container;
        end
        result = previous_container;
    end
    fprintf('Gray code of %d bits',bits);
    disp(' ');
    disp(result);
end


10 FOR h=1 TO 20: GO SUB 1000: NEXT h
20 LET h=1691: GO SUB 1000
30 STOP
1000 REM Hamming
1010 DIM a(h)
1030 LET a(1)=1: LET x2=2: LET x3=3: LET x5=5: LET i=1: LET j=1: LET k=1
1040 FOR n=2 TO h
1050 LET m=x2
1060 IF m>x3 THEN LET m=x3
1070 IF m>x5 THEN LET m=x5
1080 LET a(n)=m
1090 IF m=x2 THEN LET i=i+1: LET x2=2*a(i)
1100 IF m=x3 THEN LET j=j+1: LET x3=3*a(j)
1110 IF m=x5 THEN LET k=k+1: LET x5=5*a(k)
1120 NEXT n
1130 PRINT "H(";h;")= ";a(h)
1140 RETURN


Sequences[m_]:=Prepend[Flatten[Table[Partition[Range[m],n,1],{n,m}],1],{}]
MaximumSubsequence[x_List]:=Module[{sums},
 sums={x[[#]],Total[x[[#]]]}&/@Sequences[Length[x]];
 First[First[sums[[Ordering[sums,-1,#1[[2]]<#2[[2]]&]]]]]
]


/*Special ordered set of type N

  Nigel_Galloway
  January 26th, 2012
*/

param Lmax;
param Lmin;
set SOS;
param Sx{SOS};
var db{Lmin..Lmax,SOS}, binary;

maximize s : sum{q in (Lmin..Lmax),t in (0..q-1), z in SOS: z > (q-1)} Sx[z-t]*db[q,z];
sos1 : sum{t in (Lmin..Lmax),z in SOS: z > (t-1)} db[t,z] = 1;
solve;

for{t in (Lmin..Lmax),z in SOS: db[t,z] == 1} {
  printf "\nA sub-sequence of length %d sums to %f:\n", t,s;
  printf{q in (z-t+1)..z} "  %f", Sx[q];
}
printf "\n\n";

data;
param Lmin := 1;
param Lmax := 6;
param:
SOS:  Sx :=
 1     7
 2     4
 3   -11
 4     6
 5     3
 6     1
;

end;


# Convert color image (PPM) to greyscale image (PGM)
(de ppm->pgm (Ppm)
   (mapcar
      '((Y)
         (mapcar
            '((C)
               (/
                  (+
                     (* (car C) 2126)  # Red
                     (* (cadr C) 7152)  # Green
                     (* (caddr C) 722) )  # Blue
                  10000 ) )
            Y ) )
      Ppm ) )

# Convert greyscale image (PGM) to color image (PPM)
(de pgm->ppm (Pgm)
   (mapcar
      '((Y)
         (mapcar
            '((G) (list G G G))
            Y ) )
      Pgm ) )


do j = 1 to hbound(image,1);
   do i = 0 to hbound(image,2);
      color = image(i,j);
      R = substr(color, 17, 8);
      G = substr(color, 9, 8);
      B = substr(color, 1, 8);
      grey =  trunc(0.2126*R + 0.7152*G + 0.0722*B);
      greybits = grey;
      image(i,j) = substr(greybits, length(greybits)-7, 8);
   end;
end;


Procedure ImageGrayout(image)
  Protected w, h, x, y, r, g, b, gray, color

  w = ImageWidth(image)
  h = ImageHeight(image)
  StartDrawing(ImageOutput(image))
  For x = 0 To w - 1
    For y = 0 To h - 1
      color = Point(x, y)
      r    = Red(color)
      g    = Green(color)
      b    = Blue(color)
      gray = 0.2126*r + 0.7152*g + 0.0722*b
      Plot(x, y, RGB(gray, gray, gray)
    Next
  Next
  StopDrawing()
EndProcedure

Procedure ImageToColor(image)
  Protected w, h, x, y, v, gray

  w = ImageWidth(image)
  h = ImageHeight(image)
  StartDrawing(ImageOutput(image))
  For x = 0 To w - 1
    For y = 0 To h - 1
      gray = Point(x, y)
      v    = Red(gray) ;for gray, each of the color's components is the same
      ;color = RGB(0.2126*v, 0.7152*v, 0.0722*v)
      Plot(x, y, RGB(v, v, v))
    Next
  Next
  StopDrawing()
EndProcedure


# String masquerading as ppm file (version P3)
import io
ppmfileout = io.StringIO('')

def togreyscale(self):
    for h in range(self.height):
        for w in range(self.width):
            r, g, b = self.get(w, h)
            l = int(0.2126 * r + 0.7152 * g + 0.0722 * b)
            self.set(w, h, Colour(l, l, l))

Bitmap.togreyscale = togreyscale

# Draw something simple
bitmap = Bitmap(4, 4, white)
bitmap.fillrect(1, 0, 1, 2, Colour(127, 0, 63))
bitmap.set(3, 3, Colour(0, 127, 31))
print('Colour:')
# Write to the open 'file' handle
bitmap.writeppmp3(ppmfileout)
print(ppmfileout.getvalue())
print('Grey:')
bitmap.togreyscale()
ppmfileout = io.StringIO('')
bitmap.writeppmp3(ppmfileout)
print(ppmfileout.getvalue())

'''
The print statement above produces the following output :

Colour:
P3
# generated from Bitmap.writeppmp3
4 4
255
   255 255 255   255 255 255   255 255 255     0 127  31
   255 255 255   255 255 255   255 255 255   255 255 255
   255 255 255   127   0  63   255 255 255   255 255 255
   255 255 255   127   0  63   255 255 255   255 255 255

Grey:
P3
# generated from Bitmap.writeppmp3
4 4
254
   254 254 254   254 254 254   254 254 254    93  93  93
   254 254 254   254 254 254   254 254 254   254 254 254
   254 254 254    31  31  31   254 254 254   254 254 254
   254 254 254    31  31  31   254 254 254   254 254 254

'''


MODULE Operations;
IMPORT StdLog,Args,Strings;

PROCEDURE Max(s: ARRAY OF INTEGER): INTEGER;
VAR
	i: INTEGER;
	max: INTEGER;
BEGIN
	max := MIN(INTEGER);
	FOR i := 0 TO LEN(s) - 1 DO
		max := MAX(max,s[i]);
	END;
	RETURN max
END Max;

PROCEDURE DoMax*;
VAR
	sq: POINTER TO ARRAY OF INTEGER;
	p: Args.Params;
	i,n,done: INTEGER;
BEGIN
	Args.Get(p);
	IF p.argc > 0 THEN
		NEW(sq,p.argc);
		FOR i := 0 TO p.argc - 1 DO
			Strings.StringToInt(p.args[i],n,done);
			sq[i] := n
		END;
		StdLog.String("max:> ");StdLog.Int(Max(sq));StdLog.Ln
	END
END DoMax;

END Operations.


:- module gray.

:- interface.
:- import_module int.

:- type gray.

% VALUE conversion functions
:- func gray.from_int(int) = gray.
:- func gray.to_int(gray) = int.

% REPRESENTATION conversion predicate
:- pred gray.coerce(gray, int).
:- mode gray.coerce(in,   out) is det.
:- mode gray.coerce(out,  in)  is det.

:- implementation.

:- import_module list.

:- type gray
  ---> gray(int).

gray.from_int(X) = gray(X `xor` (X >> 1)).

gray.to_int(gray(G)) = (G > 0 -> G `xor` gray.to_int(gray(G >> 1))
                        ;        G).
gray.coerce(gray(I), I).

:- end_module gray.


proc grayEncode(n: int): int =
  n xor (n shr 1)

proc grayDecode(n: int): int =
  result = n
  var t = n
  while t > 0:
    t = t shr 1
    result = result xor t


; link with PIOxxx.OBJ

        sectiondata

output:         db " : "
inbinary:       db "00000 => "
graybinary:     db "00000 => "
outbinary:      db "00000"
                db 13,10,0        ; carriage return and null terminator

        sectioncode

start!
        gosub initplatform

        beginfunc
        localvar i.d,g.d,b.d

        i=0
        whileless i,32
        callex g,gray_encode,i
        callex b,gray_decode,g

        callex ,bin2string,i,inbinary,5              ; 5 = number of binary digits
        callex ,bin2string,g,graybinary,5
        callex ,bin2string,b,outbinary,5

        callex ,printhex8,i                  ; display hex value
                                             ; because there is no PIO routine for decimals...
        callex ,printnt,output.a

        i=_+1
        wend

        endfunc
        end

gray_encode:
        beginfunc n.d
        n=_ xor (n shr 1)
        endfunc n
        returnex 4                           ; clean off 1 parameter from the stack

gray_decode:
        beginfunc n.d
        localvar p.d
        p=n
        whilegreater n,1
        n=_ shr 1 > p=_ xor n
        wend
        endfunc p
        returnex 4                           ; clean off 1 parameter from the stack

bin2string:
        beginfunc digits.d,straddr.d,value.d

        whilegreater digits,0
        digits=_-1
        [straddr].b=value shr digits and 1+$30        ; write an ASCII '0' or '1'
        straddr=_+1                                   ; increment the pointer
        wend

        endfunc
        returnex $0C                         ; clean off 3 parameters from the stack


let gray_encode b =
  b lxor (b lsr 1)

let gray_decode n =
  let rec aux p n =
    if n = 0 then p
    else aux (p lxor n) (n lsr 1)
  in
  aux n (n lsr 1)

let bool_string len n =
  let s = Bytes.make len '0' in
  let rec aux i n =
    if n land 1 = 1 then Bytes.set s i '1';
    if i <= 0 then (Bytes.to_string s)
    else aux (pred i) (n lsr 1)
  in
  aux (pred len) n

let () =
  let s = bool_string 5 in
  for i = 0 to pred 32 do
    let g = gray_encode i in
    let b = gray_decode g in
    Printf.printf "%2d : %s => %s => %s : %2d\n" i (s i) (s g) (s b) b
  done


function [S,GS]=gss(a)
% Greatest subsequential sum
a =[0;a(:);0]';
ix1 = find(a(2:end) >0 & a(1:end-1) <= 0);
ix2 = find(a(2:end)<=0 & a(1:end-1) > 0);
K = 0;
S = 0;
for k = 1:length(ix1)
	s = sum(a(ix1(k)+1:ix2(k)));
	if (s>S)
		S=s; K=k;
	end;
end;
GS = a(ix1(K)+1:ix2(K));


/* REXX ***************************************************************
* 10.08.2012 Walter Pachl Pascal algorithm -> Rexx -> NetRexx
**********************************************************************/
  s=' -1 -2  3  5  6 -2 -1  4 -4  2 -1'
  maxSum   = 0
  seqStart = 0
  seqEnd   = -1
  Loop i = 1 To s.words()
    seqSum = 0
    Loop j = i to s.words()
      seqSum = seqSum + s.word(j)
      if seqSum > maxSum then Do
        maxSum   = seqSum
        seqStart = i
        seqEnd   = j
        end
      end
    end
  Say 'Sequence:'
  Say s
  Say 'Subsequence with greatest sum: '
  If seqend<seqstart Then
    Say 'empty'
  Else Do
    ol='   '.copies(seqStart-1)
    Loop i = seqStart to seqEnd
      w=s.word(i)
      ol=ol||w.right(3)
      End
    Say ol
    Say 'Sum:' maxSum
    End


# Conversion from Grey to RGB uses the following code
setAs("pixmapGrey", "pixmapRGB",
function(from, to){
    z = new(to, as(from, "pixmap"))
    [email protected] = [email protected]
    [email protected] = [email protected]
    [email protected] = [email protected]
    [email protected] = c("red", "green", "blue")
    z
})

# Conversion from RGB to grey uses built-in coefficients of 0.3, 0.59, 0.11.  To see this, type
getMethods(addChannels)

# We can override this behaviour with
setMethod("addChannels", "pixmapRGB",
function(object, coef=NULL){
    if(is.null(coef)) coef = c(0.2126, 0.7152, 0.0722)
    z = new("pixmapGrey", object)
    [email protected] = coef[1] * [email protected] + coef[2] * [email protected] +
        coef[3] * [email protected]
    [email protected] = "grey"
    z
})

# Colour image
plot(p1 <- pixmapRGB(c(c(1,0,0,0,0,1), c(0,1,0,0,1,0), c(0,0,1,1,0,0)), nrow=6, ncol=6))

#Convert to grey
plot(p2 <- as(p1, "pixmapGrey"))

# Convert back to "colour"
plot(p3 <- as(p2, "pixmapRGB"))


#lang racket
(require racket/draw)

(define (gray->color gray-bm)
  (define gray-dc (new bitmap-dc% [bitmap gray-bm]))
  (define-values (w h) (send gray-dc get-size))
  (define width (exact-floor w))
  (define height (exact-floor h))
  (define color-bm (make-bitmap width height))
  (define color-dc (new bitmap-dc% [bitmap color-bm]))
  (define pixels (make-bytes (* 4 width height)))
  (send gray-dc get-argb-pixels 0 0 width height pixels)
  (send color-dc set-argb-pixels 0 0 width height pixels)
  color-bm)

(define (color->gray color-bm)
  (define color-dc (new bitmap-dc% [bitmap color-bm]))
  (define-values (w h) (send color-dc get-size))
  (define width (exact-floor w))
  (define height (exact-floor h))
  (define gray-bm (make-bitmap width height))
  (define gray-dc (new bitmap-dc% [bitmap gray-bm]))
  (define pixels (make-bytes (* 4 width height)))
  (send color-dc get-argb-pixels 0 0 width height pixels)
  (for ([i (in-range 0 (* 4 width height) 4)])
    (define α (bytes-ref pixels i))
    (define r (bytes-ref pixels (+ i 1)))
    (define g (bytes-ref pixels (+ i 2)))
    (define b (bytes-ref pixels (+ i 3)))
    (define l (exact-floor (+ (* 0.2126 r) (* 0.7152 g) (* 0.0722 b))))
    (bytes-set! pixels (+ i 1) l)
    (bytes-set! pixels (+ i 2) l)
    (bytes-set! pixels (+ i 3) l))
  (send gray-dc set-argb-pixels 0 0 width height pixels)
  gray-bm)

(require images/icons/symbol)
(define rosetta (text-icon "Rosetta Code" #:color "red" #:height 80))
rosetta
(color->gray rosetta)
(gray->color (color->gray rosetta))


sub MAIN ($filename = 'default.ppm') {

    my $in = open($filename, :r, :enc<iso-8859-1>) or die $in;

    my ($type, $dim, $depth) = $in.lines[^3];

    my $outfile = $filename.subst('.ppm', '.pgm');
    my $out = open($outfile, :w, :enc<iso-8859-1>) or die $out;

    $out.say("P5\n$dim\n$depth");

    for $in.lines.ords -> $r, $g, $b {
        my $gs = $r * 0.2126 + $g * 0.7152 + $b * 0.0722;
        $out.print: chr($gs.floor min 255);
    }

    $in.close;
    $out.close;
}


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Go_Fish
use warnings;
use List::Util qw( first shuffle );

my $pat = qr/[atjqk2-9]/; # ranks
my $deck = join '', shuffle map { my $rank = $_; map "$rank$_", qw( S H C D ) }
  qw( a t j q k ), 2 .. 9;

my $mebooks = my $youbooks = 0;

my $me = substr $deck, 0, 2 * 9, '';
my $mepicks = join '', $me =~ /$pat/g;
arrange($me);
$mebooks++ while $me =~ s/($pat).\1.\1.\1.//;
my $you = substr $deck, 0, 2 * 9, '';
my $youpicks = join '', $you =~ /$pat/g;
arrange($you);
$youbooks++ while $you =~ s/($pat).\1.\1.\1.//;

while( $mebooks + $youbooks < 13 )
  {
  play( \$you, \$youbooks, \$youpicks, \$me, \$mebooks, 1 );
  $mebooks + $youbooks == 13 and last;
  play( \$me, \$mebooks, \$mepicks, \$you, \$youbooks, 0 );
  }
print "me $mebooks you $youbooks\n";

sub arrange { $_[0] = join '', sort $_[0] =~ /../g }

sub human
  {
  my $have = shift =~ s/($pat).\K(?!\1)/ /gr;
  local $| = 1;
  my $pick;
  do
    {
    print "You have $have, enter request: ";
    ($pick) = lc(<STDIN>) =~ /$pat/g;
    } until $pick and $have =~ /$pick/;
  return $pick;
  }

sub play
  {
  my ($me, $mb, $lastpicks, $you, $yb, $human) = @_;
  my $more = 1;
  while( arrange( $$me ), $more and $$mb + $$yb < 13 )
    {
#   use Data::Dump 'dd'; dd \@_, "deck $deck";
    if( $$me =~ s/($pat).\1.\1.\1.// )
      {
      print "book of $&\n";
      $$mb++;
      }
    elsif( $$me )
      {
      my $pick = $human ? do { human($$me) } : do
        {
        my %picks;
        $picks{$_}++ for my @picks = $$me =~ /$pat/g;
        my $pick = first { $picks{$_} } split(//, $$lastpicks), shuffle @picks;
        print "pick $pick\n";
        $$lastpicks =~ s/$pick//g;
        $$lastpicks .= $pick;
        $pick;
        };
      if( $$you =~ s/(?:$pick.)+// )
        {
        $$me .= $&;
        }
      else
        {
        print "GO FISH !!\n";
        $$me .= substr $deck, 0, 2, '';
        $more = 0;
        }
      }
    elsif( $deck )
      {
      $$me .= substr $deck, 0, 2, '';
      }
    else
      {
      $more = 0;
      }
    }
  arrange( $$me );
  }


void main()
{
    import std.algorithm.searching : maxElement;
    import std.stdio : writeln;

    [9, 4, 3, 8, 5].maxElement.writeln;
}


/*This is a function which returns the greatest element in a list of numbers */
num findGreatestElement(List<num> list){
  num greatestElement = list[0];
  for (num element in list){
    if (element>greatestElement) {
      greatestElement = element;
    }
  }
  return greatestElement;
}
/* and this is a shorter version */
import 'dart:math';
num findGreatestElement(List<num> list){
  return list.reduce(max);
}


sub bin2gray
{
    return $_[0] ^ ($_[0] >> 1);
}

sub gray2bin
{
    my ($num)= @_;
    my $bin= $num;
    while( $num >>= 1 ) {
        # a bit ends up flipped iff an odd number of bits to its left is set.
        $bin ^= $num;   # different from the suggested algorithm;
    }                   # avoids using bit mask and explicit bittery
    return $bin;
}

for (0..31) {
    my $gr= bin2gray($_);
    printf "%d\t%b\t%b\t%b\n", $_, $_, $gr, gray2bin($gr);
}


*        Greatest common divisor   04/05/2016
GCD      CSECT
         USING  GCD,R15            use calling register
         L      R6,A               u=a
         L      R7,B               v=b
LOOPW    LTR    R7,R7              while v<>0
         BZ     ELOOPW               leave while
         LR     R8,R6                t=u
         LR     R6,R7                u=v
         LR     R4,R8                t
         SRDA   R4,32                shift to next reg
         DR     R4,R7                t/v
         LR     R7,R4                v=mod(t,v)
         B      LOOPW              end while
ELOOPW   LPR    R9,R6              c=abs(u)
         L      R1,A               a
         XDECO  R1,XDEC            edit a
         MVC    PG+4(5),XDEC+7     move a to buffer
         L      R1,B               b
         XDECO  R1,XDEC            edit b
         MVC    PG+10(5),XDEC+7    move b to buffer
         XDECO  R9,XDEC            edit c
         MVC    PG+17(5),XDEC+7    move c to buffer
         XPRNT  PG,80              print buffer
         XR     R15,R15            return code =0
         BR     R14                return to caller
A        DC     F'1071'            a
B        DC     F'1029'            b
PG       DC     CL80'gcd(00000,00000)=00000'  buffer
XDEC     DS     CL12               temp for edit
         YREGS
         END    GCD


: gcd \ a b -- gcd
	dup 0 n:= if drop ;; then
	tuck \ b a b
	n:mod \ b a-mod-b
	recurse ;

: demo \ a b --
	2dup "GCD of " . . " and " . . " = " . gcd . ;

100    5 demo cr
  5  100 demo cr
  7   23 demo cr

bye


proc maxsum(s: openArray[int]): int =
  var maxendinghere = 0
  for x in s:
    maxendinghere = max(maxendinghere + x, 0)
    result = max(result, maxendinghere)

echo maxsum(@[-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1])


MODULE GreatestSubsequentialSum;
IMPORT
  Out,
  Err,
  IntStr,
  ProgramArgs,
  TextRider;
TYPE
  IntSeq= POINTER TO ARRAY OF LONGINT;

PROCEDURE ShowUsage();
BEGIN
  Out.String("Usage: GreatestSubsequentialSum {int}+");Out.Ln
END ShowUsage;

PROCEDURE Gss(iseq: IntSeq; VAR start, end, maxsum: LONGINT);
VAR
  i, j, sum: LONGINT;
BEGIN
  i := 0; maxsum := 0; start := 0; end := -1;
  WHILE (i < LEN(iseq^)) DO
    sum := 0; j := i;
    WHILE (j < LEN(iseq^) - 1) DO
      INC(sum,iseq[j]);
      IF sum > maxsum THEN
        maxsum := sum;
        start := i;
        end := j
      END;
      INC(j)
    END;
    INC(i)
  END
END Gss;

PROCEDURE GetParams():IntSeq;
VAR
  reader: TextRider.Reader;
  iseq: IntSeq;
  param: ARRAY 32 OF CHAR;
  argc,i: LONGINT;
  res: SHORTINT;
BEGIN
  iseq := NIL;
  reader := TextRider.ConnectReader(ProgramArgs.args);
  IF reader # NIL THEN
    argc := ProgramArgs.args.ArgNumber();
    IF argc < 1 THEN
      Err.String("There is no enough arguments.");Err.Ln;
      ShowUsage;
      HALT(0)
    END;

    reader.ReadLn; (* Skips program name *)

    NEW(iseq,argc);
    FOR i := 0 TO argc - 1 DO
      reader.ReadLine(param);
      IntStr.StrToInt(param,iseq[i],res);
    END
 END;
 RETURN iseq
END GetParams;

PROCEDURE Do;
VAR
  iseq: IntSeq;
  start, end, sum, i: LONGINT;
BEGIN
  iseq := GetParams();
  Gss(iseq, start, end, sum);
  i := start;
  Out.String("[");
  WHILE (i <= end) DO
    Out.LongInt(iseq[i],0);
    IF (i < end) THEN Out.Char(',') END;
    INC(i)
  END;
  Out.String("]: ");Out.LongInt(sum,0);Out.Ln
END Do;

BEGIN
  Do
END GreatestSubsequentialSum.


/*REXX program converts a  RGB (red─green─blue) image into a  grayscale/greyscale image.*/
  blue= '00 00 ff'x                              /*define the blue color  (hexadecimal).*/
    @.= blue                                     /*set the entire  image  to blue color.*/
 width=  60                                      /* width of the   image  (in pixels).  */
height= 100                                      /*height  "  "      "      "   "       */

  do    col=1  for width
     do row=1  for height                        /* [↓]  C2D  convert  char ───► decimal*/
     r= left(@.col.row, 1)      ;     r= c2d(r)  /*extract the component red  & convert.*/
     g= substr(@.col.row, 2, 1) ;     g= c2d(g)  /*   "     "      "    green "    "    */
     b=  right(@.col.row, 1)    ;     b= c2d(b)  /*   "     "      "    blue  "    "    */
     _= d2c( (.2126*r + .7152*g + .0722*b) % 1)  /*convert RGB number  ───►  grayscale. */
     @.col.row= copies(_, 3)                     /*redefine old RGB    ───►  grayscale. */
     end   /*row*/                               /* [↑]  D2C  convert  decimal ───► char*/
  end      /*col*/                               /* [↑]  x%1   is the same as  TRUNC(x) */
                                                 /*stick a fork in it,  we're all done. */


class RGBColour
  def to_grayscale
    luminosity = Integer(0.2126*@red + 0.7152*@green + 0.0722*@blue)
    self.class.new(luminosity, luminosity, luminosity)
  end
end

class Pixmap
  def to_grayscale
    gray = self.class.new(@width, @height)
    @width.times do |x|
      @height.times do |y|
        gray[x,y] = self[x,y].to_grayscale
      end
    end
    gray
  end
end


object BitmapOps {
   def luminosity(c:Color)=(0.2126*c.getRed + 0.7152*c.getGreen + 0.0722*c.getBlue+0.5).toInt

   def grayscale(bm:RgbBitmap)={
      val image=new RgbBitmap(bm.width, bm.height)
      for(x <- 0 until bm.width; y <- 0 until bm.height; l=luminosity(bm.getPixel(x,y)))
         image.setPixel(x, y, new Color(l,l,l))
      image
   }
}


[sm llx] sg
[lm p q] sq
[d lm <u s_ z 0 =q llx] sl
[d sm] su

["Put list of numbers on the stack starting here, then execute g"] s_

3.14159265358979 sp

_275.0 _111.19 0.0 _1234568.0 lp lp _1 *

lgx


$ list = "45,65,81,12,0,13,-56,123,-123,888,12,0"
$ max = f$integer( f$element( 0, ",", list ))
$ i = 1
$ loop:
$  element = f$element( i, ",", list )
$  if element .eqs. "," then $ goto done
$  element = f$integer( element )
$  if element .gt. max then $ max = element
$  i = i + 1
$  goto loop
$ done:
$ show symbol max


with javascript_semantics
function gray_encode(integer n)
    return xor_bits(n,floor(n/2))
end function

function gray_decode(integer n)
integer r = 0
    while n>0 do
        r = xor_bits(r,n)
        n = floor(n/2)
    end while
    return r
end function

integer e,d
puts(1," N  Binary Gray   Decoded\n"&
       "==  =====  =====  =======\n")
for i=0 to 31 do
    e = gray_encode(i)
    d = gray_decode(e)
    printf(1,"%2d  %05b  %05b  %2d\n",{i,i,e,d})
end for


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program calPgcd64.s  */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Number 1 : @ number 2 : @ PGCD  : @ \n"
szCarriageReturn:   .asciz "\n"
szMessError:        .asciz "Error PGCD !!\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:            .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                               // entry of program

    mov x20,36
    mov x21,18
    mov x0,x20
    mov x1,x21
    bl calPGCDmod
    bcs   99f                       // error ?
    mov x2,x0                       // pgcd
    mov x0,x20
    mov x1,x21
    bl displayResult
    mov x20,37
    mov x21,15
    mov x0,x20
    mov x1,x21
    bl calPGCDmod
    bcs   99f                       // error ?
    mov x2,x0                       // pgcd
    mov x0,x20
    mov x1,x21
    bl displayResult

    b 100f
99:                                 // display error
    ldr x0,qAdrszMessError
    bl affichageMess
100:                                // standard end of the program
    mov x0, #0                      // return code
    mov x8, #EXIT                   // request to exit program
    svc #0                          // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrszMessError:          .quad szMessError

/***************************************************/
/*   Compute pgcd  modulo use */
/***************************************************/
/* x0 contains first number */
/* x1 contains second number */
/* x0 return  PGCD            */
/* if error carry set to 1    */
calPGCDmod:
    stp x1,lr,[sp,-16]!        // save  registres
    stp x2,x3,[sp,-16]!        // save  registres
    cbz x0,99f                 // if = 0 error
    cbz x1,99f
    cmp x0,0
    bgt 1f
    neg x0,x0                  // if negative inversion number 1
1:
    cmp x1,0
    bgt 2f
    neg x1,x1                  // if negative inversion number 2
2:
    cmp x0,x1                  // compare two numbers
    bgt 3f
    mov x2,x0                  // inversion
    mov x0,x1
    mov x1,x2
3:
    udiv x2,x0,x1              // division
    msub x0,x2,x1,x0           // compute remainder
    cmp x0,0
    bgt 2b                     // loop
    mov x0,x1
    cmn x0,0                   // clear carry
    b 100f
99:                            // error
    mov x0,0
    cmp x0,0                   // set carry
100:
    ldp x2,x3,[sp],16          // restaur des  2 registres
    ldp x1,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30

/***************************************************/
/*   display result */
/***************************************************/
/* x0 contains first number */
/* x1 contains second number */
/* x2 contains  PGCD         */
displayResult:
    stp x1,lr,[sp,-16]!          // save  registres
    mov x3,x1                    // save x1
    ldr x1,qAdrsZoneConv
    bl conversion10              // décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv         // insert conversion
    bl strInsertAtCharInc
    mov x4,x0                    // save message address
    mov x0,x3                    // conversion second number
    ldr x1,qAdrsZoneConv
    bl conversion10              // décimal conversion
    mov x0,x4                    // move message address
    ldr x1,qAdrsZoneConv         // insert conversion
    bl strInsertAtCharInc
    mov x4,x0                    // save message address
    mov x0,x2                    // conversion pgcd
    ldr x1,qAdrsZoneConv
    bl conversion10              // décimal conversion
    mov x0,x4                    // move message address
    ldr x1,qAdrsZoneConv         // insert conversion
    bl strInsertAtCharInc
    bl affichageMess             // display message
    ldp x1,lr,[sp],16            // restaur des  2 registres
    ret                          // retour adresse lr x30
qAdrsMessResult:          .quad sMessResult
qAdrsZoneConv:            .quad sZoneConv
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


(include-book "arithmetic-3/floor-mod/floor-mod" :dir :system)

(defun gcd$ (x y)
   (declare (xargs :guard (and (natp x) (natp y))))
   (cond ((or (not (natp x)) (< y 0))
          nil)
         ((zp y) x)
         (t (gcd$ y (mod x y)))))


let maxsubseq =
  let rec loop sum seq maxsum maxseq = function
    | [] -> maxsum, List.rev maxseq
    | x::xs ->
        let sum = sum + x
        and seq = x :: seq in
          if sum < 0 then
            loop 0 [] maxsum maxseq xs
          else if sum > maxsum then
            loop sum seq sum seq xs
          else
            loop sum seq maxsum maxseq xs
  in
    loop 0 [] 0 []

let _ =
  maxsubseq [-1 ; -2 ; 3 ; 5 ; 6 ; -2 ; -1 ; 4; -4 ; 2 ; -1]


declare
  fun {MaxSubSeq Xs}

     fun {Step [Sum0 Seq0 MaxSum MaxSeq] X}
        Sum = Sum0 + X
        Seq = X|Seq0
     in
        if Sum > MaxSum then
           %% found new maximum
           [Sum Seq Sum Seq]
        elseif Sum < 0 then
           %% discard negative subseqs
           [0 nil MaxSum MaxSeq]
        else
           [Sum Seq MaxSum MaxSeq]
        end
     end

     [_ _ _ MaxSeq] = {FoldL Xs Step [0 nil 0 nil]}
  in
     {Reverse MaxSeq}
  end
in
  {Show {MaxSubSeq [~1 ~2 3 5 6 ~2 ~1 4 ~4 2 1]}}


require('Image::Imlib2')

func tograyscale(img) {
    var (width, height) = (img.width, img.height)
    var gimg = %s'Image::Imlib2'.new(width, height)
    for y,x in (^height ~X ^width) {
        var (r, g, b) = img.query_pixel(x, y)
        var gray = int(0.2126*r + 0.7152*g + 0.0722*b)
        gimg.set_color(gray, gray, gray, 255)
        gimg.draw_point(x, y)
    }
    return gimg
}

var (input='input.png', output='output.png') = ARGV...
var image = %s'Image::Imlib2'.load(input)
var gscale = tograyscale(image)
gscale.set_quality(80)
gscale.save(output)


package require Tk

proc grayscale image {
    set w [image width $image]
    set h [image height $image]
    for {set x 0} {$x<$w} {incr x} {
        for {set y 0} {$y<$h} {incr y} {
            lassign [$image get $x $y] r g b
            set l [expr {int(0.2126*$r + 0.7152*$g + 0.0722*$b)}]
            $image put [format "#%02x%02x%02x" $l $l $l] -to $x $y
        }
    }
}


//  Convert RGB image to grayscale (8 bit/pixel)
//    #10 = buffer that contains image data
//  On return:
//    #20 = buffer for the new grayscale image

:RGB_TO_GRAYSCALE:
File_Open("|(VEDIT_TEMP)\gray.data", OVERWRITE+NOEVENT+NOMSG)
#20 = Buf_Num
BOF
Del_Char(ALL)
Buf_Switch(#10)
Repeat(File_Size/3) {
    #9 =  Cur_Char() * 2126
    #9 += Cur_Char(1) * 7152
    #9 += Cur_Char(2) * 722
    Char(3)
    Buf_Switch(#20)
    Ins_Char(#9 / 10000)
    Buf_Switch(#10)
}
Return


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Go_Fish
use warnings;
use List::Util qw( first shuffle );

my $pat = qr/[atjqk2-9]/; # ranks
my $deck = join '', shuffle map { my $rank = $_; map "$rank$_", qw( S H C D ) }
  qw( a t j q k ), 2 .. 9;

my $mebooks = my $youbooks = 0;

my $me = substr $deck, 0, 2 * 9, '';
my $mepicks = join '', $me =~ /$pat/g;
arrange($me);
$mebooks++ while $me =~ s/($pat).\1.\1.\1.//;
my $you = substr $deck, 0, 2 * 9, '';
my $youpicks = join '', $you =~ /$pat/g;
arrange($you);
$youbooks++ while $you =~ s/($pat).\1.\1.\1.//;

while( $mebooks + $youbooks < 13 )
  {
  play( \$you, \$youbooks, \$youpicks, \$me, \$mebooks, 1 );
  $mebooks + $youbooks == 13 and last;
  play( \$me, \$mebooks, \$mepicks, \$you, \$youbooks, 0 );
  }
print "me $mebooks you $youbooks\n";

sub arrange { $_[0] = join '', sort $_[0] =~ /../g }

sub human
  {
  my $have = shift =~ s/($pat).\K(?!\1)/ /gr;
  local $| = 1;
  my $pick;
  do
    {
    print "You have $have, enter request: ";
    ($pick) = lc(<STDIN>) =~ /$pat/g;
    } until $pick and $have =~ /$pick/;
  return $pick;
  }

sub play
  {
  my ($me, $mb, $lastpicks, $you, $yb, $human) = @_;
  my $more = 1;
  while( arrange( $$me ), $more and $$mb + $$yb < 13 )
    {
#   use Data::Dump 'dd'; dd \@_, "deck $deck";
    if( $$me =~ s/($pat).\1.\1.\1.// )
      {
      print "book of $&\n";
      $$mb++;
      }
    elsif( $$me )
      {
      my $pick = $human ? do { human($$me) } : do
        {
        my %picks;
        $picks{$_}++ for my @picks = $$me =~ /$pat/g;
        my $pick = first { $picks{$_} } split(//, $$lastpicks), shuffle @picks;
        print "pick $pick\n";
        $$lastpicks =~ s/$pick//g;
        $$lastpicks .= $pick;
        $pick;
        };
      if( $$you =~ s/(?:$pick.)+// )
        {
        $$me .= $&;
        }
      else
        {
        print "GO FISH !!\n";
        $$me .= substr $deck, 0, 2, '';
        $more = 0;
        }
      }
    elsif( $deck )
      {
      $$me .= substr $deck, 0, 2, '';
      }
    else
      {
      $more = 0;
      }
    }
  arrange( $$me );
  }


program GElemLIst;
{$IFNDEF FPC}
  {$Apptype Console}
{$ENDIF}

uses
  math;
const
  MaxCnt = 10000;
var
  IntArr : array of integer;
  fltArr : array of double;
  i: integer;
begin
  setlength(fltArr,MaxCnt); //filled with 0
  setlength(IntArr,MaxCnt); //filled with 0.0
  randomize;
  i := random(MaxCnt);      //choose a random place
  IntArr[i] := 1;
  fltArr[i] := 1.0;
  writeln(Math.MaxIntValue(IntArr)); // Array of Integer
  writeln(Math.MaxValue(fltArr));
end.


func max(xs) {
    var y
    for x in xs {
        if y == nil || x > y {
            y = x
        }
    }
    y
}

var xs = [1..10]
max(xs)


<?php

/**
 * @author Elad Yosifon
 */

/**
 * @param int $binary
 * @return int
 */
function gray_encode($binary){
	return $binary ^ ($binary >> 1);
}

/**
 * @param int $gray
 * @return int
 */
function gray_decode($gray){
	$binary = $gray;
	while($gray >>= 1) $binary ^= $gray;
	return $binary;
}

for($i=0;$i<32;$i++){
	$gray_encoded = gray_encode($i);
	printf("%2d : %05b => %05b => %05b : %2d \n",$i, $i, $gray_encoded, $gray_encoded, gray_decode($gray_encoded));
}


go =>
   foreach(I in 0..2**5-1)
      G = gray_encode1(I),
      E = gray_decode1(G),
      printf("%2d %6w %2d %6w %6w %2d\n",I,I.to_binary_string,
                                         G, G.to_binary_string,
                                         E.to_binary_string, E)
   end,
   nl,
   println("Checking 2**1300:"),
   N2=2**1300,
   G2=gray_encode1(N2),
   E2=gray_decode1(G2),
   % println(g2=G2),
   % println(e2=E2),
   println(check=cond(N2==E2,same,not_same)),
   nl.

gray_encode1(N) = N ^ (N >> 1).
gray_decode1(N) = P =>
    P = N,
    N := N >> 1,
    while (N != 0)
      P := P ^ N,
      N := N >> 1
    end.


(de grayEncode (N)
   (bin (x| N (>> 1 N))) )

(de grayDecode (G)
   (bin
      (pack
         (let X 0
            (mapcar
               '((C) (setq X (x| X (format C))))
               (chop G) ) ) ) ) )


CARD FUNC Gcd(CARD a,b)
  CARD tmp

  IF a<b THEN
    tmp=a a=b b=tmp
  FI

  WHILE b#0
  DO
    tmp=a MOD b
    a=b
    b=tmp
  OD
RETURN(a)

PROC Test(CARD a,b)
  CARD res

  res=Gcd(a,b)
  PrintF("GCD of %I and %I is %I%E",a,b,res)
RETURN

PROC Main()
  Test(48,18)
  Test(9360,12240)
  Test(17,19)
  Test(123,1)
  Test(0,0)
RETURN


//Euclidean algorithm
function gcd(a:int,b:int):int
{
	var tmp:int;
	//Swap the numbers so a >= b
	if(a < b)
	{
		tmp = a;
		a = b;
		b = tmp;
	}
	//Find the gcd
	while(b != 0)
	{
		tmp = a % b;
		a = b;
		b = tmp;
	}
	return a;
}


Program GreatestSubsequentialSum(output);

var
  a: array[1..11] of integer = (-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1);
  i, j: integer;
  seqStart, seqEnd: integer;
  maxSum, seqSum: integer;

begin
  maxSum   := 0;
  seqStart := 0;
  seqEnd   := -1;
  for i := low(a) to high(a) do
  begin
    seqSum := 0;
    for j := i to high(a) do
    begin
      seqSum := seqSum + a[j];
      if seqSum > maxSum then
      begin
        maxSum   := seqSum;
        seqStart := i;
        seqEnd   := j;
      end;
    end;
  end;

  writeln ('Sequence: ');
  for i := low(a) to high(a) do
    write (a[i]:3);
  writeln;
  writeln ('Subsequence with greatest sum: ');
  for i := low(a) to seqStart - 1 do
    write (' ':3);
  for i := seqStart to seqEnd do
    write (a[i]:3);
  writeln;
  writeln ('Sum:');
  writeln (maxSum);
end.


Option Explicit

Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Private Type RGB
  Red As Byte
  Green As Byte
  Blue As Byte
  Alpha As Byte
End Type

Private Type RGBColor
  Color As Long
End Type

Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Public Declare Function GetObjectA Lib "gdi32.dll" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long

Sub Main()
Dim p As stdole.IPictureDisp
Dim hdc As Long
Dim bmp As BITMAP
Dim i As Long, x As Long, y As Long
Dim tRGB As RGB, cRGB As RGBColor

Set p = VB.LoadPicture("T:\TestData\Input_Colored.bmp")
GetObjectA p.Handle, Len(bmp), bmp

hdc = CreateCompatibleDC(0)
SelectObject hdc, p.Handle

For x = 0 To bmp.bmWidth - 1
  For y = 0 To bmp.bmHeight - 1
    cRGB.Color = GetPixel(hdc, x, y)
    LSet tRGB = cRGB
    i = (0.2126 * tRGB.Red + 0.7152 * tRGB.Green + 0.0722 * tRGB.Blue)
    SetPixel hdc, x, y, RGB(i, i, i)
  Next y
Next x

VB.SavePicture p, "T:\TestData\Output_GrayScale.bmp"
DeleteDC hdc

End Sub


Imports System.Drawing.Imaging

  Public Function Grayscale(ByVal Map As Bitmap) As Bitmap

    Dim oData() As Integer = GetData(Map)
    Dim oReturn As New Bitmap(Map.Width, Map.Height, Map.PixelFormat)
    Dim a As Integer = 0
    Dim r As Integer = 0
    Dim g As Integer = 0
    Dim b As Integer = 0
    Dim l As Integer = 0

    For i As Integer = 0 To oData.GetUpperBound(0)
      a = (oData(i) >> 24)
      r = (oData(i) >> 16) And 255
      g = (oData(i) >> 8) And 255
      b = oData(i) And 255

      l = CInt(r * 0.2126F + g * 0.7152F + b * 0.0722F)

      oData(i) = (a << 24) Or (l << 16) Or (l << 8) Or l
    Next

    SetData(oReturn, oData)

    Return oReturn

  End Function

  Private Function GetData(ByVal Map As Bitmap) As Integer()

    Dim oBMPData As BitmapData = Nothing
    Dim oData() As Integer = Nothing

    oBMPData = Map.LockBits(New Rectangle(0, 0, Map.Width, Map.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)

    Array.Resize(oData, Map.Width * Map.Height)

    Runtime.InteropServices.Marshal.Copy(oBMPData.Scan0, oData, 0, oData.Length)

    Map.UnlockBits(oBMPData)

    Return oData

  End Function

  Private Sub SetData(ByVal Map As Bitmap, ByVal Data As Integer())

    Dim oBMPData As BitmapData = Nothing

    oBMPData = Map.LockBits(New Rectangle(0, 0, Map.Width, Map.Height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)

    Runtime.InteropServices.Marshal.Copy(Data, 0, oBMPData.Scan0, Data.Length)

    Map.UnlockBits(oBMPData)

  End Sub


Red [
    Title:  "Go Fish"
    Author: "gltewalt"
]

chand: []   ;-- c and p = computer and player
cguesses: []
phand: []
cbooks: 0
pbooks: 0
gf: {
    ***************
    *   GO FISH   *
    ***************
}
pip: ["a" "2" "3" "4" "5" "6" "7" "8" "9" "10" "j" "q" "k"] ;-- suits are not relevant
pile: []    ;-- where discarded cards go

;---------------------
;  Helper functions  -
;---------------------

clear-screen: does [
    "clears the console"
    call/console either system/platform = 'Linux ["clear"]["cls"]
]

clear-and-show: func [duration str][
    {
        Poor persons animation.
        Blips message to screen after a pause of duration length.

    }
    clear-screen
    print str
    wait duration
    clear-screen
]

deal-cards: func [num hand][
    loop num [
        append hand rejoin [trim/all form take deck]
    ]
]

find-in: func [blk str][
    "Finds a string value in a block. Series in series."
    foreach i blk [if find i str [return i]]
]

go-fish: func [num hand][
    either not empty? deck [
        deal-cards num hand
    ][
        append hand rejoin [trim/all form take pile]    ;-- take from pile if deck is empty
    ]
]

guess-from: func [hand guessed][
    {
        Randomly picks from hand minus guessed.

        Simulates a person asking for different cards on
        their next turn if their previous guess resulted
        in a Go Fish.
    }
    random/seed now/time
    either any [empty? guessed empty? exclude hand guessed][
        random/only hand
    ][
        random/only exclude hand guessed
    ]
]

make-deck: function [] [
    "make-deck and shuffle from https://rosettacode.org/wiki/Playing_cards#Red"
     new-deck: make block! 52
     foreach p pip [loop 4 [append/only new-deck p]]
     return new-deck
]

show-cards: does [
    clear-and-show 0 ""
    print [newline "Player cards:" newline sort phand newline]
    print ["Computer books:" cbooks]
    print ["Player books:" pbooks newline]
]

shuffle: function [deck [block!]] [deck: random deck]

;------------- end of helper functions -----------------

check-for-books: func [
    {
        Checks for a book in a players hand.
        Increments the players book score, and
        discards the book from the players hand
    }
    hand "from or to hand"
    kind "rank of cards"
    /local
        c "collected"
][
    c: collect [
        forall hand [keep find hand/1 kind]
    ]
    remove-each i c [none = i]
    if 4 = length? c [
        either hand = phand [pbooks: pbooks + 1][cbooks: cbooks + 1]
        remove-each i hand [if find/only c i [i]]   ;-- remove book from hand
        forall c [append pile c/1]  ;-- append discarded book to the pile
    ]
]

transfer-cards: func [
    "Transfers cards from player to player"
    fhand "from hand"
    thand "to hand"
    kind "rank of cards"
    /local
        c "collected"
][
    c: collect [forall fhand [keep find fhand/1 kind]]
    remove-each i c [none = i]  ;-- remove none values from collected
    forall c [append thand c/1] ;-- append remaining values to "to hand"
    remove-each i fhand [if find/only c i [i]] ;-- remove those values from "from hand"
]

computer-turn: func [
    fhand "from hand"
    thand "to hand"
    kind  "rank of cards"
    /local
        a
][
    a: ask rejoin ["Do you have any " kind " s? "]
    if a = "x" [halt]
    either any [a = "y" a = "yes"][
        check-for-books thand kind
        transfer-cards fhand thand kind
        show-cards
        computer-turn fhand thand guess-from thand cguesses
    ][
        clear-and-show 0.4 gf
        go-fish 1 thand
        append cguesses kind
    ]
]

player-turn: func [
    fhand "from hand"
    thand "to hand"
    kind  "rank of cards"
    /local
        p
][
    if empty? fhand [go-fish 3 fhand]

    if none? find-in thand kind [   ;-- player has to hold rank asked for
        clear-and-show 1.0
        "You have to have that rank in your hand to ask for it.^/Computers turn..."
        exit
    ]

    either find-in fhand kind [
        check-for-books thand kind
        transfer-cards fhand thand kind
        show-cards
        if find-in thand kind [
            p: ask "Your guess: "
            either p = "x" [halt][player-turn fhand thand p]
            check-for-books thand p
        ]
    ][
        clear-and-show 0.4 gf
        go-fish 1 thand
    ]
]

game-round: has [c p][
    print {
          -------------------
          -  COMPUTER TURN  -
          -------------------
          }

    if empty? chand [  ; computer has no more cards? fish 3 cards.
        go-fish 3 chand
        show-cards
    ]
    computer-turn phand chand c: guess-from chand cguesses
    check-for-books chand c
    show-cards

    print {
          -------------------
          -   PLAYER TURN   -
          -------------------
          }

    if empty? phand [   ;-- player has no more cards? fish 3 cards.
        go-fish 3 phand
        show-cards
    ]
    p: ask "Your guess: "
    either p = "x" [halt][player-turn chand phand find-in phand p]
    check-for-books phand p
    show-cards
]

main: does [
    deck: shuffle make-deck
    deal-cards 9 chand
    deal-cards 9 phand
    show-cards
    while [cbooks + pbooks < 13][
        game-round
    ]
    clear-and-show 0 ""
    print "GAME OVER"
    print [newline "Computer books:" cbooks newline "Player books:" pbooks]
]

main


max lst:
    lst! 0
    for item in copy lst:
         if > item dup:
              item drop

!. max [ 10 300 999 9 ]


/* Find the greatest element in an array of ints */
proc nonrec max([*] int a) int:
    int INT_MIN = ~((~0) >> 1);
    int nmax, i;
    nmax := INT_MIN;
    for i from 0 upto dim(a,1)-1 do
        if a[i] > nmax then nmax := a[i] fi
    od;
    nmax
corp

/* Test on an array */
proc nonrec main() void:
    type arr = [8] int;
    writeln("Maximum: ", max(arr(1,5,17,2,53,99,61,3)))
corp


pragma.enable("accumulator") # non-finalized syntax feature

def max([first] + rest) {
    return accum first for x in rest { _.max(x) }
}


(stringrange, stringsize):
Gray_code: procedure options (main);  /* 15 November 2013 */
   declare (bin(0:31), g(0:31), b2(0:31)) bit (5);
   declare (c, carry) bit (1);
   declare (i, j) fixed binary (7);

   bin(0) = '00000'b;
   do i = 0 to 31;
      if i > 0 then
         do;
            carry = '1'b;
            bin(i) = bin(i-1);
            do j = 5 to 1 by -1;
               c = substr(bin(i), j, 1) & carry;
               substr(bin(i), j, 1) = substr(bin(i), j, 1) ^ carry;
               carry = c;
            end;
         end;
      g(i) = bin(i) ^ '0'b || substr(bin(i), 1, 4);
   end;
   do i = 0 to 31;
      substr(b2(i), 1, 1) = substr(g(i), 1, 1);
      do j = 2 to 5;
         substr(b2(i), j, 1) = substr(g(i), j, 1) ^ substr(bin(i), j-1, 1);
      end;
   end;

   do i = 0 to 31;
      put skip edit (i, bin(i), g(i), b2(i)) (f(2), 3(x(1), b));
   end;
end Gray_code;


function gray%(byval n%)
  gray%=n% xor (n%\2)
end function

function igray%(byval n%)
  r%=0
  while n%>0
    r%=r% xor n%
    shift right n%,1
  wend
  igray%=r%
end function

print "   N  GRAY   INV"
for n%=0 to 31
  g%=gray%(n%)
  print bin$(n%);" ";bin$(g%);" ";bin$(igray%(g%))
next


to_gray(N, G) :-
  N0 is N >> 1,
  G is N xor N0.

from_gray(G, N) :-
  ( G > 0
  ->  S is G >> 1,
      from_gray(S, N0),
      N is G xor N0
  ;   N is G ).


Procedure.i gray_encode(n)
  ProcedureReturn n ! (n >> 1)
EndProcedure

Procedure.i gray_decode(g)
  Protected bit = 1 << (8 * SizeOf(Integer) - 2)
  Protected b = g & bit, p = b >> 1

  While bit > 1
    bit >> 1
    b | (p ! (g & bit))
    p = (b & bit) >> 1
  Wend
  ProcedureReturn b
EndProcedure

If OpenConsole()
  PrintN("Number Gray   Binary  Decoded")
  Define i, n
  For i = 0 To 31
    g = gray_encode(i)
    Print(RSet(Str(i), 2, "0") + Space(5))
    Print(RSet(Bin(g, #PB_Byte), 5, "0") + Space(2))
    n = gray_decode(g)
    Print(RSet(Bin(n, #PB_Byte), 5, "0") + Space(3))
    PrintN(RSet(Str(n), 2, "0"))
  Next

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


with Ada.Text_Io; use Ada.Text_Io;

procedure Gcd_Test is
   function Gcd (A, B : Integer) return Integer is
      M : Integer := A;
      N : Integer := B;
      T : Integer;
   begin
      while N /= 0 loop
         T := M;
         M := N;
         N := T mod N;
      end loop;
      return M;
   end Gcd;

begin
   Put_Line("GCD of 100, 5 is" & Integer'Image(Gcd(100, 5)));
   Put_Line("GCD of 5, 100 is" & Integer'Image(Gcd(5, 100)));
   Put_Line("GCD of 7, 23 is" & Integer'Image(Gcd(7, 23)));
end Gcd_Test;


import "graphics" for Canvas, Color, ImageData
import "dome" for Window

class PercentageDifference {
    construct new(width, height, image1, image2) {
        Window.title = "Grayscale Image"
        Window.resize(width, height)
        Canvas.resize(width, height)
        _image1 = image1
        _image2 = image2
        _img1 = ImageData.loadFromFile(image1)
        _img2 = ImageData.create(image2, _img1.width, _img1.height)
    }

    init() {
        toGrayScale()
        // display images side by side
        _img1.draw(0, 0)
        _img2.draw(550, 0)
        Canvas.print(_image1, 200, 525, Color.white)
        Canvas.print(_image2, 750, 525, Color.white)
    }

    toGrayScale() {
        for (x in 0..._img1.width) {
            for (y in 0..._img1.height) {
                var c1 = _img1.pget(x, y)
                var lumin = (0.2126 * c1.r + 0.7152 * c1.g + 0.0722 * c1.b).floor
                var c2 = Color.rgb(lumin, lumin,lumin, c1.a)
                _img2.pset(x, y, c2)
            }
        }
    }

    update() {}

    draw(alpha) {}
}

var Game = PercentageDifference.new(1100, 550, "Lenna100.jpg", "Lenna-grayscale.jpg")


import image

open window 600,600

GetImage(1, "House.bmp")
DisplayImage(1, 0, 0)

For x = 1 to 300
    For y = 1 to 300
	z$ = getbit$(x,y,x,y)
	r = dec(mid$(z$,9,2))
	g = dec(mid$(z$,11,2))
	b = dec(mid$(z$,13,2))
	r3=(r+g+b)/3
	g3=(r+g+b)/3
	b3=(r+g+b)/3
	color r3,g3,b3
	dot x+300,y+300
    next y
next x


fcn toGrayScale(img){  // in-place conversion
   foreach x,y in (img.w,img.h){
      r,g,b:=img[x,y].toBigEndian(3);
      lum:=(0.2126*r + 0.7152*g + 0.0722*b).toInt();
      img[x,y]=((lum*256) + lum)*256 + lum;
   }
}


a[] = [ 2 9 4 3 8 5 ]
for e in a[]
  max = higher e max
.
print max


;; a random length list of random values
(define L (map random (make-list (random 50) 100))) → L
L → (24 60 83 8 24 60 31 97 96 65 9 41 64 24 22 57 73 17 6 28 77 58 18 13 27 22 41 69 85)

;; find max
(apply max L) → 97


MaxVal(SET OF INTEGER s) := MAX(s);

//example usage

SetVals := [4,8,16,2,1];
MaxVal(SetVals) //returns 16;


def gray_encode(n):
    return n ^ n >> 1

def gray_decode(n):
    m = n >> 1
    while m:
        n ^= m
        m >>= 1
    return n

if __name__ == '__main__':
    print("DEC,   BIN =>  GRAY => DEC")
    for i in range(32):
        gray = gray_encode(i)
        dec = gray_decode(gray)
        print(f" {i:>2d}, {i:>05b} => {gray:>05b} => {dec:>2d}")


  [ dup 1 >> ^ ]        is encodegray (   n --> n )

  [ dup
    [ dip [ 1 >> ]
      over ^
      over 0 = until ]
    nip ]               is decodegray (   n --> n )

  [ [] unrot times
      [ 2 /mod char 0 +
        rot join swap ]
    drop echo$ ]        is echobin    ( n n -->   )

  say "number  encoded  decoded" cr
  say "------  -------  -------" cr
  32 times
    [ sp i^ 5 echobin
      say " -> "
      i^ encodegray dup 5 echobin
      say " -> "
      decodegray 5 echobin cr ]


GrayEncode <- function(binary) {
	gray <- substr(binary,1,1)
	repeat {
	if  (substr(binary,1,1) != substr(binary,2,2)) gray <- paste(gray,"1",sep="")
	else gray <- paste(gray,"0",sep="")
	binary <- substr(binary,2,nchar(binary))
	if (nchar(binary) <=1) {
		break
		}
	}
return (gray)
}
GrayDecode <- function(gray) {
	binary <- substr(gray,1,1)
	repeat {
	if  (substr(binary,nchar(binary),nchar(binary)) != substr(gray,2,2)) binary <- paste(binary ,"1",sep="")
	else binary <- paste(binary ,"0",sep="")
	gray <- substr(gray,2,nchar(gray))

	if (nchar(gray) <=1) {
		break
		}
	}
return (binary)
}


#lang racket

(define (gray-encode n) (bitwise-xor n (arithmetic-shift n -1)))

(define (gray-decode n)
  (letrec ([loop (lambda(g bits)
                   (if (> bits 0)
                       (loop (bitwise-xor g bits) (arithmetic-shift bits -1))
                       g))])
	 (loop 0 n)))

(define (to-bin n) (format "~b" n))
(define (show-table)
  (for ([i (in-range 1 32)])
    (printf "~a | ~a | ~a ~n"
            (~r i #:min-width 2 #:pad-string "0")
            (~a (to-bin(gray-encode i)) #:width 5 #:align 'right #:pad-string "0")
            (~a (to-bin (gray-decode(gray-encode i))) #:width 5 #:align 'right #:pad-string "0"))))


sub gray_encode ( Int $n --> Int ) {
    return $n +^ ( $n +> 1 );
}

sub gray_decode ( Int $n is copy --> Int ) {
    my $mask = 1 +< (32-2);
    $n +^= $mask +> 1 if $n +& $mask while $mask +>= 1;
    return $n;
}

for ^32 -> $n {
    my $g = gray_encode($n);
    my $d = gray_decode($g);
    printf "%2d: %5b => %5b => %5b: %2d\n", $n, $n, $g, $d, $d;
    die if $d != $n;
}


begin
    comment Greatest common divisor - algol 60;

    integer procedure gcd(m,n);
 	value m,n;
	integer m,n;
    begin
        integer a,b;
        a:=abs(m);
        b:=abs(n);
        if a=0 then gcd:=b
        else begin
			integer c,i;
		    for i:=a while b notequal 0 do begin
                c:=b;
                b:=a-(a div b)*b;
                a:=c
            end;
            gcd:=a
        end
    end gcd;

    outinteger(1,gcd(21,35))
end


PROC gcd = (INT a, b) INT: (
  IF a = 0 THEN
    b
  ELIF b = 0 THEN
    a
  ELIF a > b  THEN
    gcd(b, a MOD b)
  ELSE
    gcd(a, b MOD a)
  FI
);
test:(
  INT a = 33, b = 77;
  printf(($x"The gcd of"g" and "g" is "gl$,a,b,gcd(a,b)));
  INT c = 49865, d = 69811;
  printf(($x"The gcd of"g" and "g" is "gl$,c,d,gcd(c,d)))
)


with javascript_semantics
function maxSubseq(sequence s)
    integer maxsum = 0, first = 1, last = 0
    for i=1 to length(s) do
        integer sumsij = 0
        for j=i to length(s) do
            sumsij += s[j]
            if sumsij>maxsum then
                {maxsum,first,last} = {sumsij,i,j}
            end if
        end for
    end for
    return s[first..last]
end function
? maxSubseq({-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1})
? maxSubseq({})
? maxSubseq({-1, -5, -3})


list_max = fn ([Head:Rest]) {
  list_max(Rest, Head)
}

list_max = fn ([], Res) {
  Res
}
fn ([Head:Rest], Max) when Head > Max {
  list_max(Rest, Head)
}
fn ([_Head:Rest], Max) {
  list_max(Rest, Max)
}

list_max1 = fn ([H:T]) {
  lists.foldl(fn erlang.max:2, H, T)
}

@public
run = fn () {
    io.format("~p~n", [list_max([9, 4, 3, 8, 5])])
    io.format("~p~n", [list_max1([9, 4, 3, 8, 5])])
}


class
	GREATEST_ELEMENT [G -> COMPARABLE]

create
	make

feature {NONE} --Implementation

	is_max (element: G maximum: G): BOOLEAN
		do
			Result := maximum >= element
		end

	max (list: ARRAY [G]): G
		require
			not_empty: not list.is_empty
		do
			Result := list [list.lower]
			across
				list as i
			loop
				Result := i.item.max (Result)
			end
		ensure
			is_part_of_array: list.has (Result)
			is_maximum: list.for_all (agent is_max(?, Result))
		end

feature -- Initialization

	make
		do
		end

	greatest_element (a: ARRAY [G]): G
		do
			Result := max (a)
		end

end


/*REXX program converts decimal number ───► binary ───► gray code ───► binary.*/
parse arg N .                          /*get the optional argument from the CL*/
if N==''  | N==","   then N=31         /*Not specified?  Then use the default.*/
L=max(1,length(strip(x2b(d2x(N)),'L',0)))   /*find the max binary length of N.*/
w=14                                   /*used for the formatting of cell width*/
_=center('binary',w,'─')               /*the  2nd and 4th  part of the header.*/
say center('decimal', w, "─")'►'     _"►"    center('gray code', w, '─')"►"    _
                                                     /* [+]  the output header*/
     do j=0  to N;     b=right(x2b(d2x(j)),L,0)      /*process   0  ──►  N.   */
     g=b2gray(b)                       /*convert binary number to gray code.  */
     a=gray2b(g)                       /*convert the gray code to binary.     */
     say center(j,w+1)   center(b,w+1)   center(g,w+1)   center(a,w+1)
     end   /*j*/
exit                                   /*stick a fork in it,  we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
b2gray: procedure; parse arg x 1 $ 2;    do b=2  to length(x)
                                         $=$||(substr(x,b-1,1) && substr(x,b,1))
                                         end   /*b*/
        return $
/*────────────────────────────────────────────────────────────────────────────*/
gray2b: procedure; parse arg x 1 $ 2;    do g=2  to length(x)
                                         $=$ || (right($,1)    && substr(x,g,1))
                                         end   /*g*/        /*  ↑  */
                                                            /*  │  */
        return $           /*this is an eXclusive OR  ►─────────┘  */


# Project : Gray code

pos = 5
see "0 : 00000 => 00000 => 00000" + nl
for n = 1 to 31
     res1 = tobase(n, 2, pos)
     res2 = tobase(grayencode(n), 2, pos)
     res3 = tobase(graydecode(n), 2, pos)
     see "" + n + " : " + res1 + " => " + res2 +  " => " + res3 + nl
next

func grayencode(n)
        return n ^ (n >> 1)

func graydecode(n)
        p = n
        while (n = n >> 1)
                  p = p ^ n
        end
        return p

func tobase(nr, base, pos)
        binary = 0
        i = 1
       while(nr != 0)
              remainder = nr % base
              nr = floor(nr/base)
              binary= binary + (remainder*i)
              i = i*10
       end
       result = ""
       for nr = 1 to  pos - len(string(binary))
             result = result + "0"
       next
       result = result + string(binary)
       return result


BEGIN

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

%  RETURN GREATEST COMMON DIVISOR OF X AND Y  %
INTEGER FUNCTION GCD (X, Y);
INTEGER X, Y;
BEGIN
	INTEGER R;
	IF X < Y THEN
	BEGIN
		INTEGER TEMP;
		TEMP := X;
		X := Y;
		Y := TEMP;
	END;
	WHILE (R := MOD(X, Y)) <> 0 DO
	BEGIN
		X := Y;
		Y := R;
	END;
	GCD := Y;
END;

COMMENT - EXERCISE THE FUNCTION;

WRITE("THE GDC OF 21 AND 35 IS", GCD(21,35));
WRITE("THE GDC OF 23 AND 35 IS", GCD(23,35));
WRITE("THE GDC OF 1071 AND 1029 IS", GCD(1071,1029));
WRITE("THE GDC OF 3528 AND 3780 IS", GCD(3528,252));

END


begin
    % iterative Greatest Common Divisor routine                               %
    integer procedure gcd ( integer value m, n ) ;
    begin
        integer a, b, newA;
        a := abs( m );
        b := abs( n );
        if a = 0 then begin
            b
            end
        else begin
            while b not = 0 do begin
                newA := b;
                b    := a rem b;
                a    := newA;
            end;
            a
        end
    end gcd ;

    write( gcd( -21, 35 ) );
end.


<?php

function max_sum_seq($sequence) {
  // This runs in linear time.
  $sum_start = 0;
  $sum = 0;
  $max_sum = 0;
  $max_start = 0;
  $max_len = 0;
  for ($i = 0; $i < count($sequence); $i += 1) {
    $n = $sequence[$i];
    $sum += $n;
    if ($sum > $max_sum) {
      $max_sum = $sum;
      $max_start = $sum_start;
      $max_len = $i + 1 - $max_start;
    }
    if ($sum < 0) { # start new sequence
      $sum = 0;
      $sum_start = $i + 1;
    }
  }
  return array_slice($sequence, $max_start, $max_len);
}

function print_array($arr) {
  if (count($arr) > 0) {
    echo join(" ", $arr);
  } else {
    echo "(empty)";
  }
  echo '<br>';
}
// tests
print_array(max_sum_seq(array(-1, 0, 15, 3, -9, 12, -4)));
print_array(max_sum_seq(array(-1)));
print_array(max_sum_seq(array(4, -10, 3)));
?>


open list

findBy p (x::xs) = foldl (\x y | p x y -> x | else -> y) x xs
maximum = findBy (>)

maximum [1..10]


import extensions;

extension op
{
    get Maximal()
    {
        auto en := cast Enumerator(self.enumerator());

        object maximal := nil;
        while (en.next())
        {
            var item := en.get();
            if (nil == maximal)
            {
                maximal := item
            }
            else if (maximal < item)
            {
                maximal := item
            }
        };

        ^ maximal
    }
}

public program()
{
    console.printLine(new int[]{1,2,3,4,20,10,9,8}.Maximal)
}


class Integer
  # Converts a normal integer to a Gray code.
  def to_gray
    raise Math::DomainError, "integer is negative" if self < 0
    self ^ (self >> 1)
  end

  # Converts a Gray code to a normal integer.
  def from_gray
    raise Math::DomainError, "integer is negative" if self < 0
    recurse = proc do |i|
      next 0 if i == 0
      o = recurse[i >> 1] << 1
      o | (i[0] ^ o[1])
    end
    recurse[self]
  end
end

(0..31).each do |number|
  encoded = number.to_gray
  decoded = encoded.from_gray
  printf "%2d : %5b => %5b => %5b : %2d\n",
         number, number, encoded, decoded, decoded
end


fn gray_encode(integer: u64) -> u64 {
    (integer >> 1) ^ integer
}

fn gray_decode(integer: u64) -> u64 {
    match integer {
        0 => 0,
        _ => integer ^ gray_decode(integer >> 1)
    }
}

fn main() {
    for i in 0..32 {
        println!("{:2} {:0>5b} {:0>5b} {:2}", i, i, gray_encode(i),
            gray_decode(i));
    }

}


def encode(n: Int)    = (n ^ (n >>> 1)).toBinaryString
def decode(s: String) = Integer.parseInt( s.scanLeft(0)(_ ^ _.asDigit).tail.mkString , 2)

println("decimal  binary   gray  decoded")
for (i <- 0 to 31; g = encode(i))
  println("%7d  %6s  %5s  %7s".format(i, i.toBinaryString, g, decode(g)))


def gcd(a as Int, b as Int) as Int
   while b != 0
      a,b = b, a mod b
   end
   return Abs(a)
end


greatest_subsequential_sum_it([]) = [] => true.
greatest_subsequential_sum_it(A) = Seq =>
    P = allcomb(A),
    Total = max([Tot : Tot=_T in P]),
    Seq1 = [],
    if Total > 0 then
       [B,E] = P.get(Total),
       Seq1 := [A[I] : I in B..E]
    else
      Seq1 := []
    end,
    Seq = Seq1.

allcomb(A) = Comb =>
   Len = A.length,
   Comb = new_map([(sum([A[I]:I in B..E])=([B,E])) : B in 1..Len, E in B..Len]).


(maxi '((L) (apply + L))
   (mapcon '((L) (maplist reverse (reverse L)))
      (-1 -2 3 5 6 -2 -1 4 -4 2 -1) ) )


*process source attributes xref;
 ss: Proc Options(Main);
 /* REXX ***************************************************************
 * 26.08.2013 Walter Pachl translated from REXX version 3
 **********************************************************************/
  Dcl HBOUND builtin;
  Dcl SYSPRINT Print;
  Dcl (I,J,LB,MAXSUM,SEQEND,SEQSTART,SEQSUM) Bin Fixed(15);
  Dcl s(11) Bin Fixed(15) Init(-1,-2,3,5,6,-2,-1,4,-4,2,-1);
  maxSum   = 0;
  seqStart = 0;
  seqEnd   = -1;
  do i = 1 To hbound(s);
    seqSum = 0;
    Do j = i to hbound(s);
      seqSum = seqSum + s(j);
      if seqSum > maxSum then Do;
        maxSum   = seqSum;
        seqStart = i;
        seqEnd   = j;
        end;
      end;
    end;
  Put Edit('Sequence:')(Skip,a);
  Put Edit('')(Skip,a);
  Do i=1 To hbound(s);
    Put Edit(s(i))(f(3));
    End;
  Put Edit('Subsequence with greatest sum:')(Skip,a);
  If seqend<seqstart Then
    Put Edit('empty')(Skip,a);
  Else Do;
    /*ol=copies('   ',seqStart-1)*/
    lb=(seqStart-1)*3;
    Put Edit(' ')(Skip,a(lb));
    Do i = seqStart to seqEnd;
      Put Edit(s(i))(f(3));
      End;
    Put Edit('Sum:',maxSum)(Skip,a,f(5));
    End;
 End;


(defun find-maximum (items)
  (let (max)
    (dolist (item items)
      (when (or (not max) (> item max))
        (setq max item)))
    max))

(find-maximum '(2 7 5)) ;=> 7


PROGRAM MAXLIST

!
! for rosettacode.org
!

! VAR L$,EL$,CH$,I%,MAX

BEGIN
  PRINT(CHR$(12);) ! CLS
  INPUT("Lista",L$)
  L$=L$+CHR$(32)
  MAX=-1.7E+38
  FOR I%=1 TO LEN(L$) DO
    CH$=MID$(L$,I%,1)
    IF CH$<>CHR$(32) THEN ! blank is separator
       EL$=EL$+CH$
     ELSE
       IF VAL(EL$)>MAX THEN MAX=VAL(EL$) END IF
       EL$=""
    END IF
  END FOR
  PRINT("Max list element is";MAX)
END PROGRAM


$ include "seed7_05.s7i";
  include "bin32.s7i";

const func integer: grayEncode (in integer: n) is
  return ord(bin32(n) >< bin32(n >> 1));

const func integer: grayDecode (in var integer: n) is func
  result
    var integer: decoded is 0;
  begin
    decoded := n;
    while n > 1 do
      n >>:= 1;
      decoded := ord(bin32(decoded) >< bin32(n));
    end while;
  end func;

const proc: main is func
  local
    var integer: i is 0;
  begin
    for i range 0 to 32 do
      writeln(i <& " => " <& grayEncode(i) radix 2 lpad0 6 <& " => " <& grayDecode(grayEncode(i)));
    end for;
  end func;


function BinaryToGray param1
	set theResult to ""
	repeat for each character in param1
		if the counter is equal to 1
			put it after theResult
		else
			if it is equal to previousCharacter
				put "0" after theResult
			else
				put "1" after theResult
			end if
		end if
		set previousCharacter to it
	end repeat
	return theResult
end BinaryToGray

function GrayToBinary param1
	set theResult to param1
	repeat for each character in param1
		if the counter is equal to 1
			next repeat
		end if
		set currentChar to it
		set lastCharInd to the counter - 1
		repeat for lastCharInd down to 1
			if currentChar is equal to character it of param1
				set currentChar to "0"
			else
				set currentChar to "1"
			end if
		end repeat
		set character the counter of theResult to currentChar
	end repeat

	return theResult
end GrayToBinary


func bin2gray(n) {
    n ^ (n >> 1)
}

func gray2bin(num) {
    var bin = num
    while (num >>= 1) { bin ^= num }
    return bin
}

{ |i|
    var gr = bin2gray(i)
    printf("%d\t%b\t%b\t%b\n", i, i, gr, gray2bin(gr))
} << ^32


DECLARE @BINARY AS NVARCHAR(MAX) = '001010111'
DECLARE @gray AS NVARCHAR(MAX) = ''

--Encoder
SET @gray = LEFT(@BINARY, 1)

WHILE LEN(@BINARY) > 1
  BEGIN
      IF LEFT(@BINARY, 1) != SUBSTRING(@BINARY, 2, 1)
        SET @gray = @gray + '1'
      ELSE
        SET @gray = @gray + '0'

      SET @BINARY = RIGHT(@BINARY, LEN(@BINARY) - 1)
  END

SELECT @gray

--Decoder
SET @BINARY = LEFT(@gray, 1)

WHILE LEN(@gray) > 1
  BEGIN
      IF RIGHT(@BINARY, 1) != SUBSTRING(@gray, 2, 1)
        SET @BINARY = @BINARY + '1'
      ELSE
        SET @BINARY = @BINARY + '0'

      SET @gray = RIGHT(@gray, LEN(@gray) - 1)
  END

SELECT @BINARY


-- gcd :: Int -> Int -> Int
on gcd(a, b)
    if b ≠ 0 then
        gcd(b, a mod b)
    else
        if a < 0 then
            -a
        else
            a
        end if
    end if
end gcd


gss = (lst) :
   # Find discrete integral
   integral = (0)
   accum = 0
   lst each (n): accum = accum + n, integral append(accum).
   # Check integral[b + 1] - integral[a] for all 0 <= a <= b < N
   max = -1
   max_a = 0
   max_b = 0
   lst length times (b) :
      b times (a) :
         if (integral(b + 1) - integral(a) > max) :
            max = integral(b + 1) - integral(a)
            max_a = a
            max_b = b
         .
      .
   .
   # Print the results
   if (max >= 0) :
      (lst slice(max_a, max_b) join(" + "), " = ", max, "\n") join print
   .
   else :
      "No subsequence larger than 0\n" print
   .
.

gss((-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1))
gss((-1, -2, -3, -4, -5))
gss((7,-6, -8, 5, -2, -6, 7, 4, 8, -9, -3, 2, 6, -4, -6))


:- use_module(library(chr)).

:- chr_constraint
	init_chr/2,
	seq/2,
	% gss(Deb, Len, TT)
	gss/3,
	% gsscur(Deb, Len, TT, IdCur)
	gsscur/4,
	memoseq/3,
	clean/0,
	greatest_subsequence/0.

greatest_subsequence <=>
	L = [-1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , -1],
	init_chr(1, L),
	find_chr_constraint(gss(Deb, Len, V)),
	clean,
	writeln(L),
	forall(between(1, Len, I),
	       (   J is I+Deb-1, nth1(J, L, N), format('~w ', [N]))),
	format('==> ~w ~n', [V]).

% destroy last constraint gss
clean \ gss(_,_,_) <=> true.
clean <=> true.

init_chr_end @ init_chr(_, []) <=> gss(0, 0, 0), gsscur(1,0,0,1).

init_chr_loop @ init_chr(N, [H|T]) <=> seq(N, H), N1 is N+1, init_chr(N1, T).

% here, we memorize the list
gsscur_with_negative @ gsscur(Deb, Len, TT, N),  seq(N, V) <=> V =< 0 |
             memoseq(Deb, Len, TT),
	     TT1 is TT + V,
	     N1 is N+1,
	     % if TT1 becomes negative,
	     % we begin a new subsequence
	     (	 TT1 < 0 -> gsscur(N1,0,0,N1)
	     ;	 Len1 is Len + 1, gsscur(Deb, Len1, TT1, N1)).

gsscur_with_positive @ gsscur(Deb, Len, TT, N),  seq(N, V) <=> V > 0 |
             TT1 is TT + V,
	     N1 is N+1,
	     Len1 is Len + 1,
	     gsscur(Deb, Len1, TT1, N1).

gsscur_end @ gsscur(Deb, Len, TT, _N) <=> memoseq(Deb, Len, TT).

memoseq(_DC, _LC, TTC), gss(D, L, TT) <=> TTC =< TT |
	       gss(D, L, TT).

memoseq(DC, LC, TTC), gss(_D, _L, TT) <=> TTC > TT |
		gss(DC, LC, TTC).


function aeval( sequence sArr, integer id )
    for i = 1 to length( sArr ) do
        sArr[ i ] = call_func( id, { sArr[ i ] } )
    end for
    return sArr
end function

object biggun
function biggest( object elem )
    if compare(elem, biggun) > 0 then
        biggun = elem
    end if
    return elem
end function

biggun = 0
object a
a = aeval( {1,1234,62,234,12,34,6}, routine_id("biggest") )
printf( 1, "%d\n", biggun )

sequence s
s = {"antelope", "dog", "cat", "cow", "wolf", "wolverine", "aardvark"}
biggun = "ant"
a = aeval( s, routine_id("biggest") )
printf( 1, "%s\n", {biggun} )


fun gray_encode b =
  Word.xorb (b, Word.>> (b, 0w1))

fun gray_decode n =
  let
    fun aux (p, n) =
      if n = 0w0 then p
      else aux (Word.xorb (p, n), Word.>> (n, 0w1))
  in
    aux (n, Word.>> (n, 0w1))
  end;

val s = Word.fmt StringCvt.BIN;
fun aux i =
  if i = 0w32 then
    ()
  else
    let
      val g = gray_encode i
      val b = gray_decode g
    in
      print (Word.toString i ^ " :\t" ^ s i ^ " => " ^ s g ^ " => " ^ s b ^ "\t: " ^ Word.toString b ^ "\n");
      aux (i + 0w1)
    end;
aux 0w0


func grayEncode(_ i: Int) -> Int {
  return (i >> 1) ^ i
}

func grayDecode(_ i: Int) -> Int {
  switch i {
  case 0:
    return 0
  case _:
    return i ^ grayDecode(i >> 1)
  }
}

for i in 0..<32 {
  let iStr = String(i, radix: 2)
  let encode = grayEncode(i)
  let encodeStr = String(encode, radix: 2)
  let decode = grayDecode(encode)
  let decodeStr = String(decode, radix: 2)

  print("\(i) (\(iStr)) => \(encode) (\(encodeStr)) => \(decode) (\(decodeStr))")
}


namespace eval gray {
    proc encode n {
	expr {$n ^ $n >> 1}
    }
    proc decode n {
	# Compute some bit at least as large as MSB
	set i [expr {2**int(ceil(log($n+1)/log(2)))}]
	set b [set bprev [expr {$n & $i}]]
	while {[set i [expr {$i >> 1}]]} {
	    set b [expr {$b | [set bprev [expr {$n & $i ^ $bprev >> 1}]]}]
	}
	return $b
    }
}


0 A = ABS(INT(A))
1 B = ABS(INT(B))
2 GCD = A * NOT NOT B
3 FOR B = B + A * NOT B TO 0 STEP 0
4     A = GCD
5     GCD = B
6     B = A - INT (A / GCD) * GCD
7 NEXT B


If OpenConsole()
  Define s$, a, b, p1, p2, sum, max, dm=(?EndOfMyData-?MyData)
  Dim Seq.i(dm/SizeOf(Integer))
  CopyMemory(?MyData,@seq(),dm)

  For a=0 To ArraySize(seq())
    sum=0
    For b=a To ArraySize(seq())
      sum+seq(b)
      If sum>max
        max=sum
        p1=a
        p2=b
      EndIf
    Next
  Next

  For a=p1 To p2
    s$+str(seq(a))
    If a<p2
      s$+"+"
    EndIf
  Next
  PrintN(s$+" = "+str(max))

  Print("Press ENTER to quit"): Input()
  CloseConsole()
EndIf

DataSection
  MyData:
  Data.i  -1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1
  EndOfMyData:
EndDataSection


def maxsubseq(seq):
  return max((seq[begin:end] for begin in xrange(len(seq)+1)
                             for end in xrange(begin, len(seq)+1)),
             key=sum)


let N = System.Random()
let G = List.init 10 (fun _->N.Next())
List.iter (printf "%d ") G
printfn "\nMax value of list is %d" (List.max G)


: supremum ( seq -- elt ) [ ] [ max ] map-reduce ;


// Gray code

function encode(v: number): number {
  return v ^ (v >> 1);
}

function decode(v: number): number {
  var result = 0;
  while (v > 0) {
    result ^= v;
    v >>= 1;
  }
  return result;
}

console.log("decimal  binary   gray    decoded");
for (var i = 0; i <= 31; i++) {
  var g = encode(i);
  var d = decode(g);
  process.stdout.write(
    "  " + i.toString().padStart(2, " ") +
    "     " + i.toString(2).padStart(5, "0") +
    "   " + g.toString(2).padStart(5, "0") +
    "   " + d.toString(2).padStart(5, "0") +
    "  " + d.toString().padStart(2, " "));
  console.log();
}


#import std
#import nat

xor = ~&Y&& not ~&B                  # either and not both

btog = xor*+ [email protected]             # map xor over the argument zipped with its shift

gtob = ~&y+ =><0> ^C/[email protected] ~&r   # fold xor over the next input with previous output

#show+

test = mat` * 2-$'01'***K7xSS pad0*K7 <.~&,btog,gtob+ btog>* iota32


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

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

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

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


(********************************************************************)
(*

  GCD of two integers, by Stein’s algorithm:
  https://en.wikipedia.org/w/index.php?title=Binary_GCD_algorithm&oldid=1072393147

  This is an implementation without proofs of anything.

  The implementations shown here require the GCC builtin functions
  for ‘count trailing zeros’. If your C compiler is GCC or another
  that supports those functions, you are fine. Otherwise, one could
  easily substitute other C code.

  Compile with ‘patscc -o gcd gcd.dats’.

*)

#define ATS_EXTERN_PREFIX "rosettacode_gcd_"
#define ATS_DYNLOADFLAG 0       (* No initialization is needed. *)

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

(********************************************************************)
(*                                                                  *)
(* Declarations of the functions.                                   *)
(*                                                                  *)

(* g0uint_gcd_stein will be the generic template function for
   unsigned integers. *)
extern fun {tk : tkind}
g0uint_gcd_stein :
  (g0uint tk, g0uint tk) -<> g0uint tk

(* g0int_gcd_stein will be the generic template function for
   signed integers, giving an unsigned result. *)
extern fun {tk_signed, tk_unsigned : tkind}
g0int_gcd_stein :
  (g0int tk_signed, g0int tk_signed) -<> g0uint tk_unsigned

(* Let us call these functions ‘gcd_stein’ or just ‘gcd’. *)
overload gcd_stein with g0uint_gcd_stein
overload gcd_stein with g0int_gcd_stein
overload gcd with gcd_stein

(********************************************************************)
(*                                                                  *)
(* The implementations.                                             *)
(*                                                                  *)

%{^

/*

  We will need a ‘count trailing zeros of a positive number’ function,
  but this is not provided in the ATS prelude. Here are
  implementations using GCC builtin functions. For fast alternatives
  in standard C, see
  https://www.chessprogramming.org/index.php?title=BitScan&oldid=22495#Trailing_Zero_Count

*/

ATSinline() atstype_uint
rosettacode_gcd_g0uint_ctz_uint (atstype_uint x)
{
  return __builtin_ctz (x);
}

ATSinline() atstype_ulint
rosettacode_gcd_g0uint_ctz_ulint (atstype_ulint x)
{
  return __builtin_ctzl (x);
}

ATSinline() atstype_ullint
rosettacode_gcd_g0uint_ctz_ullint (atstype_ullint x)
{
  return __builtin_ctzll (x);
}

%}

extern fun g0uint_ctz_uint : uint -<> int = "mac#%"
extern fun g0uint_ctz_ulint : ulint -<> int = "mac#%"
extern fun g0uint_ctz_ullint : ullint -<> int = "mac#%"

(* A generic template function for ‘count trailing zeros’ of
   non-dependent unsigned integers. *)
extern fun {tk : tkind} g0uint_ctz : g0uint tk -<> int

(* Link the implementations to the template function. *)
implement g0uint_ctz<uint_kind> (x) = g0uint_ctz_uint x
implement g0uint_ctz<ulint_kind> (x) = g0uint_ctz_ulint x
implement g0uint_ctz<ullint_kind> (x) = g0uint_ctz_ullint x

(* Let one call the function simply ‘ctz’. *)
overload ctz with g0uint_ctz

(* Now the actual implementation of g0uint_gcd_stein, the template
   function for the gcd of two unsigned integers. *)
implement {tk}
g0uint_gcd_stein (u, v) =
  let
    (* Make ‘t’ a shorthand for the unsigned integer type. *)
    typedef t = g0uint tk

    (* Use this macro to fake proof that an int is non-negative. *)
    macdef nonneg (n) = $UNSAFE.cast{intGte 0} ,(n)

    (* Looping is done by tail recursion. There is no proof
       the function terminates; this fact is indicated by
       ‘<!ntm>’. *)
    fun {tk : tkind}
    main_loop (x_odd : t, y : t) :<!ntm> t =
      let
        (* Remove twos from y, giving an odd number.
           Note gcd(x_odd,y_odd) = gcd(x_odd,y). *)
        val y_odd = (y >> nonneg (ctz y))
      in
        if x_odd = y_odd then
          x_odd
        else
          let
            (* If y_odd < x_odd then swap x_odd and y_odd.
               This operation does not affect the gcd. *)
            val x_odd = min (x_odd, y_odd)
            and y_odd = max (x_odd, y_odd)
          in
            main_loop (x_odd, y_odd - x_odd)
          end
      end

    fn
    u_and_v_both_positive (u : t, v : t) :<> t =
      let
        (* n = the number of common factors of two in u and v. *)
        val n = ctz (u lor v)

        (* Remove the common twos from u and v, giving x and y. *)
        val x = (u >> nonneg n)
        val y = (v >> nonneg n)

        (* Remove twos from x, giving an odd number.
           Note gcd(x_odd,y) = gcd(x,y). *)
        val x_odd = (x >> nonneg (ctz x))

        (* Run the main loop, but pretend it is proven to
           terminate. Otherwise we could not write ‘<>’ above,
           telling the ATS compiler that we trust the function
           to terminate. *)
        val z = $effmask_ntm (main_loop (x_odd, y))
      in
        (* Put the common factors of two back in. *)
        (z << nonneg n)
      end

    (* If v < u then swap u and v. This operation does not
       affect the gcd. *)
    val u = min (u, v)
    and v = max (u, v)
  in
    if iseqz u then
      v
    else
      u_and_v_both_positive (u, v)
  end

(* The implementation of g0int_gcd_stein, the template function for
   the gcd of two signed integers, giving an unsigned result. *)
implement {signed_tk, unsigned_tk}
g0int_gcd_stein (u, v) =
  let
    val abs_u = $UNSAFE.cast{g0uint unsigned_tk} (abs u)
    val abs_v = $UNSAFE.cast{g0uint unsigned_tk} (abs v)
  in
    g0uint_gcd_stein<unsigned_tk> (abs_u, abs_v)
  end

(********************************************************************)
(* A demonstration program. *)

implement
main0 () =
  begin
    (* Unsigned integers. *)
    assertloc (gcd (0U, 10U) = 10U);
    assertloc (gcd (9UL, 6UL) = 3UL);
    assertloc (gcd (40902ULL, 24140ULL) = 34ULL);

    (* Signed integers. *)
    assertloc (gcd (0, 10) = gcd (0U, 10U));
    assertloc (gcd (~10, 0) = gcd (0U, 10U));
    assertloc (gcd (~6L, ~9L) = 3UL);
    assertloc (gcd (40902LL, 24140LL) = 34ULL);
    assertloc (gcd (40902LL, ~24140LL) = 34ULL);
    assertloc (gcd (~40902LL, 24140LL) = 34ULL);
    assertloc (gcd (~40902LL, ~24140LL) = 34ULL);
    assertloc (gcd (24140LL, 40902LL) = 34ULL);
    assertloc (gcd (~24140LL, 40902LL) = 34ULL);
    assertloc (gcd (24140LL, ~40902LL) = 34ULL);
    assertloc (gcd (~24140LL, ~40902LL) = 34ULL)
  end

(********************************************************************)


max.subseq <- function(x) {
  cumulative <- cumsum(x)
  min.cumulative.so.far <- Reduce(min, cumulative, accumulate=TRUE)
  end <- which.max(cumulative-min.cumulative.so.far)
  begin <- which.min(c(0, cumulative[1:end]))
  if (end >= begin) x[begin:end] else x[c()]
}


(define (max-subseq l)
  (define-values (_ result _1 max-sum)
    (for/fold ([seq '()] [max-seq '()] [sum 0] [max-sum 0])
      ([i l])
      (cond [(> (+ sum i) max-sum)
             (values (cons i seq) (cons i seq) (+ sum i) (+ sum i))]
            [(< (+ sum i) 0)
             (values '() max-seq 0 max-sum)]
            [else
             (values (cons i seq) max-seq (+ sum i) max-sum)])))
  (values (reverse result) max-sum))


sub max-subseq (*@a) {
    my ($start, $end, $sum, $maxsum) = -1, -1, 0, 0;
    for @a.kv -> $i, $x {
        $sum += $x;
        if $maxsum < $sum {
            ($maxsum, $end) = $sum, $i;
        }
        elsif $sum < 0 {
            ($sum, $start) = 0, $i;
        }
    }
    return @a[$start ^.. $end];
}


class Greatest
{
  public static Void main ()
  {
    Int[] values := [1,2,3,4,5,6,7,8,9]
    Int greatest := values.max
    echo (greatest)
  }
}


: array-max ( addr len -- max )
  dup 0= if nip exit then
  over @  rot cell+  rot 1-
  cells bounds ?do  i @ max  cell +loop ;

: stack-max ( n ... m count -- max ) 1 ?do max loop ;


`timescale 1ns/10ps
`default_nettype wire

module graytestbench;

localparam aw = 8;

function [aw:0] binn_to_gray;
    input  [aw:0] binn;
begin :b2g
    binn_to_gray = binn ^ (binn >> 1);
end
endfunction

function [aw:0] gray_to_binn;
    input [aw:0] gray;
begin :g2b
    reg   [aw:0] binn;
    integer      i;

    for(i=0; i <= aw; i = i+1) begin
     binn[i] = ^(gray >> i);
    end
    gray_to_binn = binn;
end
endfunction

initial begin :test_graycode
    integer   ii;
    reg[aw:0] gray;
    reg[aw:0] binn;

    for(ii=0; ii < 10; ii=ii+1) begin
        gray = binn_to_gray(ii[aw:0]);
        binn = gray_to_binn(gray);

        $display("test_graycode: i:%x gray:%x:%b binn:%x", ii[aw:0], gray, gray, binn);
    end

    $stop;
end

endmodule

`default_nettype none


LIBRARY ieee;
USE ieee.std_logic_1164.all;

entity b2g is
   port(  bin  : in  std_logic_vector (4 downto 0);
          gray : out std_logic_vector (4 downto 0)
        );
end b2g ;

architecture rtl of b2g is
  constant N : integer := bin'high;
begin
  gray <= bin(n) & ( bin(N-1 downto 0) xor bin(N downto 1));
end architecture rtl;


GCD(a,b) {
   Return b=0 ? Abs(a) : Gcd(b,mod(a,b))
}


_GCD(18, 12)
_GCD(1071, 1029)
_GCD(3528, 3780)

Func _GCD($ia, $ib)
	Local $ret = "GCD of " & $ia & " : " & $ib & " = "
	Local $imod
	While True
		$imod = Mod($ia, $ib)
		If $imod = 0 Then Return ConsoleWrite($ret & $ib & @CRLF)
		$ia = $ib
		$ib = $imod
	WEnd
EndFunc   ;==>_GCD


[ -1 -2 3 5 6 -2 -1 4 -4 2 -1 ] as $seq

1 31 shl as $max

0   $seq length   1 range each as $i
    0 as $sum
    $i   $seq length  1 range each as $j
        $seq $j get   $sum +  as $sum
        $sum $max > if
            $sum as $max
            $i as $i1
            $j as $j1

"Sum: " print
$i1 $j1 1 range each
    #dup "$seq[%d]\n" print
    $seq swap get "%d," print
$max   $seq $j1 get   "%d  =  %d\n" print


/*REXX program  finds and displays  the  longest  greatest continuous subsequence  sum. */
parse arg @;         w= words(@);      p= w + 1  /*get arg list;  number words in list. */
say 'words='w    "   list="@                     /*show number words & LIST to terminal,*/
     do #=1  for w;  @.#= word(@, #);  end       /*build an array for faster processing.*/
L=0;                    sum= 0                   /* [↓]  process the list of numbers.   */
     do j=1  for w                               /*select one number at a time from list*/
         do k=j  to w;  _= k-j+1;    s= @.j      /* [↓]  process a sub─list of numbers. */
                                         do m=j+1  to k;     s= s + @.m;        end  /*m*/
         if (s==sum & _>L) | s>sum  then do;       sum= s;   p= j;      L= _;   end
         end   /*k*/                             /* [↑]  chose the longest greatest sum.*/
     end       /*j*/
say
$= subword(@,p,L);   if $==''  then $= "[NULL]"  /*Englishize the  null   (value).      */
say 'sum='sum/1            "   sequence="$       /*stick a fork in it,  we're all done. */


program test_maxval

integer,dimension(5),parameter :: x = [10,100,7,1,2]
real,dimension(5),parameter :: y = [5.0,60.0,1.0,678.0,0.0]

write(*,'(I5)') maxval(x)
write(*,'(F5.1)') maxval(y)

end program test_maxval


' FB 1.05.0 Win64

Function MaxElement(a() As Double) As Double
  Dim max As Double = a(LBound(a))
  For i As Integer = LBound(a) + 1 To UBound(a)
    If a(i) > max Then max = a(i)
  Next
  Return max
End Function

Dim As Integer i, n
Input "How many values are to be input ";  n
If n < 1 Then End
Dim a(1 To n) As Double
For i = 1 To n
  Print "  Value"; i; " : ";
  Input "", a(i)
Next
Dim max As Double = MaxElement(a())
Print
Print "The greatest value is"; max
Print
Print "Press any key to quit"
Sleep


fn enc(b int) int {
    return b ^ b>>1
}

fn dec(gg int) int {
    mut b := 0
    mut g := gg
    for ; g != 0; g >>= 1 {
        b ^= g
    }
    return b
}

fn main() {
    println("decimal  binary   gray    decoded")
    for b := 0; b < 32; b++ {
        g := enc(b)
        d := dec(g)
        println("  ${b:2}     ${b:05b}   ${g:05b}   ${d:05b}  ${d:2}")
    }
}


import "/fmt" for Fmt

var toGray = Fn.new { |n| n ^ (n>>1) }

var fromGray = Fn.new { |g|
    var b = 0
    while (g != 0) {
        b = b ^ g
        g = g >> 1
    }
    return b
}

System.print("decimal  binary  gray    decoded")
for (b in 0..31) {
    System.write("  %(Fmt.d(2, b))     %(Fmt.bz(5, b))")
    var g = toGray.call(b)
    System.write("   %(Fmt.bz(5, g))")
    System.print("   %(Fmt.bz(5, fromGray.call(g)))")
}


' Gray code
PROGRAM "graycode"
VERSION "0.0001"

DECLARE FUNCTION Entry()
INTERNAL FUNCTION Encode(v&)
INTERNAL FUNCTION Decode(v&)

FUNCTION Entry()
  PRINT "decimal  binary   gray    decoded"
  FOR i& = 0 TO 31
    g& = Encode(i&)
    d& = Decode(g&)
    PRINT FORMAT$("  ##", i&); "     "; BIN$(i&, 5); "   "; BIN$(g&, 5);
    PRINT "   "; BIN$(d&, 5); FORMAT$("  ##", d&)
  NEXT i&
END FUNCTION

FUNCTION Encode(v&)
END FUNCTION v& ^ (v& >> 1)

FUNCTION Decode(v&)
  result& = 0
  DO WHILE v& > 0
    result& = result& ^ v&
    v& = v& >> 1
  LOOP
END FUNCTION result&

END PROGRAM


# Project : Greatest subsequential sum

aList1 = [0, 1, 2, -3, 3, -1, 0, -4, 0, -1, -4, 2]
see "[0, 1, 2, -3, 3, -1, 0, -4, 0, -1, -4, 2]  -> " + sum(aList1) + nl
aList2 = [-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1]
see "[-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1] -> " + sum(aList2) + nl
aList3 = [-1, -2, -3, -4, -5]
see "[-1, -2, -3, -4, -5] -> " + sum(aList3) + nl
aList4 = []
see "[] - > " + sum(aList4) + nl

func sum aList
     sumold = []
     sumnew = []
     snew = 0
     flag = 0
     if len(aList) = 0
        return 0
     ok
     for s=1 to len(aList)
         if aList[s] > -1
            flag = 1
         ok
     next
     if flag = 0
        return "[]"
     ok
     for n=1 to len(aList)
         sumold = []
         sold = 0
         for m=n to len(aList)
             add(sumold, aList[m])
             sold = sold + aList[m]
             if sold > snew
                snew = sold
                sumnew = sumold
             ok
         next
     next
     return showarray(sumnew)

func showarray(a)
     conv = "["
     for i = 1 to len(a)
         conv = conv + string(a[i]) + ", "
     next
     conv = left(conv, len(conv) - 2) + "]"
     return conv


def subarray_sum(arr)
  max, slice = 0, []
  arr.each_index do |i|
    (i...arr.length).each do |j|
      sum = arr[i..j].inject(0, :+)
      max, slice = sum, arr[i..j]  if sum > max
    end
  end
  [max, slice]
end


let main (xs: []f64) = reduce f64.max (-f64.inf) xs


include c:\cxpl\codes;          \intrinsic 'code' declarations

func Gray2Bin(N);               \Convert N from Gray code to binary
int N;
int S;
[S:= 1;
repeat  N:= N>>S | N;
        S:= S<<1;
until   S=32;
return N;
]; \Gray2Bin

func Bin2Gray(N);               \Convert N from binary to Gray code
int N;
return N>>1 | N;

proc BinOut(N);                 \Output N in binary
int N;
int R;
[R:= N&1;
N:= N>>1;
if N then BinOut(N);
ChOut(0, R+^0);
]; \BinOut

int N, G;
[for N:= 0 to 31 do
        [BinOut(N); ChOut(0, 9\tab\);
        G:= Bin2Gray(N);
        BinOut(G);  ChOut(0, 9\tab\);
        BinOut(Gray2Bin(G));  CrLf(0);
        ];
]


fcn grayEncode(n){ n.bitXor(n.shiftRight(1)) }
fcn grayDecode(g){ b:=g; while(g/=2){ b=b.bitXor(g) } b }


Lbl GCD
r₁→A
r₂→B
!If B
 A
 Return
End
GCD(B,A^B)


FUNCTION gcd(a%, b%)
   IF a > b THEN
      factor = a
   ELSE
      factor = b
   END IF
   FOR l = factor TO 1 STEP -1
      IF a MOD l = 0 AND b MOD l = 0 THEN
         gcd = l
      END IF
   NEXT l
   gcd = 1
END FUNCTION


seq$ = "-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1"
max = -999
for i = 1 to 11
sum = 0
   for j = i to 11
      sum = sum + val(word$(seq$,j,","))
      If sum > max then
         max = sum
         i1  = i
         j1  = j
      end if
   next j
next i
print "Sum:";
for i = i1 to j1
   print word$(seq$,i,",");",";
next i
print " = ";max


fn main() {
    let nums = [1,2,39,34,20, -20, -16, 35, 0];

    let mut max = 0;
    let mut boundaries = 0..0;

    for length in 0..nums.len() {
        for start in 0..nums.len()-length {
            let sum = (&nums[start..start+length]).iter()
                .fold(0, |sum, elem| sum+elem);
            if sum > max {
                max = sum;
                boundaries = start..start+length;
            }
        }
    }

    println!("Max subsequence sum: {} for {:?}", max, &nums[boundaries]);;
}


def maxSubseq(l: List[Int]) = l.scanRight(Nil : List[Int]) {
  case (el, acc) if acc.sum + el < 0 => Nil
  case (el, acc)                     => el :: acc
} max Ordering.by((_: List[Int]).sum)

def biggestMaxSubseq(l: List[Int]) = l.scanRight(Nil : List[Int]) {
  case (el, acc) if acc.sum + el < 0 => Nil
  case (el, acc)                     => el :: acc
} max Ordering.by((ss: List[Int]) => (ss.sum, ss.length))

def biggestMaxSubseq[N](l: List[N])(implicit n: Numeric[N]) = {
  import n._
  l.scanRight(Nil : List[N]) {
    case (el, acc) if acc.sum + el < zero => Nil
    case (el, acc)                        => el :: acc
  } max Ordering.by((ss: List[N]) => (ss.sum, ss.length))
}

def linearBiggestMaxSubseq[N](l: List[N])(implicit n: Numeric[N]) = {
  import n._
  l.scanRight((zero, Nil : List[N])) {
    case (el, (acc, _)) if acc + el < zero => (zero, Nil)
    case (el, (acc, ss))                   => (acc + el, el :: ss)
  } max Ordering.by((t: (N, List[N])) => (t._1, t._2.length)) _2
}


10 INPUT "How many items? ", N%
20 DIM ARR(N%)
30 FOR I% = 0 TO N%-1
40 PRINT "Value of item #";I%
50 INPUT ARR(I%)
60 NEXT I%
70 CHAMP = ARR(0) : INDEX = 0
80 FOR I% = 1 TO N%-1
90 IF ARR(I%)>CHAMP THEN CHAMP=ARR(I%):INDEX=I%
100 NEXT I%
110 PRINT "The maximum value was ";CHAMP;" at index ";INDEX;"."
120 END


function gcdI(x, y)
	while y
		t = y
		y = x mod y
		x = t
	end while

	return x
end function

# ------ test ------
a = 111111111111111
b = 11111

print : print "GCD(";a;", ";b;") = "; gcdI(a, b)
print : print "GCD(";a;", 111) = "; gcdI(a, 111)
end


:: gcd.cmd
@echo off
:gcd
if "%2" equ "" goto :instructions
if "%1" equ "" goto :instructions

if %2 equ 0 (
	set final=%1
	goto :done
)
set /a res = %1 %% %2
call :gcd %2 %res%
goto :eof

:done
echo gcd=%final%
goto :eof

:instructions
echo Syntax:
echo 	GCD {a} {b}
echo.


(define (maxsubseq in)
  (let loop
    ((_sum 0) (_seq (list)) (maxsum 0) (maxseq (list)) (l in))
    (if (null? l)
        (cons maxsum (reverse maxseq))
        (let* ((x (car l)) (sum (+ _sum x)) (seq (cons x _seq)))
          (if (> sum 0)
              (if (> sum maxsum)
                  (loop sum seq    sum    seq (cdr l))
                  (loop sum seq maxsum maxseq (cdr l)))
              (loop 0 (list) maxsum maxseq (cdr l)))))))


$ include "seed7_05.s7i";

const func array integer: maxSubseq (in array integer: sequence) is func
  result
    var array integer: maxSequence is 0 times 0;
  local
    var integer: number is 0;
    var integer: index is 0;
    var integer: currentSum is 0;
    var integer: currentStart is 1;
    var integer: maxSum is 0;
    var integer: startPos is 0;
    var integer: endPos is 0;
  begin
    for number key index range sequence do
      currentSum +:= number;
      if currentSum < 0 then
        currentStart := succ(index);
        currentSum := 0;
      elsif currentSum > maxSum then
        maxSum := currentSum;
        startPos := currentStart;
        endPos := index;
      end if;
    end for;
    if startPos <= endPos and startPos >= 1 and endPos >= 1 then
      maxSequence := sequence[startPos .. endPos];
    end if;
  end func;

const proc: main is func
  local
    const array integer: a1 is [] (-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1);
    const array integer: a2 is [] (-1, -2, -3, -5, -6, -2, -1, -4, -4, -2, -1);
    var integer: number is 0;
  begin
    write("Maximal subsequence:");
    for number range maxSubseq(a1) do
      write(" " <& number);
    end for;
    writeln;
    write("Maximal subsequence:");
    for number range maxSubseq(a2) do
      write(" " <& number);
    end for;
    writeln;
  end func;


# Built-in

L := List([1 .. 100], n -> Random(1, 10));

MaximumList(L);
# 10