' Go Fish ~ ¡Pesca!

Const cartas = "A234567890JQK"

Declare Sub Reparto_Cartas
Declare Sub Pescar_Carta_Jug
Declare Sub Pescar_Carta_CPU
Declare Sub Comprobar_Libro_Jug
Declare Sub Comprobar_Libro_CPU
Declare Sub Comprobar_Fin_Partida
Declare Sub Intro

Dim Shared As Integer play(13), compu(13), deck(13), guess(13), poss(13), asked(13)
Dim Shared As String nombre, Snombre, CartaPedida
Dim Shared puntos(2) As Byte = {0,0}
Dim Shared As Integer remca = 4*Len(cartas)
Dim Shared As Integer i, k, j, cn
For i = 1 To 13
    deck(i) = 4
Next i
For i = 1 To 9
    Reparto_Cartas
    deck(k) -= 1
    compu(k) += 1
    Reparto_Cartas
    deck(k) -= 1
    play(k) += 1
Next i
Dim As Integer v, po

Sub Reparto_Cartas
    remca -= 1
    Dim As Integer sc = remca * Rnd + 1
    For k = 1 To 13
        sc -= deck(k)
        If sc <= 0 Then Return
    Next k
End Sub

Sub Pescar_Carta_Jug
    Reparto_Cartas
    Print " " &Mid(cartas,k,1) &"."
    deck(k) -= 1
    play(k) += 1
End Sub

Sub Pescar_Carta_CPU
    Reparto_Cartas
    Print "a carta."
    deck(k) -= 1
    compu(k) += 1
End Sub

Sub Comprobar_Libro_Jug
    For i = 1 To 13
        If play(i) <> 4 Then
        Else
            Color 11: Print Snombre &" completa el libro de " &Mid(cartas,i,1) &"'s.": Color 7
            play(i) = 0
            puntos(0) += 1
        End If
    Next i
End Sub

Sub Comprobar_Libro_CPU
    For i = 1 To 13
        If compu(i) <> 4 Then
        Else
            Color 11: Print Snombre &" completa el libro de " &Mid(cartas,i,1) &"'s.": Color 7
            compu(i) = 0
            puntos(1) += 1
        End If
    Next i
End Sub

Sub Comprobar_Fin_Partida
    Dim As Integer np = 0, nc = 0
    For i = 1 To 13
        np += play(i)
        nc += compu(i)
    Next i
    If remca = 0 Or np = 0 Or nc = 0 Then
        Color 15: Print
        Print "*** FIN de la partida! ***"
        Print
        If puntos(0) < puntos(1) Then
            Print "La CPU ha ganado."
        Elseif puntos(0) > puntos(1) Then
            Print nombre &" ha ganado."
        Else
            Print "Es un empate!"
        End If
        Sleep: End
    End If
End Sub

Sub Intro
    Color 15
    Print "                __ _     _      "
    Print "  __ _  ___    / _(_)___| |__   "
    Print " /  ` |/ _ \  | |_| / __| '_ \  "
    Print "| (_) | (_) | |  _| \__ \ | | | "
    Print " \__, |\___/  |_| |_|___/_| |_| "
    Print " |___/                          "
    Print "                                "
    Color 14: Locate 10, 2: Input "Como te llamas: ", nombre
End Sub

'--- Programa Principal ---
Cls
Randomize Timer
Intro
Do
    Dim As boolean MuestraMano = false
    While MuestraMano = false
        Color 15: Print Chr(10) &"Puntos >> " &nombre &": "; puntos(0); "  CPU: "; puntos(1)
        Color 13: Print Chr(10) &space(10) &remca &" cartas restantes"
        Color 14: Print Chr(10) &"Tu mano: ";
        For i = 1 To 13
            If Not play(i) Then
                For j = 1 To play(i)
                    Print Mid(cartas,i,1); " ";
                Next j
            End If
        Next i
        Print

        Dim As boolean PideCarta = false
        While PideCarta = false
            Comprobar_Fin_Partida
            Snombre = nombre
            Color 7: Print
            Input "¨Que carta pides... "; CartaPedida
            Print
            If CartaPedida <> "" Then cn = Instr(cartas, Ucase(CartaPedida)): PideCarta = true
            If cn = 0 Then
                Print "Lo siento, no es una opción valida.": PideCarta = false
                Elseif play(cn) = 0 Then Color 12: Print "No tienes esa carta!": Color 7: PideCarta = false
            End If
        Wend

        guess(cn) = 1
        If compu(cn) = 0 Then
            Print Snombre &", ";
            Color 15: Print "ve a pescar!"
            Color 7: Print Snombre &" pesca un";: Pescar_Carta_Jug
            Comprobar_Libro_Jug
            MuestraMano = true
        Else
            v = compu(cn)
            compu(cn) = 0
            play(cn) += v
            Print Snombre &" consigue " &v &" carta(s) mas."
            Comprobar_Libro_Jug
            MuestraMano = false
        End If
    Wend

    Snombre = "CPU"
    For i = 1 To 13
        asked(i) = 0
    Next i
    Dim As boolean Turno_CPU_2 = false
    While Turno_CPU_2 = false
        Comprobar_Fin_Partida
        po = 0
        For i = 1 To 13
            If (compu(i) > 0) And (guess(i) > 0) Then poss(i) = 1: po += 1
        Next i
        If po = 0 Then
            Do
                k = (Rnd*12)+1
            Loop While compu(k) = 0 Or asked(k)
        Else
            Do
                k = (Rnd*12)+1
            Loop While poss(k) = 0
            guess(k) = 0
            asked(k) = 1
        End If

        Print: Print Snombre &" quiere tus " &Mid(cartas,k,1) &"'s."
        asked(k) = 1
        If play(k) = 0 Then
            Print Snombre &", ";
            Color 15: Print "ve a pescar!"
            Color 7:Print Snombre &" pesca un";: Pescar_Carta_CPU
            Comprobar_Libro_CPU
            Turno_CPU_2 = true
        Else
            v = play(k)
            play(k) = 0
            compu(k) += v
            Print Snombre &" consigue " &v &" carta(s) mas."
            Comprobar_Libro_CPU
            Turno_CPU_2 = false
        End If
    Wend
Loop
End


max({1, 2, 3, 4, 20, 6, 11, 3, 9, 7})

on max(aList)
	set _curMax to first item of aList
	repeat with i in (rest of aList)
		if i > _curMax then set _curMax to contents of i
	end repeat
	return _curMax
end max


      INSTALL @lib$+"STRINGLIB"

      PRINT "   Decimal    Binary      Gray   Decoded"
      FOR number% = 0 TO 31
        gray% = FNgrayencode(number%)
        PRINT number% "     " FN_tobase(number%, 2, 5) ;
        PRINT "     " FN_tobase(gray%, 2, 5) FNgraydecode(gray%)
      NEXT
      END

      DEF FNgrayencode(B%) = B% EOR (B% >>> 1)

      DEF FNgraydecode(G%) : LOCAL B%
      REPEAT B% EOR= G% : G% = G% >>> 1 : UNTIL G% = 0
      = B%


scale = 0  /* to use integer division */

/* encode Gray code */
define e(i) {
	auto h, r

	if (i <= 0) return 0
	h = i / 2
	r = e(h) * 2                /* recurse */
	if (h % 2 != i % 2) r += 1  /* xor low bits of h, i */
	return r
}

/* decode Gray code */
define d(i) {
	auto h, r

	if (i <= 0) return 0
	h = d(i / 2)                /* recurse */
	r = h * 2
	if (h % 2 != i % 2) r += 1  /* xor low bits of h, i */
	return r
}

/* print i as 5 binary digits */
define p(i) {
	auto d, d[]

	for (d = 0; d <= 4; d++) {
		d[d] = i % 2
		i /= 2
	}
	for (d = 4; d >= 0; d--) {
		if(d[d] == 0) "0"
		if(d[d] == 1) "1"
	}
}

for (i = 0; i < 32; i++) {
	/* original */ t = p(i); " => "
	/* encoded */ e = e(i); t = p(e); " => "
	/* decoded */ d = d(e); t = p(d); "
"
}
quit


int gray_encode(int n) {
    return n ^ (n >> 1);
}

int gray_decode(int n) {
    int p = n;
    while (n >>= 1) p ^= n;
    return p;
}


using System;

public class Gray {
    public static ulong grayEncode(ulong n) {
        return n^(n>>1);
    }

    public static ulong grayDecode(ulong n) {
        ulong i=1<<8*64-2; //long is 64-bit
        ulong p, b=p=n&i;

        while((i>>=1)>0)
            b|=p=n&i^p>>1;
        return b;
    }

    public static void Main(string[] args) {
        Console.WriteLine("Number\tBinary\tGray\tDecoded");
        for(ulong i=0;i<32;i++) {
            Console.WriteLine(string.Format("{0}\t{1}\t{2}\t{3}", i, Convert.ToString((long)i, 2), Convert.ToString((long)grayEncode(i), 2), grayDecode(grayEncode(i))));
        }
    }
}


defmodule Greatest do
  def subseq_sum(list) do
    list_i = Enum.with_index(list)
    acc = {0, 0, length(list), 0, 0}
    {_,max,first,last,_} = Enum.reduce(list_i, acc, fn {elm,i},{curr,max,first,last,curr_first} ->
      if curr < 0 do
        if elm > max, do: {elm, elm, i,     i,    curr_first},
                    else: {elm, max, first, last, curr_first}
      else
        cur2 = curr + elm
        if cur2 > max, do: {cur2, cur2, curr_first, i, curr_first},
                     else: {cur2, max,  first,   last, curr_first}
      end
    end)
    {max, Enum.slice(list, first..last)}
  end
end


PROGRAM MAX_SUM

DIM A%[11],B%[10],C%[4]

!$DYNAMIC
DIM P%[0]

PROCEDURE MAX_SUBSEQUENCE(P%[],N%->A$)
      LOCAL A%,B%,I%,J%,M%,S%
      A%=1
      FOR I%=0 TO N% DO
        S%=0
        FOR J%=I% TO N% DO
          S%+=P%[J%]
          IF S%>M% THEN
            M%=S%
            A%=I%
            B%=J%
          END IF
        END FOR
      END FOR
      IF A%>B% THEN A$="[]" EXIT PROCEDURE END IF
      A$="["
      FOR I%=A% TO B% DO
        A$+=STR$(P%[I%])+","
      END FOR
      A$=LEFT$(A$,LEN(A$)-1)+"]"
END PROCEDURE

PROCEDURE SHOW_ARRAY(P%[],N%->A$)
      LOCAL I%
      A$="["
      FOR I%=0 TO N% DO
        A$+=STR$(P%[I%])+","
      END FOR
      A$=LEFT$(A$,LEN(A$)-1)+"]"
END PROCEDURE

BEGIN

   A%[]=(0,1,2,-3,3,-1,0,-4,0,-1,-4,2)
   N%=UBOUND(A%,1)
   !$DIM P%[N%]
   SHOW_ARRAY(A%[],N%->A$)
   PRINT(A$;" -> ";)
   MAX_SUBSEQUENCE(A%[],N%->A$)
   PRINT(A$)
   !$ERASE P%

   B%[]=(-1,-2,3,5,6,-2,-1,4,-4,2,-1)
   N%=UBOUND(B%,1)
   !$DIM P%[N%]
   SHOW_ARRAY(B%[],N%->A$)
   PRINT(A$;" -> ";)
   MAX_SUBSEQUENCE(B%[],N%->A$)
   PRINT(A$)
   !$ERASE P%

   C%[]=(-1,-2,-3,-4,-5)
   N%=UBOUND(C%,1)
   !$DIM P%[N%]
   SHOW_ARRAY(C%[],N%->A$)
   PRINT(A$;" -> ";)
   MAX_SUBSEQUENCE(C%[],N%->A$)
   PRINT(A$)
   !$ERASE P%
END PROGRAM


(in-package #:rgb-pixel-buffer)

(defun rgb-to-gray-image (rgb-image)
  (flet ((rgb-to-gray (rgb-value)
	   (round (+ (* 0.2126 (rgb-pixel-red rgb-value))
		     (* 0.7152 (rgb-pixel-green rgb-value))
		     (* 0.0722 (rgb-pixel-blue rgb-value))))))
    (let ((gray-image (make-array (array-dimensions rgb-image) :element-type '(unsigned-byte 8))))
      (dotimes (i (array-total-size rgb-image))
	(setf (row-major-aref gray-image i) (rgb-to-gray (row-major-aref rgb-image i))))
      gray-image)))

(export 'rgb-to-gray-image)

(defun grayscale-image-to-pgm-file (image file-name &optional (max-value 255))
  (with-open-file (p file-name :direction :output
		     :if-exists :supersede)
    (format p "P2 ~&~A ~A ~&~A" (array-dimension image 1) (array-dimension image 0) max-value)
    (dotimes (i (array-total-size image))
      (print (row-major-aref image i) p))))

(export 'grayscale-image-to-pgm-file)


class RGBColour
  def to_grayscale
    luminosity = (0.2126*@red + 0.7152*@green + 0.0722*@blue).to_i
    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


 100 REMMAX
 110 R$ = "":E$ = ""
 120 L =  LEN (L$)
 130 IF L = 0 THEN  RETURN
 140 FOR I = 1 TO L
 150     C$ =  MID$ (L$,I,1)
 160     SP = C$ = " "
 170     IF SP THEN  GOSUB 200
 180     E$ = E$ + C$
 190 NEXT I
 200 C$ = ""
 210 IF E$ = "" THEN  RETURN
 220 V =  VAL (E$):V$ = R$
 230 E$ = "":E = V$ = ""
 240 IF E AND V = 0 THEN  RETURN
 250 R$ =  STR$ (V)
 260 IF E THEN  RETURN
 270 R =  VAL (V$)
 280 IF R < V THEN  RETURN
 290 R$ = V$: RETURN


/* ARM assembly Raspberry PI  */
/*  program rechMax.s   */

/* Constantes    */
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessResult:  .ascii "Max number is = "      @ message result
sMessValeur:   .fill 12, 1, ' '
                  .ascii " rank = "
sMessRank:   .fill 12, 1, ' '
                  .ascii " address (hexa) = "
sMessAddress:   .fill 12, 1, ' '
                   .asciz "\n"

tTableNumbers:    .int   50
                      .int 12
                      .int -1000
                      .int 40
                      .int 255
                      .int 60
                      .int 254
.equ NBRANKTABLE,   (. - tTableNumbers) / 4  @ number table posts

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                @ entry of program
    push {fp,lr}      @ saves 2 registers

    ldr r1,iAdrtTableNumbers
    mov r2,#0
    ldr r4,[r1,r2,lsl #2]
    mov r3,r2
    add r2,#1
1:
    cmp r2,#NBRANKTABLE
	bge 2f
	ldr r0,[r1,r2,lsl #2]
	cmp r0,r4
	movgt r4,r0
	movgt r3,r2
	add r2,#1
	b 1b

2:
    mov r0,r4
    ldr r1,iAdrsMessValeur
    bl conversion10S       @ call conversion
    mov r0,r3
    ldr r1,iAdrsMessRank
    bl conversion10       @ call conversion
    ldr r0,iAdrtTableNumbers
    add r0,r3,lsl #2
    ldr r1,iAdrsMessAddress
    bl conversion16       @ call conversion
    ldr r0,iAdrszMessResult
    bl affichageMess            @ display message

100:   @ standard end of the program
    mov r0, #0                  @ return code
    pop {fp,lr}                 @restaur 2 registers
    mov r7, #EXIT              @ request to exit program
    swi 0                       @ perform the system call
iAdrtTableNumbers:    .int  tTableNumbers
iAdrsMessValeur:      .int sMessValeur
iAdrsMessRank:         .int sMessRank
iAdrsMessAddress:     .int sMessAddress
iAdrszMessResult:     .int szMessResult

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {fp,lr}    			/* save  registres */
    push {r0,r1,r2,r7}    		/* save others registers */
    mov r2,#0   				/* counter length */
1:      	/* loop length calculation */
    ldrb r1,[r0,r2]  			/* read octet start position + index */
    cmp r1,#0       			/* if 0 its over */
    addne r2,r2,#1   			/* else add 1 in the length */
    bne 1b          			/* and loop */
                                /* so here r2 contains the length of the message */
    mov r1,r0        			/* address message in r1 */
    mov r0,#STDOUT      		/* code to write to the standard output Linux */
    mov r7, #WRITE             /* code call system "write" */
    swi #0                      /* call systeme */
    pop {r0,r1,r2,r7}     		/* restaur others registers */
    pop {fp,lr}    				/* restaur des  2 registres */
    bx lr	        			/* return  */
/******************************************************************/
/*     Converting a register to hexadecimal                      */
/******************************************************************/
/* r0 contains value and r1 address area   */
conversion16:
    push {r1-r4,lr}    /* save registers */
    mov r2,#28         @ start bit position
    mov r4,#0xF0000000    @ mask
    mov r3,r0      @ save entry value
1:	   @ start loop
    and r0,r3,r4   @value register and mask
    lsr r0,r2      @ move right
    cmp r0,#10      @ compare value
    addlt r0,#48        @ <10  ->digit
    addge r0,#55        @ >10  ->letter A-F
    strb r0,[r1],#1  @ store digit on area and + 1 in area address
    lsr r4,#4       @ shift mask 4 positions
    subs r2,#4         @  counter bits - 4 <= zero  ?
    bge 1b	          @  no -> loop
    @end
    pop {r1-r4,lr}    @ restaur registres
    bx lr             @return
/******************************************************************/
/*     Converting a register to a decimal                                 */
/******************************************************************/
/* r0 contains value and r1 address area   */
conversion10:
    push {r1-r4,lr}    /* save registers */
    mov r3,r1
    mov r2,#10

1:	   @ start loop
    bl divisionpar10 @ r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48        @ digit
    strb r1,[r3,r2]  @ store digit on area
    sub r2,#1         @ previous position
    cmp r0,#0         @ stop if quotient = 0 */
    bne 1b	          @ else loop
    @ and move spaves in first on area
    mov r1,#' '   @ space
2:
    strb r1,[r3,r2]  @ store space in area
    subs r2,#1       @ @ previous position
    bge 2b           @ loop if r2 >= zéro

100:
    pop {r1-r4,lr}    @ restaur registres
    bx lr	          @return
/***************************************************/
/*  Converting a register to a signed decimal      */
/***************************************************/
/* r0 contains value and r1 area address    */
conversion10S:
    push {r0-r4,lr}    @ save registers
    mov r2,r1       /* debut zone stockage */
    mov r3,#'+'     /* par defaut le signe est + */
    cmp r0,#0       @ negative number ?
    movlt r3,#'-'   @ yes
    mvnlt r0,r0     @ number inversion
    addlt r0,#1
    mov r4,#10       @ length area
1:  @ start loop
    bl divisionpar10
    add r1,#48   @ digit
    strb r1,[r2,r4]  @ store digit on area
    sub r4,r4,#1      @ previous position
    cmp r0,#0          @ stop if quotient = 0
    bne 1b

    strb r3,[r2,r4]  @ store signe
    subs r4,r4,#1    @ previous position
    blt  100f        @ if r4 < 0 -> end

    mov r1,#' '   @ space
2:
    strb r1,[r2,r4]  @store byte space
    subs r4,r4,#1    @ previous position
    bge 2b           @ loop if r4 > 0
100:
    pop {r0-r4,lr}   @ restaur registers
    bx lr
/***************************************************/
/*   division par 10   signé                       */
/* Thanks to http://thinkingeek.com/arm-assembler-raspberry-pi/*
/* and   http://www.hackersdelight.org/            */
/***************************************************/
/* r0 dividende   */
/* r0 quotient */
/* r1 remainder  */
divisionpar10:
  /* r0 contains the argument to be divided by 10 */
   push {r2-r4}   /* save registers  */
   mov r4,r0
   ldr r3, .Ls_magic_number_10 /* r1 <- magic_number */
   smull r1, r2, r3, r0   /* r1 <- Lower32Bits(r1*r0). r2 <- Upper32Bits(r1*r0) */
   mov r2, r2, ASR #2     /* r2 <- r2 >> 2 */
   mov r1, r0, LSR #31    /* r1 <- r0 >> 31 */
   add r0, r2, r1         /* r0 <- r2 + r1 */
   add r2,r0,r0, lsl #2   /* r2 <- r0 * 5 */
   sub r1,r4,r2, lsl #1   /* r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10) */
   pop {r2-r4}
   bx lr                  /* leave function */
   .align 4
.Ls_magic_number_10: .word 0x66666667


#include <bitset>
#include <iostream>
#include <string>
#include <assert.h>

uint32_t gray_encode(uint32_t b)
{
    return b ^ (b >> 1);
}

uint32_t gray_decode(uint32_t g)
{
    for (uint32_t bit = 1U << 31; bit > 1; bit >>= 1)
    {
        if (g & bit) g ^= bit >> 1;
    }
    return g;
}

std::string to_binary(int value) // utility function
{
    const std::bitset<32> bs(value);
    const std::string str(bs.to_string());
    const size_t pos(str.find('1'));
    return pos == std::string::npos ? "0" : str.substr(pos);
}

int main()
{
    std::cout << "Number\tBinary\tGray\tDecoded\n";
    for (uint32_t n = 0; n < 32; ++n)
    {
        uint32_t g = gray_encode(n);
        assert(gray_decode(g) == n);

        std::cout << n << "\t" << to_binary(n) << "\t" << to_binary(g) << "\t" << g << "\n";
    }
}


gray_encode = (n) ->
  n ^ (n >> 1)

gray_decode = (g) ->
  n = g
  n ^= g while g >>= 1
  n

for i in [0..32]
  console.log gray_decode gray_encode(i)


Object subclass: Hammer [
  Hammer class >> hammingNumbers: howMany [
    |h i j k x2 x3 x5|
      h := OrderedCollection new.
      i := 0. j := 0. k := 0.
      h add: 1.
      x2 := 2. x3 := 2. x5 := 5.
      [ ( h size) < howMany ] whileTrue: [
        |m|
        m := { x2. x3. x5 } sort first.
        (( h indexOf: m ) = 0) ifTrue: [ h add: m ].
        ( x2 = (h last) ) ifTrue: [ i := i + 1. x2 := 2 * (h at: i) ].
        ( x3 = (h last) ) ifTrue: [ j := j + 1. x3 := 3 * (h at: j) ].
        ( x5 = (h last) ) ifTrue: [ k := k + 1. x5 := 5 * (h at: k) ].
      ].
      ^ h sort
  ]
].

(Hammer hammingNumbers: 20) displayNl.
(Hammer hammingNumbers: 1690) last displayNl.


>function %maxsubs (v,n) ...
$if n==1 then
$  if (v[1]<0) then return {zeros(1,0),zeros(1,0)}
$  else return {v,v};
$  endif;
$endif;
${v1,v2}=%maxsubs(v[1:n-1],n-1);
$m1=sum(v1); m2=sum(v2); m3=m2+v[n];
$if m3>0 then v3=v2|v[n]; else v3=zeros(1,0); endif;
$if m3>m1 then return {v2|v[n],v3};
$else return {v1,v3};
$endif;
$endfunction
>function maxsubs (v) ...
${v1,v2}=%maxsubs(v,cols(v));
$return v1
$endfunction
>maxsubs([0, 1, 2, -3, 3, -1, 0, -4, 0, -1, -4])
 [ 0  1  2 ]
>maxsubs([-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1])
 [ 3  5  6  -2  -1  4 ]
>maxsubs([-1, -2, -3, -4, -5])
 Empty matrix of size 1x0


function maxSubseq(sequence s)
    integer sum, maxsum, first, last
    maxsum = 0
    first = 1
    last = 0
    for i = 1 to length(s) do
        sum = 0
        for j = i to length(s) do
            sum += s[j]
            if sum > maxsum then
                maxsum = sum
                first = i
                last = 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})


module grayscale_image;

import core.stdc.stdio, std.array, std.algorithm, std.string, std.ascii;
public import bitmap;

struct Gray {
    ubyte c;
    enum black = typeof(this)(0);
    enum white = typeof(this)(255);
    alias c this;
}

Image!Color loadPGM(Color)(Image!Color img, in string fileName) {
    static int readNum(FILE* f) nothrow @nogc {
        int n;
        while (!fscanf(f, "%d ", &n)) {
            if ((n = fgetc(f)) == '#') {
                while ((n = fgetc(f)) != '\n')
                    if (n == EOF)
                        return 0;
            } else
                return 0;
        }
        return n;
    }

    if (img is null)
        img = new Image!Color();

    auto fin = fopen(fileName.toStringz(), "rb");
    scope(exit) if (fin) fclose(fin);
    if (!fin)
        throw new Exception("Can't open input file.");

    if (fgetc(fin) != 'P' ||
        fgetc(fin) != '5' ||
        !isWhite(fgetc(fin)))
        throw new Exception("Not a PGM (PPM P5) image.");

    immutable int nc = readNum(fin);
    immutable int nr = readNum(fin);
    immutable int maxVal = readNum(fin);
    if (nc <= 0 || nr <= 0 || maxVal <= 0)
        throw new Exception("Wrong input image sizes.");
    img.allocate(nc, nr);
    auto pix = new ubyte[img.image.length];

    immutable count = fread(pix.ptr, 1, nc * nr, fin);
    if (count != nc * nr)
        throw new Exception("Wrong number of items read.");

    pix.copy(img.image);
    return img;
}

void savePGM(Color)(in Image!Color img, in string fileName)
in {
    assert(img !is null);
    assert(!fileName.empty);
    assert(img.nx > 0 && img.ny > 0 &&
           img.image.length == img.nx * img.ny,
           "Wrong image.");
} body {
    auto fout = fopen(fileName.toStringz(), "wb");
    if (fout == null)
        throw new Exception("File can't be opened.");
    fprintf(fout, "P5\n%d %d\n255\n", img.nx, img.ny);
    auto pix = new ubyte[img.image.length];
    foreach (i, ref p; pix)
        p = cast(typeof(pix[0]))img.image[i];
    immutable count = fwrite(pix.ptr, ubyte.sizeof,
                             img.nx * img.ny, fout);
    if (count != img.nx * img.ny)
        new Exception("Wrong number of items written.");
    fclose(fout);
}

Gray lumCIE(in RGB c) pure nothrow @nogc {
    return Gray(cast(ubyte)(0.2126 * c.r +
                            0.7152 * c.g +
                            0.0722 * c.b + 0.5));
}

Gray lumAVG(in RGB c) pure nothrow @nogc {
    return Gray(cast(ubyte)(0.3333 * c.r +
                            0.3333 * c.g +
                            0.3333 * c.b + 0.5));
}

Image!Gray rgb2grayImage(alias Conv=lumCIE)(in Image!RGB im) nothrow {
    auto result = new typeof(return)(im.nx, im.ny);
    foreach (immutable i, immutable rgb; im.image)
        result.image[i] = Conv(rgb);
    return result;
}

Image!RGB gray2rgbImage(in Image!Gray im) nothrow {
    auto result = new typeof(return)(im.nx, im.ny);
    foreach (immutable i, immutable gr; im.image)
        result.image[i] = RGB(gr, gr, gr);
    return result;
}

version (grayscale_image_main) {
    void main() {
        auto im1 = new Image!Gray;
        im1.loadPGM("lena.pgm");
        gray2rgbImage(im1).savePPM6("lena_rgb.ppm");

        auto img2 = new Image!RGB;
        img2.loadPPM6("quantum_frog.ppm");
        img2.rgb2grayImage.savePGM("quantum_frog_grey.pgm");
    }
}


' Go Fish ~ ¡Pesca!

Const cartas = "A234567890JQK"

Declare Sub Reparto_Cartas
Declare Sub Pescar_Carta_Jug
Declare Sub Pescar_Carta_CPU
Declare Sub Comprobar_Libro_Jug
Declare Sub Comprobar_Libro_CPU
Declare Sub Comprobar_Fin_Partida
Declare Sub Intro

Dim Shared As Integer play(13), compu(13), deck(13), guess(13), poss(13), asked(13)
Dim Shared As String nombre, Snombre, CartaPedida
Dim Shared puntos(2) As Byte = {0,0}
Dim Shared As Integer remca = 4*Len(cartas)
Dim Shared As Integer i, k, j, cn
For i = 1 To 13
    deck(i) = 4
Next i
For i = 1 To 9
    Reparto_Cartas
    deck(k) -= 1
    compu(k) += 1
    Reparto_Cartas
    deck(k) -= 1
    play(k) += 1
Next i
Dim As Integer v, po

Sub Reparto_Cartas
    remca -= 1
    Dim As Integer sc = remca * Rnd + 1
    For k = 1 To 13
        sc -= deck(k)
        If sc <= 0 Then Return
    Next k
End Sub

Sub Pescar_Carta_Jug
    Reparto_Cartas
    Print " " &Mid(cartas,k,1) &"."
    deck(k) -= 1
    play(k) += 1
End Sub

Sub Pescar_Carta_CPU
    Reparto_Cartas
    Print "a carta."
    deck(k) -= 1
    compu(k) += 1
End Sub

Sub Comprobar_Libro_Jug
    For i = 1 To 13
        If play(i) <> 4 Then
        Else
            Color 11: Print Snombre &" completa el libro de " &Mid(cartas,i,1) &"'s.": Color 7
            play(i) = 0
            puntos(0) += 1
        End If
    Next i
End Sub

Sub Comprobar_Libro_CPU
    For i = 1 To 13
        If compu(i) <> 4 Then
        Else
            Color 11: Print Snombre &" completa el libro de " &Mid(cartas,i,1) &"'s.": Color 7
            compu(i) = 0
            puntos(1) += 1
        End If
    Next i
End Sub

Sub Comprobar_Fin_Partida
    Dim As Integer np = 0, nc = 0
    For i = 1 To 13
        np += play(i)
        nc += compu(i)
    Next i
    If remca = 0 Or np = 0 Or nc = 0 Then
        Color 15: Print
        Print "*** FIN de la partida! ***"
        Print
        If puntos(0) < puntos(1) Then
            Print "La CPU ha ganado."
        Elseif puntos(0) > puntos(1) Then
            Print nombre &" ha ganado."
        Else
            Print "Es un empate!"
        End If
        Sleep: End
    End If
End Sub

Sub Intro
    Color 15
    Print "                __ _     _      "
    Print "  __ _  ___    / _(_)___| |__   "
    Print " /  ` |/ _ \  | |_| / __| '_ \  "
    Print "| (_) | (_) | |  _| \__ \ | | | "
    Print " \__, |\___/  |_| |_|___/_| |_| "
    Print " |___/                          "
    Print "                                "
    Color 14: Locate 10, 2: Input "Como te llamas: ", nombre
End Sub

'--- Programa Principal ---
Cls
Randomize Timer
Intro
Do
    Dim As boolean MuestraMano = false
    While MuestraMano = false
        Color 15: Print Chr(10) &"Puntos >> " &nombre &": "; puntos(0); "  CPU: "; puntos(1)
        Color 13: Print Chr(10) &space(10) &remca &" cartas restantes"
        Color 14: Print Chr(10) &"Tu mano: ";
        For i = 1 To 13
            If Not play(i) Then
                For j = 1 To play(i)
                    Print Mid(cartas,i,1); " ";
                Next j
            End If
        Next i
        Print

        Dim As boolean PideCarta = false
        While PideCarta = false
            Comprobar_Fin_Partida
            Snombre = nombre
            Color 7: Print
            Input "¨Que carta pides... "; CartaPedida
            Print
            If CartaPedida <> "" Then cn = Instr(cartas, Ucase(CartaPedida)): PideCarta = true
            If cn = 0 Then
                Print "Lo siento, no es una opción valida.": PideCarta = false
                Elseif play(cn) = 0 Then Color 12: Print "No tienes esa carta!": Color 7: PideCarta = false
            End If
        Wend

        guess(cn) = 1
        If compu(cn) = 0 Then
            Print Snombre &", ";
            Color 15: Print "ve a pescar!"
            Color 7: Print Snombre &" pesca un";: Pescar_Carta_Jug
            Comprobar_Libro_Jug
            MuestraMano = true
        Else
            v = compu(cn)
            compu(cn) = 0
            play(cn) += v
            Print Snombre &" consigue " &v &" carta(s) mas."
            Comprobar_Libro_Jug
            MuestraMano = false
        End If
    Wend

    Snombre = "CPU"
    For i = 1 To 13
        asked(i) = 0
    Next i
    Dim As boolean Turno_CPU_2 = false
    While Turno_CPU_2 = false
        Comprobar_Fin_Partida
        po = 0
        For i = 1 To 13
            If (compu(i) > 0) And (guess(i) > 0) Then poss(i) = 1: po += 1
        Next i
        If po = 0 Then
            Do
                k = (Rnd*12)+1
            Loop While compu(k) = 0 Or asked(k)
        Else
            Do
                k = (Rnd*12)+1
            Loop While poss(k) = 0
            guess(k) = 0
            asked(k) = 1
        End If

        Print: Print Snombre &" quiere tus " &Mid(cartas,k,1) &"'s."
        asked(k) = 1
        If play(k) = 0 Then
            Print Snombre &", ";
            Color 15: Print "ve a pescar!"
            Color 7:Print Snombre &" pesca un";: Pescar_Carta_CPU
            Comprobar_Libro_CPU
            Turno_CPU_2 = true
        Else
            v = play(k)
            play(k) = 0
            compu(k) += v
            Print Snombre &" consigue " &v &" carta(s) mas."
            Comprobar_Libro_CPU
            Turno_CPU_2 = false
        End If
    Wend
Loop
End


list = 1,5,17,-2
Loop Parse, list, `,
   x := x < A_LoopField ? A_LoopField : x
MsgBox Max = %x%


(defun gray-encode (n)
  (logxor n (ash n -1)))

(defun gray-decode (n)
  (do ((p n (logxor p n)))
    ((zerop n) p)
    (setf n (ash n -1))))

(loop for i to 31 do
      (let* ((g (gray-encode i)) (b (gray-decode g)))
	(format t "~2d:~6b =>~6b =>~6b :~2d~%" i i g b b)))


MODULE GrayCodes;
IMPORT StdLog,SYSTEM;

PROCEDURE Encode*(i: INTEGER; OUT x: INTEGER);
VAR
	j: INTEGER;
	s,r: SET;
BEGIN
	s := BITS(i);j := MAX(SET);
	WHILE (j >= 0) & ~(j IN s) DO DEC(j) END;
	r := {};IF j >= 0 THEN INCL(r,j) END;
	WHILE j > 0 DO
		IF ((j IN s) & ~(j - 1 IN s)) OR (~(j IN s) & (j - 1 IN s)) THEN INCL(r,j-1) END;
		DEC(j)
	END;
	x := SYSTEM.VAL(INTEGER,r)
END Encode;

PROCEDURE Decode*(x: INTEGER; OUT i: INTEGER);
VAR
	j: INTEGER;
	s,r: SET;
BEGIN
	s := BITS(x);r:={};j := MAX(SET);
	WHILE (j >= 0) & ~(j IN s) DO DEC(j) END;
	IF j >= 0 THEN INCL(r,j) END;
	WHILE j > 0 DO
		IF ((j IN r) & ~(j - 1 IN s)) OR (~(j IN r) & (j - 1 IN s)) THEN INCL(r,j-1) END;
		DEC(j)
	END;
	i := SYSTEM.VAL(INTEGER,r);
END Decode;

PROCEDURE Do*;
VAR
	grayCode,binCode: INTEGER;
	i: INTEGER;
BEGIN
	StdLog.String(" i ");StdLog.String("     bin code    ");StdLog.String("   gray code    ");StdLog.Ln;
	StdLog.String("---");StdLog.String(" ----------------");StdLog.String(" ---------------");StdLog.Ln;
	FOR i := 0 TO 32 DO;
		Encode(i,grayCode);Decode(grayCode,binCode);
		StdLog.IntForm(i,10,3,' ',FALSE);
		StdLog.IntForm(binCode,2,16,' ',TRUE);
		StdLog.IntForm(grayCode,2,16,' ',TRUE);
		StdLog.Ln;
	END
END Do;

END GrayCodes.


CREATE TEMPORARY TABLE factors(n INT);
INSERT INTO factors VALUES(2);
INSERT INTO factors VALUES(3);
INSERT INTO factors VALUES(5);

CREATE TEMPORARY TABLE hamming AS
    WITH RECURSIVE ham AS (
          SELECT 1 AS h
          UNION
          SELECT h*n x FROM ham JOIN factors ORDER BY x
          LIMIT 1700
        )
    SELECT h FROM ham;

sqlite> SELECT h FROM hamming ORDER BY h LIMIT 20;
1
2
3
4
5
6
8
9
10
12
15
16
18
20
24
25
27
30
32
36
sqlite> SELECT h FROM hamming ORDER BY h LIMIT 1 OFFSET 1690;
2125764000


let maxsubseq s =
    let (_, _, maxsum, maxseq) =
        List.fold (fun (sum, seq, maxsum, maxseq) x ->
            let (sum, seq) = (sum + x, x :: seq)
            if sum < 0 then (0, [], maxsum, maxseq)
            else if sum > maxsum then (sum, seq, sum, seq)
            else (sum, seq, maxsum, maxseq))
            (0, [], 0, []) s
    List.rev maxseq

printfn "%A" (maxsubseq  [-1 ; -2 ; 3 ; 5 ; 6 ; -2 ; -1 ; 4; -4 ; 2 ; -1])


USING: kernel locals math math.order sequences ;

:: max-with-index ( elt0 ind0 elt1 ind1 -- elt ind )
elt0 elt1 <  [ elt1 ind1 ] [ elt0 ind0 ] if ;
: last-of-max ( accseq -- ind ) -1 swap -1 [ max-with-index ] reduce-index nip ;

: max-subseq ( seq -- subseq )
dup 0 [ + 0 max ] accumulate swap suffix last-of-max head
dup 0 [ + ] accumulate swap suffix [ neg ] map last-of-max tail ;


-module(ros_bitmap).

-export([new/2, fill/2, set_pixel/3, get_pixel/2, convert/2]).

-record(bitmap, {
    mode = rgb,
    pixels = nil,
    shape = {0, 0}
  }).

tuple_to_bytes({rgb, R, G, B}) ->
  <<R:8, G:8, B:8>>;
tuple_to_bytes({gray, L}) ->
  <<L:8>>.

bytes_to_tuple(rgb, Bytes) ->
  <<R:8, G:8, B:8>> = Bytes,
  {rgb, R, G, B};
bytes_to_tuple(gray, Bytes) ->
  <<L:8>> = Bytes,
  {gray, L}.

new(Width, Height) ->
  new(Width, Height, {rgb, 0, 0, 0}).

new(Width, Height, rgb) ->
  new(Width, Height, {rgb, 0, 0, 0});

new(Width, Height, gray) ->
  new(Width, Height, {gray, 0, 0, 0});

new(Width, Height, ColorTuple) when is_tuple(ColorTuple) ->
  [Mode|Components] = tuple_to_list(ColorTuple),
  Bytes = list_to_binary(Components),
  #bitmap{
    pixels=array:new(Width * Height, {default, Bytes}),
    shape={Width, Height},
    mode=Mode}.

fill(#bitmap{shape={Width, Height}, mode=Mode}, ColorTuple)
    when element(1, ColorTuple) =:= Mode ->
  new(Width, Height, ColorTuple).

set_pixel(#bitmap{pixels=Pixels, shape={Width, _Height}, mode=Mode}=Bitmap,
    {at, X, Y}, ColorTuple) when  element(1, ColorTuple) =:= Mode ->
  Index = X + Y * Width,
  Bitmap#bitmap{pixels=array:set(Index, tuple_to_bytes(ColorTuple), Pixels)}.

get_pixel(#bitmap{pixels=Pixels, shape={Width, _Height}, mode=Mode},
    {at, X, Y}) ->
  Index = X + Y * Width,
  Bytes = array:get(Index, Pixels),
  bytes_to_tuple(Mode, Bytes).

luminance(<<R:8, G:8, B:8>>) ->
  <<(trunc(R * 0.2126 + G * 0.7152 + B * 0.0722))>>.

%% convert from rgb to grayscale
convert(#bitmap{pixels=Pixels, mode=rgb}=Bitmap, gray) ->
  Bitmap#bitmap{
    pixels=array:map(fun(_I, Pixel) ->
          luminance(Pixel) end, Pixels),
    mode=gray};

%% convert from grayscale to rgb
convert(#bitmap{pixels=Pixels, mode=gray}=Bitmap, rgb)->
  Bitmap#bitmap{
    pixels=array:map(fun(_I, <<L:8>>) -> <<L:8, L:8, L:8>> end, Pixels),
    mode=rgb};

%% no conversion if the mode is the same with the bitmap.
convert(#bitmap{mode=Mode}=Bitmap, Mode) ->
  Bitmap.


$ awk 'func max(a){for(i in a)if(a[i]>r)r=a[i];return r}BEGIN{a[0]=42;a[1]=33;a[2]=21;print max(a)}'
42


Lbl MAX
0→M
While {r₁}
 {r₁}>M?{r₁}→M
End
M
Return


def gray_encode(bin)
  bin ^ (bin >> 1)
end

def gray_decode(gray)
  bin = gray
  while gray > 0
    gray >>= 1
    bin ^= gray
  end
  bin
end


uint grayEncode(in uint n) pure nothrow @nogc {
    return n ^ (n >> 1);
}

uint grayDecode(uint n) pure nothrow @nogc {
    auto p = n;
    while (n >>= 1)
        p ^= n;
    return p;
}

void main() {
    import std.stdio;

    " N     N2      enc     dec2 dec".writeln;
    foreach (immutable n; 0 .. 32) {
        immutable g = n.grayEncode;
        immutable d = g.grayDecode;
        writefln("%2d: %5b => %5b => %5b: %2d", n, n, g, d, d);
        assert(d == n);
    }
}


program GrayCode;

{$APPTYPE CONSOLE}

uses SysUtils;

function Encode(v: Integer): Integer;
begin
  Result := v xor (v shr 1);
end;

function Decode(v: Integer): Integer;
begin
  Result := 0;
  while v > 0 do
  begin
    Result := Result xor v;
    v := v shr 1;
  end;
end;

function IntToBin(aValue: LongInt; aDigits: Integer): string;
begin
  Result := StringOfChar('0', aDigits);
  while aValue > 0 do
  begin
    if (aValue and 1) = 1 then
      Result[aDigits] := '1';
    Dec(aDigits);
    aValue := aValue shr 1;
  end;
end;

var
  i, g, d: Integer;
begin
  Writeln('decimal  binary   gray    decoded');

  for i := 0 to 31 do
  begin
    g := Encode(i);
    d := Decode(g);
    Writeln(Format('  %2d     %s   %s   %s  %2d', [i, IntToBin(i, 5), IntToBin(g, 5), IntToBin(d, 5), d]));
  end;
end.


package require Tcl 8.6

# Simple helper: Tcl-style list "map"
proc map {varName list script} {
    set l {}
    upvar 1 $varName v
    foreach v $list {lappend l [uplevel 1 $script]}
    return $l
}

# The core of a coroutine to compute the product of a hamming sequence.
#
# Tricky bit: we don't automatically advance to the next value, and instead
# wait to be told that the value has been consumed (i.e., is the result of
# the [yield] operation).
proc ham {key multiplier} {
    global hammingCache
    set i 0
    yield [info coroutine]
    # Cannot use [foreach]; that would take a snapshot of the list in
    # the hammingCache variable, so missing updates.
    while 1 {
	set n [expr {[lindex $hammingCache($key) $i] * $multiplier}]
	# If the number selected was ours, we advance to compute the next
	if {[yield $n] == $n} {
	    incr i
	}
    }
}

# This coroutine computes the hamming sequence given a list of multipliers.
# It uses the [ham] helper from above to generate indivdual multiplied
# sequences. The key into the cache is the list of multipliers.
#
# Note that it is advisable for the values to be all co-prime wrt each other.
proc hammingCore args {
    global hammingCache
    set hammingCache($args) 1
    set hammers [map x $args {coroutine ham$x,$args ham $args $x}]
    yield
    while 1 {
	set n [lindex $hammingCache($args) [incr i]-1]
	lappend hammingCache($args) \
	    [tcl::mathfunc::min {*}[map h $hammers {$h $n}]]
	yield $n
    }
}

# Assemble the pieces so as to compute the classic hamming sequence.
coroutine hamming hammingCore 2 3 5
# Print the first 20 values of the sequence
for {set i 1} {$i <= 20} {incr i} {
    puts [format "hamming\[%d\] = %d" $i [hamming]]
}
for {} {$i <= 1690} {incr i} {set h [hamming]}
puts "hamming{1690} = $h"
for {} {$i <= 1000000} {incr i} {set h [hamming]}
puts "hamming{1000000} = $h"


2variable best
variable best-sum

: sum ( array len -- sum )
  0 -rot cells over + swap do i @ + cell +loop ;

: max-sub ( array len -- sub len )
  over 0 best 2!  0 best-sum !
  dup 1 do                  \ foreach length
    2dup i - 1+ cells over + swap do   \ foreach start
      i j sum
      dup best-sum @ > if
        best-sum !
        i j best 2!
      else drop then
    cell +loop
  loop
  2drop best [email protected] ;

: .array  ." [" dup 0 ?do over i cells + @ . loop ." ] = " sum . ;

create test  -1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , -1 ,
create test2 -1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , 99 ,


program MaxSubSeq
  implicit none

  integer, parameter :: an = 11
  integer, dimension(an) :: a = (/ -1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1 /)

  integer, dimension(an,an) :: mix
  integer :: i, j
  integer, dimension(2) :: m

  forall(i=1:an,j=1:an) mix(i,j) = sum(a(i:j))
  m = maxloc(mix)
  ! a(m(1):m(2)) is the wanted subsequence
  print *, a(m(1):m(2))

end program MaxSubSeq


DECLARE SUB addVal (value AS INTEGER)
DECLARE FUNCTION findMax% ()

REDIM SHARED vals(0) AS INTEGER
DIM SHARED valCount AS INTEGER
DIM x AS INTEGER, y AS INTEGER

valCount = -1

'''''begin test run
RANDOMIZE TIMER
FOR x = 1 TO 10
    y = INT(RND * 100)
    addVal y
    PRINT y; " ";
NEXT
PRINT ": "; findMax
'''''end test run

SUB addVal (value AS INTEGER)
    DIM tmp AS INTEGER
    IF valCount > -1 THEN
        'this is needed for BASICs that don't support REDIM PRESERVE
        REDIM v2(valCount) AS INTEGER
        FOR tmp = 0 TO valCount
            v2(tmp) = vals(tmp)
        NEXT
    END IF
    valCount = valCount + 1
    REDIM vals(valCount)
    IF valCount > 0 THEN
        'also needed for BASICs that don't support REDIM PRESERVE
        FOR tmp = 0 TO valCount - 1
            vals(tmp) = v2(tmp)
        NEXT
    END IF
    vals(valCount) = value
END SUB

FUNCTION findMax%
    DIM tmp1 AS INTEGER, tmp2 AS INTEGER
    FOR tmp1 = 0 TO valCount
        IF vals(tmp1) > tmp2 THEN tmp2 = vals(tmp1)
    NEXT
    findMax = tmp2
END FUNCTION


function Encode(v : Integer) : Integer;
begin
   Result := v xor (v shr 1);
end;

function Decode(v : Integer) : Integer;
begin
   Result := 0;
   while v>0 do begin
      Result := Result xor v;
	  v := v shr 1;
   end;
end;

PrintLn('decimal  binary   gray    decoded');

var i : Integer;
for i:=0 to 31 do begin
   var g := Encode(i);
   var d := Decode(g);
   PrintLn(Format('  %2d     %s   %s   %s  %2d',
                  [i, IntToBin(i, 5), IntToBin(g, 5), IntToBin(d, 5), d]));
end;


defmodule Gray_code do
  use Bitwise
  def encode(n), do: bxor(n, bsr(n,1))

  def decode(g), do: decode(g,0)

  def decode(0,n), do: n
  def decode(g,n), do: decode(bsr(g,1), bxor(g,n))
end

Enum.each(0..31, fn(n) ->
  g = Gray_code.encode(n)
  d = Gray_code.decode(g)
  :io.fwrite("~2B : ~5.2.0B : ~5.2.0B : ~5.2.0B : ~2B~n", [n, n, g, d, d])
end)


For H = 1 To 20
  Print "H("; H; ") = "; Func (_FnHamming(H))
Next

End

_FnHamming Param (1)
  @(0) = 1

  X = 2 : Y = 3 : Z = 5
  I = 0 : J = 0 : K = 0

  For N = 1 To [email protected] - 1
    M = X
    If M > Y Then M = Y
    If M > Z Then M = Z
    @(N) = M

    If M = X Then I = I + 1 : X = 2 * @(I)
    If M = Y Then J = J + 1 : Y = 3 * @(J)
    If M = Z Then K = K + 1 : Z = 5 * @(K)
  Next

Return (@([email protected]))


' FB 1.05.0 Win64

Dim As Integer seq(10) = {-1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , -1}
Dim As Integer i, j, sum, maxSum, first, last

maxSum = 0

For i = LBound(seq) To UBound(seq)
  sum = 0
  For j = i To UBound(seq)
    ' only proper sub-sequences are considered
    If i = LBound(seq) AndAlso j = UBound(seq) Then Exit For
    sum += seq(j)
    If sum > maxSum Then
      maxSum = sum
      first = i
      last = j
    End If
  Next j
Next i

If maxSum > 0 Then
  Print "Maximum subsequence is from indices"; first; " to"; last
  Print "Elements are : ";
  For i = first To last
    Print seq(i); " ";
  Next
  Print
  Print "Sum is"; maxSum
Else
  Print "Maximum subsequence is the empty sequence which has a sum of 0"
End If

Print
Print "Press any key to quit"
Sleep


package main

import "fmt"

func gss(s []int) ([]int, int) {
    var best, start, end, sum, sumStart int
    for i, x := range s {
        sum += x
        switch {
        case sum > best:
            best = sum
            start = sumStart
            end = i + 1
        case sum < 0:
            sum = 0
            sumStart = i + 1
        }
    }
    return s[start:end], best
}

var testCases = [][]int{
    {-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1},
    {-1, 1, 2, -5, -6},
    {},
    {-1, -2, -1},
}

func main() {
    for _, c := range testCases {
        fmt.Println("Input:  ", c)
        subSeq, sum := gss(c)
        fmt.Println("Sub seq:", subSeq)
        fmt.Println("Sum:    ", sum, "\n")
    }
}


>A=loadrgb("mona.jpg");
>insrgb(A);
>function grayscale (A) ...
${r,g,b}=getrgb(A);
$c=0.2126*r+0.7152*g+0.0722*b;
$return rgb(c,c,c);
$endfunction
>insrgb(grayscale(A));
>insrgb(A|grayscale(A));


function to_gray(sequence image)
    sequence color
    for i = 1 to length(image) do
        for j = 1 to length(image[i]) do
            color = and_bits(image[i][j], {#FF0000,#FF00,#FF}) /
                                          {#010000,#0100,#01} -- unpack color triple
            image[i][j] = floor(0.2126*color[1] + 0.7152*color[2] + 0.0722*color[3])
        end for
    end for
    return image
end function

function to_color(sequence image)
    for i = 1 to length(image) do
        for j = 1 to length(image[i]) do
            image[i][j] = image[i][j]*#010101
        end for
    end for
    return image
end function


USING: arrays kernel math math.matrices math.vectors ;

: rgb>gray ( matrix -- new-matrix )
    [ { 0.2126 0.7152 0.0722 } vdot >integer ] matrix-map ;

: gray>rgb ( matrix -- new-matrix )
    [ dup dup 3array ] matrix-map ;


DIM colored = ".\LenaClr.bmp", grayscale = ".\LenaGry.bmp"
DIM head, tail, r, g, b, l, ptr, blobsize = 54 ' sizeof BMP file headers

FILEGET(FILEOPEN(colored, BINARY), FILELEN(colored)): FILECLOSE(FILEOPEN) ' load buffer
head = @FILEGET + blobsize: tail = @FILEGET + FILELEN ' set loop bounds

FOR ptr = head TO tail STEP 3 ' transform color triplets
	b = PEEK(ptr + 0, 1) ' read Windows colors stored in BGR order
	g = PEEK(ptr + 1, 1)
	r = PEEK(ptr + 2, 1)
	l = 0.2126 * r + 0.7152 * g + 0.0722 * b ' derive luminance
	SETMEM(FILEGET, RGB(l, l, l), ptr - head + blobsize, 3) ' write grayscale
NEXT

FILEPUT(FILEOPEN(grayscale, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' save buffer


#!/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 );
  }


l$ = "1,1234,62,234,12,34,6"
dim n$(1)
n$ = explode(l$, ",")
m$ = "" : m = 0

for i = 1 to n$[?]-1
	t$ = n$[i]
	if t$ > m$ then m$ = t$
	if int(t$) > m then m = int(t$)
next i

print "Alphabetic order: "; m$; ", numeric order: "; m


::max.cmd
@echo off
setlocal enabledelayedexpansion
set a=.%~1
if "%a%" equ "." set /p a="Input stream: "
call :max res %a%
echo %res%
endlocal
goto :eof

:max
set %1=%2
:loop
shift /2
if "%2" equ "" goto :eof
if %2 gtr !%1! set res=%2
goto loop


-module(gray).
-export([encode/1, decode/1]).

encode(N) -> N bxor (N bsr 1).

decode(G) -> decode(G,0).

decode(0,N) -> N;
decode(G,N) -> decode(G bsr 1, G bxor N).


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

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

function dcb(integer n)
    atom d,m
    d = 0
    m = 1
    while n do
        d += remainder(n,2)*m
        n = floor(n/2)
        m *= 10
    end while
    return d
end function

integer j
for i = #0 to #1F do
    printf(1,"%05d => ",dcb(i))
    j = gray_encode(i)
    printf(1,"%05d => ",dcb(j))
    j = gray_decode(j)
    printf(1,"%05d\n",dcb(j))
end for


typeset -a hamming=(1)
function nextHamming {
    typeset -Sa q2 q3 q5
    integer h=${hamming[${#hamming[@]}-1]}
    q2+=( $(( h*2 )) )
    q3+=( $(( h*3 )) )
    q5+=( $(( h*5 )) )
    h=$( min3 ${q2[0]} ${q3[0]} ${q5[0]} )
    (( ${q2[0]} == h )) && ashift q2 >/dev/null
    (( ${q3[0]} == h )) && ashift q3 >/dev/null
    (( ${q5[0]} == h )) && ashift q5 >/dev/null
    hamming+=($h)
}

function ashift {
    nameref ary=$1
    print -- "${ary[0]}"
    ary=( "${ary[@]:1}" )
}

function min3 {
    if (( $1 < $2 )); then
        (( $1 < $3 )) && print -- $1 || print -- $3
    else
        (( $2 < $3 )) && print -- $2 || print -- $3
    fi
}

for ((i=1; i<=20; i++)); do
    nextHamming
    printf "%d\t%d\n" $i ${hamming[i-1]}
done
for ((; i<=1690; i++)); do nextHamming; done
nextHamming
printf "%d\t%d\n" $i ${hamming[i-1]}
print "elapsed: $SECONDS"


import Data.List (inits, tails, maximumBy)
import Data.Ord (comparing)

subseqs :: [a] -> [[a]]
subseqs = concatMap inits . tails

maxsubseq :: (Ord a, Num a) => [a] -> [a]
maxsubseq = maximumBy (comparing sum) . subseqs

main = print $ maxsubseq [-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1]


procedure main()
L1 := [-1,-2,3,5,6,-2,-1,4,-4,2,-1]     # sample list
L  := [-1,1,2,3,4,-11]|||L1             # prepend a local maximum into the mix
write(ximage(maxsubseq(L)))
end

link ximage      # to show lists

procedure maxsubseq(L)                    #: return the subsequence of L with maximum positive sum
local i,maxglobal,maxglobalI,maxlocal,maxlocalI

maxglobal := maxlocal := 0                                           # global and local maxima

every i := 1 to *L do  {
   if (maxlocal := max(maxlocal +L[i],0)) > 0 then
      if /maxlocalI then maxlocalI := [i,i] else maxlocalI[2] := i   # local maxima subscripts
   else maxlocalI := &null                                           # reset subsequence
   if maxglobal <:= maxlocal then                                    # global maxima
      maxglobalI := copy(maxlocalI)
   }
return L[(\maxglobalI)[1]:maxglobalI[2]] | []                        # return sub-sequence or empty list
end


\ grayscale bitmap (without word-alignment for scan lines)

\ bdim, bwidth, bdata all work with graymaps

: graymap ( w h -- gmp )
  2dup * bdata allocate throw
  dup >r 2! r> ;

: gxy ( x y gmp -- addr )
  dup bwidth rot * rot + swap bdata + ;

: [email protected] ( x y gmp -- c ) gxy [email protected] ;
: g! ( c x y bmp -- ) gxy c! ;

: gfill ( c gmp -- )
  dup bdata swap bdim * rot fill ;

: gshow ( gmp -- )
  dup bdim
  0 do cr
    dup 0 do
      over i j rot [email protected] if [char] * emit else space then
    loop
  loop
  2drop ;

\ RGB <-> Grayscale
: lum>rgb ( 0..255 -- pixel )
   dup 8 lshift or
   dup 8 lshift or ;

: pixel>rgb ( pixel -- r g b )
  256 /mod 256 /mod ;
: rgb>lum ( pixel -- 0..255 )
  pixel>rgb
   722 *   swap
  7152 * + swap
  2126 * + 10000 / ;

: bitmap>graymap ( bmp -- gmp )
  dup bdim graymap
  dup bdim nip 0 do
    dup bwidth 0 do
      over i j rot [email protected] rgb>lum
      over i j rot g!
    loop
  loop nip ;

: graymap>bitmap ( gmp -- bmp )
  dup bdim bitmap
  dup bdim nip 0 do
    dup bwidth 0 do
      over i j rot [email protected] lum>rgb
      over i j rot b!
    loop
  loop nip ;


type scimage
   integer, dimension(:,:), pointer :: channel
   integer :: width, height
end type scimage


Dim As Integer ancho = 143, alto = 188, x, y, p, red, green, blue, luminancia
Dim As String imagen = "Mona_Lisa.bmp"
Screenres ancho,alto,32
Bload imagen

For x = 0 To ancho-1
    For y = 0 To alto-1
        p = Point(x,y)
        red = p Mod 256
        p = p \ 256
        green = p Mod 256
        p = p \ 256
        blue = p Mod 256
        luminancia = 0.2126*red + 0.7152*green + 0.0722*blue
        Pset(x,y), Rgb(luminancia,luminancia,luminancia)
    Next y
Next x

Bsave "Grey_"+imagen+".bmp",0
Sleep


      ListOfValues$ = "13, 0, -6, 2, 37, -10, 12"
      PRINT "Maximum value = " ; FNmax(ListOfValues$)
      END

      DEF FNmax(list$)
      LOCAL index%, number, max
      max = VAL(list$)
      REPEAT
        index% = INSTR(list$, ",", index%+1)
        number = VAL(MID$(list$, index%+1))
        IF number > max THEN max = number
      UNTIL index% = 0
      = max


define m(a[], n) {
    auto m, i

    m = a[0]
    for (i = 1; i < n; i++) {
        if (a[i] > m) m = a[i]
    }
    return(m)
}


// Functıons to translate bınary to grey code and vv. Nigel Galloway: December 7th., 2018
let grayCode,invGrayCode=let fN g (n:uint8)=n^^^(n>>>g) in ((fN 1),(fN 1>>fN 2>>fN 4))


USING: math.ranges locals ;
IN: rosetta-gray

: gray-encode ( n -- n' ) dup -1 shift bitxor ;

:: gray-decode ( n! -- n' )
   n :> p!
   [ n -1 shift dup n! 0 = not ] [
     p n bitxor p!
   ] while
   p ;

: main ( -- )
  -1 32 [a,b] [ dup [ >bin ] [ gray-encode ] bi [ >bin ] [ gray-decode ] bi 4array . ] each ;

MAIN: main


: >gray ( n -- n' ) dup 2/ xor ;   \ n' = n xor (n logically right shifted 1 time)
                                               \ 2/ is Forth divide by 2, ie: shift right 1
: gray> ( n -- n )
  0  1 31 lshift  ( -- g b mask )
  begin
    >r                                        \ save a copy of mask on return stack
     2dup 2/ xor
     [email protected] and or
     r> 1 rshift
     dup 0=
  until
  drop nip ;                                  \ clean the parameter stack leaving result only

: test
  2 base !                                    \ set system number base to 2. ie: Binary
  32 0 do
    cr I  dup 5 .r ."  ==> "                  \ print numbers (binary) right justified 5 places
    >gray dup 5 .r ."  ==> "
    gray>     5 .r
  loop
  decimal ;                                   \ revert to BASE 10


      PROGRAM GRAY
      IMPLICIT NONE
      INTEGER IGRAY,I,J,K
      CHARACTER*5 A,B,C
      DO 10 I=0,31
      J=IGRAY(I,1)
      K=IGRAY(J,-1)
      CALL BINARY(A,I,5)
      CALL BINARY(B,J,5)
      CALL BINARY(C,K,5)
      PRINT 99,I,A,B,C,K
   10 CONTINUE
   99 FORMAT(I2,3H : ,A5,4H => ,A5,4H => ,A5,3H : ,I2)
      END

      FUNCTION IGRAY(N,D)
      IMPLICIT NONE
      INTEGER D,K,N,IGRAY
      IF(D.LT.0) GO TO 10
      IGRAY=IEOR(N,ISHFT(N,-1))
      RETURN
   10 K=N
      IGRAY=0
   20 IGRAY=IEOR(IGRAY,K)
      K=K/2
      IF(K.NE.0) GO TO 20
      END

      SUBROUTINE BINARY(S,N,K)
      IMPLICIT NONE
      INTEGER I,K,L,N
      CHARACTER*(*) S
      L=LEN(S)
      DO 10 I=0,K-1
C The following line may replace the next block-if,
C on machines using ASCII code :
C     S(L-I:L-I)=CHAR(48+IAND(1,ISHFT(N,-I)))
C On EBCDIC machines, use 240 instead of 48.
      IF(BTEST(N,I)) THEN
      S(L-I:L-I)='1'
      ELSE
      S(L-I:L-I)='0'
      END IF
   10 CONTINUE
      S(1:L-K)=''
      END


#import std
#import nat

smooth"p" "n" = ~&z take/"n" nleq-< (rep(length "n") ^Ts/~& product*K0/"p") <1>


100 PROGRAM "Subseq.bas"
110 RANDOMIZE
120 NUMERIC A(1 TO 15)
130 PRINT "Sequence:"
140 FOR I=LBOUND(A) TO UBOUND(A)
150   LET A(I)=RND(11)-6
160   PRINT A(I);
170 NEXT
180 LET MAXSUM,ST=0:LET EN=-1
190 FOR I=LBOUND(A) TO UBOUND(A)
200   LET SUM=0
210   FOR J=I TO UBOUND(A)
220     LET SUM=SUM+A(J)
230     IF SUM>MAXSUM THEN LET MAXSUM=SUM:LET ST=I:LET EN=J
240   NEXT
250 NEXT
260 PRINT :PRINT "SubSequence with greatest sum:"
270 IF ST>0 THEN PRINT TAB(ST*3-2);
280 FOR I=ST TO EN
290   PRINT A(I);
300 NEXT
310 PRINT :PRINT "Sum:";MAXSUM


maxss=: monad define
 AS =. 0,; <:/[email protected]&.> #\y
 MX =. (= >./) AS +/ . * y
 y #~ {. MX#AS
)


package raster

import (
    "math"
    "math/rand"
)

// Grmap parallels Bitmap, but with an element type of uint16
// in place of Pixel.
type Grmap struct {
    Comments   []string
    rows, cols int
    px         []uint16
    pxRow      [][]uint16
}

// NewGrmap constructor.
func NewGrmap(x, y int) (b *Grmap) {
    g := &Grmap{
        Comments: []string{creator}, // creator a const in bitmap source file
        rows:     y,
        cols:     x,
        px:       make([]uint16, x*y),
        pxRow:    make([][]uint16, y),
    }
    x0, x1 := 0, x
    for i := range g.pxRow {
        g.pxRow[i] = g.px[x0:x1]
        x0, x1 = x1, x1+x
    }
    return g
}

func (b *Grmap) Extent() (cols, rows int) {
    return b.cols, b.rows
}

func (g *Grmap) Fill(c uint16) {
    for i := range g.px {
        g.px[i] = c
    }
}

func (g *Grmap) SetPx(x, y int, c uint16) bool {
    defer func() { recover() }()
    g.pxRow[y][x] = c
    return true
}

func (g *Grmap) GetPx(x, y int) (uint16, bool) {
    defer func() { recover() }()
    return g.pxRow[y][x], true
}

// Grmap method of Bitmap, converts (color) Bitmap to (grayscale) Grmap
func (b *Bitmap) Grmap() *Grmap {
    g := NewGrmap(b.cols, b.rows)
    g.Comments = append([]string{}, b.Comments...)
    for i, p := range b.px {
        g.px[i] = uint16((int64(p.R)*2126 + int64(p.G)*7152 + int64(p.B)*722) *
            math.MaxUint16 / (math.MaxUint8 * 10000))
    }
    return g
}

// Bitmap method Grmap, converts Grmap to Bitmap.  All pixels in the resulting
// color Bitmap will be (very nearly) shades of gray.
func (g *Grmap) Bitmap() *Bitmap {
    b := NewBitmap(g.cols, g.rows)
    b.Comments = append([]string{}, g.Comments...)
    for i, p := range g.px {
        roundedSum := int(p) * 3 * math.MaxUint8 / math.MaxUint16
        rounded := uint8(roundedSum / 3)
        remainder := roundedSum % 3
        b.px[i].R = rounded
        b.px[i].G = rounded
        b.px[i].B = rounded
        if remainder > 0 {
            odd := rand.Intn(3)
            switch odd + (remainder * 3) {
            case 3:
                b.px[i].R++
            case 4:
                b.px[i].G++
            case 5:
                b.px[i].B++
            case 6:
                b.px[i].G++
                b.px[i].B++
            case 7:
                b.px[i].R++
                b.px[i].B++
            case 8:
                b.px[i].R++
                b.px[i].G++
            }
        }
    }
    return b
}


#!/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 );
  }


max = { list |
  list.reduce { n, max |
    true? n > max
      { max = n }
      { max }
  }
}

p max [3 4 1 2]


' version 18-01-2017
' compile with: fbc -s console

Function gray2bin(g As UInteger) As UInteger

    Dim As UInteger b = g

    While g
        g Shr= 1
        b Xor= g
    Wend

    Return b

End Function

Function bin2gray(b As UInteger) As UInteger

    Return b Xor (b Shr 1)

End Function

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

Dim As UInteger i

Print " i     binary     gray   gra2bin"
Print String(32,"=")

For i = 0 To 31
    Print Using "## --> "; i;
    print Bin(i,5); " --> ";
    Print Bin(bin2gray(i),5); " --> ";
    Print Bin(gray2bin(bin2gray(i)),5)
Next

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


for i=0 to 31
{
   gray = binaryToGray[i]
   back = grayToBinary[gray]
   println[(i->binary) + "\t" + (gray->binary) + "\t" + (back->binary)]
}


package main

import "fmt"

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

func dec(g int) (b int) {
    for ; g != 0; g >>= 1 {
        b ^= g
    }
    return
}

func main() {
    fmt.Println("decimal  binary   gray    decoded")
    for b := 0; b < 32; b++ {
        g := enc(b)
        d := dec(g)
        fmt.Printf("  %2d     %05b   %05b   %05b  %2d\n", b, b, g, d, d)
    }
}


'RosettaCode Hamming numbers
'This is a well known hard problem in number theory:
'counting the number of lattice points in a
'n-dimensional tetrahedron, here n=3.
Public a As Double, b As Double, c As Double, d As Double
Public p As Double, q As Double, r As Double
Public cnt() As Integer 'stores the number of lattice points indexed on the exponents of 3 and 5
Public hn(2) As Integer 'stores the exponents of 2, 3 and 5
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Function log10(x As Double) As Double
    log10 = WorksheetFunction.log10(x)
End Function
Private Function pow(x As Variant, y As Variant) As Double
    pow = WorksheetFunction.Power(x, y)
End Function
Private Sub init(N As Long)
    'Computes a, b and c as the vertices
    '(a,0,0), (0,b,0), (0,0,c) of a tetrahedron
    'with apex (0,0,0) and volume N
    'volume N=a*b*c/6
    Dim k As Double
    k = log10(2) * log10(3) * log10(5) * 6 * N
    k = pow(k, 1 / 3)
    a = k / log10(2)
    b = k / log10(3)
    c = k / log10(5)
    p = -b * c
    q = -a * c
    r = -a * b
End Sub
Private Function x_given_y_z(y As Integer, z As Integer) As Double
    x_given_y_z = -(q * y + r * z + a * b * c) / p
End Function
Private Function cmp(i As Integer, j As Integer, k As Integer, gn() As Integer) As Boolean
    cmp = (i * log10(2) + j * log10(3) + k * log10(5)) > (gn(0) * log10(2) + gn(1) * log10(3) + gn(2) * log10(5))
End Function
Private Function count(N As Long, step As Integer) As Long
    'Loop over y and z, compute x and
    'count number of lattice points within tetrahedron.
    'Step 1 is indirectly called by find_seed to calibrate the plane through A, B and C
    'Step 2 fills the matrix cnt with the number of lattice points given the exponents of 3 and 5
    'Step 3 the plane is lowered marginally so one or two candidates stick out
    Dim M As Long, j As Integer, k As Integer
    If step = 2 Then ReDim cnt(0 To Int(b) + 1, 0 To Int(c) + 1)
    M = 0: j = 0: k = 0
    Do While -c * j - b * k + b * c > 0
        Do While -c * j - b * k + b * c > 0
            Select Case step
                Case 1: M = M + Int(x_given_y_z(j, k))
                Case 2
                    cnt(j, k) = Int(x_given_y_z(j, k))
                Case 3
                    If Int(x_given_y_z(j, k)) < cnt(j, k) Then
                        'This is a candidate, and ...
                        If cmp(cnt(j, k), j, k, hn) Then
                            'it is bigger dan what is already in hn
                            hn(0) = cnt(j, k)
                            hn(1) = j
                            hn(2) = k
                        End If
                    End If
            End Select
            k = k + 1
        Loop
        k = 0
        j = j + 1
    Loop
    count = M
End Function
Private Sub list_upto(ByVal N As Integer)
    Dim count As Integer
    count = 1
    Dim hn As Integer
    hn = 1
    Do While count < N
        k = hn
        Do While k Mod 2 = 0
            k = k / 2
        Loop
        Do While k Mod 3 = 0
            k = k / 3
        Loop
        Do While k Mod 5 = 0
            k = k / 5
        Loop
        If k = 1 Then
            Debug.Print hn; " ";
            count = count + 1
        End If
        hn = hn + 1
    Loop
    Debug.Print
End Sub
Private Function find_seed(N As Long, step As Integer) As Long
    Dim initial As Long, total As Long
    initial = N
    Do 'a simple iterative goal search, takes a handful iterations only
        init initial
        total = count(initial, step)
        initial = initial + N - total
    Loop Until total = N
    find_seed = initial
End Function
Private Sub find_hn(N As Long)
    Dim fs As Long, err As Long
    'Step 1: find fs such that the number of lattice points is exactly N
    fs = find_seed(N, 1)
    'Step 2: fill the matrix cnt
    init fs
    err = count(fs, 2)
    'Step 3: lower the plane by diminishing fs, the candidates for
    'the Nth Hamming number will stick out and be recorded in hn
    init fs - 1
    err = count(fs - 1, 3)
    Debug.Print "2^" & hn(0) - 1; " * 3^" & hn(1); " * 5^" & hn(2); "=";
    If N < 1692 Then
        'The task set a limit on the number size
        Debug.Print pow(2, hn(0) - 1) * pow(3, hn(1)) * pow(5, hn(2))
    Else
        Debug.Print
        If N <= 1000000 Then
            'The big Hamming Number will end in a lot of zeroes. The common exponents of 2 and 5
            'are split off to be printed separately.
            If hn(0) - 1 < hn(2) Then
                'Conversion to Decimal datatype with CDec allows to print numbers upto 10^28
                Debug.Print CDec(pow(3, hn(1))) * CDec(pow(5, hn(2) - hn(0) + 1)) & String$(hn(0) - 1, "0")
            Else
                Debug.Print CDec(pow(2, hn(0) - 1 - hn(2))) * CDec(pow(3, hn(1))) & String$(hn(2), "0")
            End If
        End If
    End If
End Sub
Public Sub main()
    Dim start_time As Long, finis_time As Long
    start_time = GetTickCount
    Debug.Print "The first twenty Hamming numbers are:"
    list_upto 20
    Debug.Print "Hamming number 1691 is: ";
    find_hn 1691
    Debug.Print "Hamming number 1000000 is: ";
    find_hn 1000000
    finis_time = GetTickCount
    Debug.Print "Execution time"; (finis_time - start_time); " milliseconds"
End Sub


import java.util.Scanner;
import java.util.ArrayList;

public class Sub{
    private static int[] indices;

    public static void main(String[] args){
        ArrayList<Long> array= new ArrayList<Long>(); //the main set
        Scanner in = new Scanner(System.in);
        while(in.hasNextLong()) array.add(in.nextLong());
        long highSum= Long.MIN_VALUE;//start the sum at the lowest possible value
        ArrayList<Long> highSet= new ArrayList<Long>();
        //loop through all possible subarray sizes including 0
        for(int subSize= 0;subSize<= array.size();subSize++){
            indices= new int[subSize];
            for(int i= 0;i< subSize;i++) indices[i]= i;
            do{
                long sum= 0;//this subarray sum variable
                ArrayList<Long> temp= new ArrayList<Long>();//this subarray
                //sum it and save it
                for(long index:indices) {sum+= array.get(index); temp.add(array.get(index));}
                if(sum > highSum){//if we found a higher sum
                    highSet= temp;    //keep track of it
                    highSum= sum;
                }
            }while(nextIndices(array));//while we haven't tested all subarrays
        }
        System.out.println("Sum: " + highSum + "\nSet: " +
        		highSet);
    }
    /**
     * Computes the next set of choices from the previous. The
     * algorithm tries to increment the index of the final choice
     * first. Should that fail (index goes out of bounds), it
     * tries to increment the next-to-the-last index, and resets
     * the last index to one more than the next-to-the-last.
     * Should this fail the algorithm keeps starting at an earlier
     * choice until it runs off the start of the choice list without
     * Finding a legal set of indices for all the choices.
     *
     * @return true unless all choice sets have been exhausted.
     * @author James Heliotis
     */

    private static boolean nextIndices(ArrayList<Long> a) {
        for(int i= indices.length-1;i >= 0;--i){
            indices[i]++;
            for(int j=i+1;j < indices.length;++j){
                indices[j]= indices[j - 1] + 1;//reset the last failed try
            }
            if(indices[indices.length - 1] < a.size()){//if this try went out of bounds
                return true;
            }
        }
        return false;
    }
}


module Bitmap.Gray(module Bitmap.Gray) where

import Bitmap
import Control.Monad.ST

newtype Gray = Gray Int deriving (Eq, Ord)

instance Color Gray where
    luminance (Gray x) = x
    black = Gray 0
    white = Gray 255
    toNetpbm = map $ toEnum . luminance
    fromNetpbm = map $ Gray . fromEnum
    netpbmMagicNumber _ = "P5"
    netpbmMaxval _ = "255"

toGrayImage :: Color c => Image s c -> ST s (Image s Gray)
toGrayImage = mapImage $ Gray . luminance


NB. converts the image to grayscale according to formula
NB. L = 0.2126*R + 0.7152*G + 0.0722*B
toGray=: [: <. +/ .*"1&0.2126 0.7152 0.0722

NB. converts grayscale image to the color image, with all channels equal
toColor=: 3 & $"0


void convertToGrayscale(final BufferedImage image){
    for(int i=0; i<image.getWidth(); i++){
        for(int j=0; j<image.getHeight(); j++){
            int color = image.getRGB(i,j);

            int alpha = (color >> 24) & 255;
            int red = (color >> 16) & 255;
            int green = (color >> 8) & 255;
            int blue = (color) & 255;

            final int lum = (int)(0.2126 * red + 0.7152 * green + 0.0722 * blue);

            alpha = (alpha << 24);
            red = (lum << 16);
            green = (lum << 8);
            blue = lum;

            color = alpha + red + green + blue;

            image.setRGB(i,j,color);
        }
    }
}


#include <assert.h>

float max(unsigned int count, float values[]) {
     assert(count > 0);
     size_t idx;
     float themax = values[0];
     for(idx = 1; idx < count; ++idx) {
          themax = values[idx] > themax ? values[idx] : themax;
     }
     return themax;
}


def grayEncode = { i ->
    i ^ (i >>> 1)
}

def grayDecode;
grayDecode = { int code ->
    if(code <= 0) return 0
    def h = grayDecode(code >>> 1)
    return (h << 1) + ((code ^ h) & 1)
}


import Data.Bits
import Data.Char
import Numeric
import Control.Monad
import Text.Printf

grayToBin :: (Integral t, Bits t) => t -> t
grayToBin 0 = 0
grayToBin g = g `xor` (grayToBin $ g `shiftR` 1)

binToGray :: (Integral t, Bits t) => t -> t
binToGray b = b `xor` (b `shiftR` 1)

showBinary :: (Integral t, Show t) => t -> String
showBinary n = showIntAtBase 2 intToDigit n ""

showGrayCode :: (Integral t, Bits t, PrintfArg t, Show t) => t -> IO ()
showGrayCode num = do
    let bin  = showBinary num
    let gray = showBinary (binToGray num)
    printf "int: %2d -> bin: %5s -> gray: %5s\n" num bin gray

main = forM_ [0..31::Int] showGrayCode


For h = 1 To 20
	WScript.StdOut.Write "H(" & h & ") = " & Hamming(h)
	WScript.StdOut.WriteLine
Next
WScript.StdOut.Write "H(" & 1691 & ") = " & Hamming(1691)
WScript.StdOut.WriteLine

Function Hamming(l)
	Dim h() : Redim h(l) : h(0) = 1
	i = 0 : j = 0 : k = 0
	x2 = 2 : x3 = 3 : x5 = 5
	For n = 1 To l-1
		m = x2
		If m > x3 Then m = x3 End If
		If m > x5 Then m = x5 End If
		h(n) = m
		If m = x2 Then i = i + 1 : x2 = 2 * h(i) End If
		If m = x3 Then j = j + 1 : x3 = 3 * h(j) End If
		If m = x5 Then k = k + 1 : x5 = 5 * h(k) End If
	Next
	Hamming = h(l-1)
End Function


function MaximumSubsequence(population) {
    var maxValue = 0;
    var subsequence = [];

    for (var i = 0, len = population.length; i < len; i++) {
        for (var j = i; j <= len; j++) {
            var subsequence = population.slice(i, j);
            var value = sumValues(subsequence);
            if (value > maxValue) {
                maxValue = value;
                greatest = subsequence;
            };
        }
    }

    return greatest;
}

function sumValues(arr) {
    var result = 0;
    for (var i = 0, len = arr.length; i < len; i++) {
        result += arr[i];
    }
    return result;
}


def subarray_sum:
  . as $arr
  | reduce range(0; length) as $i
      ( {"first": length, "last": 0, "curr": 0, "curr_first": 0, "max": 0};
        $arr[$i] as $e
        | (.curr + $e) as $curr
        | . + (if $e > $curr then {"curr": $e, "curr_first": $i} else {"curr": $curr} end)
        | if .curr > .max then . + {"max": $curr, "first": .curr_first, "last": $i}
          else .
          end)
  | [ .max, $arr[ .first : (1 + .last)] ];


function toGray(img) {
  let cnv = document.getElementById("canvas");
  let ctx = cnv.getContext('2d');
  let imgW = img.width;
  let imgH = img.height;
  cnv.width = imgW;
  cnv.height = imgH;

  ctx.drawImage(img, 0, 0);
  let pixels = ctx.getImageData(0, 0, imgW, imgH);
  for (let y = 0; y < pixels.height; y ++) {
    for (let x = 0; x < pixels.width; x ++) {
      let i = (y * 4) * pixels.width + x * 4;
      let avg = (pixels.data[i] + pixels.data[i + 1] + pixels.data[i + 2]) / 3;

      pixels.data[i] = avg;
      pixels.data[i + 1] = avg;
      pixels.data[i + 2] = avg;
    }
  }
  ctx.putImageData(pixels, 0, 0, 0, 0, pixels.width, pixels.height);
  return cnv.toDataURL();
}


using Color, Images, FixedPointNumbers

const M_RGB_Y = reshape(Color.M_RGB_XYZ[2,:], 3)

function rgb2gray(img::Image)
    g = red(img)*M_RGB_Y[1] + green(img)*M_RGB_Y[2] + blue(img)*M_RGB_Y[3]
    g = clamp(g, 0.0, 1.0)
    return grayim(g)
end

function gray2rgb(img::Image)
    colorspace(img) == "Gray" || return img
    g = map((x)->RGB{Ufixed8}(x, x, x), img.data)
    return Image(g, spatialorder=spatialorder(img))
end

ima = imread("grayscale_image_color.png")
imb = rgb2gray(ima)
imc = gray2rgb(imb)
imwrite(imc, "grayscale_image_rc.png")


// version 1.2.10

import java.io.File
import java.awt.image.BufferedImage
import javax.imageio.ImageIO

fun BufferedImage.toGrayScale() {
    for (x in 0 until width) {
        for (y in 0 until height) {
            var argb  = getRGB(x, y)
            val alpha = (argb shr 24) and 0xFF
            val red   = (argb shr 16) and 0xFF
            val green = (argb shr  8) and 0xFF
            val blue  =  argb and 0xFF
            val lumin = (0.2126 * red + 0.7152 * green + 0.0722 * blue).toInt()
            argb = (alpha shl 24) or (lumin shl 16) or (lumin shl 8) or lumin
            setRGB(x, y, argb)
        }
    }
}

fun main(args: Array<String>) {
    val image = ImageIO.read(File("bbc.jpg")) // using BBC BASIC image
    image.toGrayScale()
    val grayFile = File("bbc_gray.jpg")
    ImageIO.write(image, "jpg", grayFile)
}


#!/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 );
  }


#include <algorithm>  //std::max_element
#include <iterator>   //std::begin and std::end
#include <functional> //std::less

template<class It, class Comp = std::less<>>
    //requires ForwardIterator<It> && Compare<Comp>
constexpr auto max_value(It first, It last, Comp compare = std::less{})
{
    //Precondition: first != last
    return *std::max_element(first, last, compare);
}

template<class C, class Comp = std::less<>>
    //requires Container<C> && Compare<Comp>
constexpr auto max_value(const C& container, Comp compare = std::less{})
{
    //Precondition: !container.empty()
    using std::begin; using std::end;
    return max_value(begin(container), end(container), compare);
}


link bitint

procedure main()
    every write(right(i := 0 to 10,4),":",right(int2bit(i),10)," -> ",
                                          right(g := gEncode(i),10)," -> ",
                                          right(b := gDecode(g),10)," -> ",
                                          right(bit2int(b),10))
end

procedure gEncode(b)
    return int2bit(ixor(b, ishift(b,-1)))
end

procedure gDecode(g)
    b := g[1]
    every i := 2 to *g do b ||:= if g[i] == b[i-1] then "0" else "1"
    return b
end


public class Gray {
	public static long grayEncode(long n){
		return n ^ (n >>> 1);
	}

	public static long grayDecode(long n) {
		long p = n;
		while ((n >>>= 1) != 0)
			p ^= n;
		return p;
	}
	public static void main(String[] args){
		System.out.println("i\tBinary\tGray\tDecoded");
		for(int i = -1; i < 32;i++){
			System.out.print(i +"\t");
			System.out.print(Integer.toBinaryString(i) + "\t");
			System.out.print(Long.toBinaryString(grayEncode(i))+ "\t");
			System.out.println(grayDecode(grayEncode(i)));
		}
	}
}


import math.big

fn min(a big.Integer, b big.Integer) big.Integer {
    if a < b {
        return a
    }
    return b
}

fn hamming(n int) []big.Integer {
    mut h := []big.Integer{len: n}
    h[0] = big.one_int
    two, three, five    := big.two_int, big.integer_from_int(3), big.integer_from_int(5)
    mut next2, mut next3, mut next5 := big.two_int, big.integer_from_int(3), big.integer_from_int(5)
    mut i, mut j, mut k := 0, 0, 0
    for m in 1..h.len {
        h[m] = min(next2, min(next3, next5))
        if h[m] == next2 {
            i++
            next2 = two * h[i]
        }
        if h[m] == next3 {
            j++
            next3 = three * h[j]
        }
        if h[m] == next5 {
            k++
            next5 = five * h[k]
        }
    }
    return h
}

fn main() {
    h := hamming(int(1e6))
    println(h[..20])
    println(h[1691-1])
    println(h[h.len-1])
}


/* Greatest Subsequential Sum, in Jsish */
function sumValues(arr) {
    var result = 0;
    for (var i = 0, len = arr.length; i < len; i++) result += arr[i];
    return result;
}

function greatestSubsequentialSum(population:array):array {
    var maxValue = (population[0]) ? population[0] : 0;
    var subsequence = [], greatest = [];

    for (var i = 0, len = population.length; i < len; i++) {
        for (var j = i; j < len; j++) {
            subsequence = population.slice(i, j);
            var value = sumValues(subsequence);
            if (value > maxValue) {
                maxValue = value;
                greatest = subsequence;
            };
        }
    }

    return [maxValue, greatest];
}

if (Interp.conf('unitTest')) {
    var gss = [-1,-2,3,5,6,-2,-1,4,-4,2,-1];
;    gss;
;    greatestSubsequentialSum(gss);
}

/*
=!EXPECTSTART!=
gss ==> [ -1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1 ]
greatestSubsequentialSum(gss) ==> [ 15, [ 3, 5, 6, -2, -1, 4 ] ]
=!EXPECTEND!=
*/


nomainwin
WindowWidth = 400
WindowHeight = 400
open "Bitmap" for graphics_nf_nsb as #1
h=hwnd(#1)
calldll  #user32, "GetDC", h as ulong, DC as ulong
#1 "trapclose [q]"
loadbmp "clr","MLcolor.bmp"
#1 "drawbmp clr 1 1;flush"
for x = 1 to 150
    for y = 1 to 200
        calldll #gdi32, "GetPixel", DC as ulong, x as long, y as long, PX as ulong
        B = int(PX/(256*256))
        G = int((PX-B*256*256) / 256)
        R = int(PX-B*256*256-G*256)
        L = 0.2126*R+0.7152*G+0.0722*B
        #1 "down;color ";L;" ";L;" ";L;";set ";x;" ";y
    next y
next x
wait
[q] unloadbmp "clr":close #1:end


on rgbToGrayscaleImageFast (img)
  res = image(img.width, img.height, 8)
  res.paletteRef = #grayScale
  res.copyPixels(img, img.rect, img.rect)
  return res
end

on rgbToGrayscaleImageCustom (img)
  res = image(img.width, img.height, 8)
  res.paletteRef = #grayScale
  repeat with x = 0 to img.width-1
    repeat with y = 0 to img.height-1
      c = img.getPixel(x,y)
      n = c.red*0.2126 + c.green*0.7152 + c.blue*0.0722
      res.setPixel(x,y, color(256-n))
    end repeat
  end repeat
  return res
end


function ConvertToGrayscaleImage( bitmap )
    local size_x, size_y = #bitmap, #bitmap[1]
    local gray_im = {}

    for i = 1, size_x do
        gray_im[i] = {}
        for j = 1, size_y do
            gray_im[i][j] = math.floor( 0.2126*bitmap[i][j][1] + 0.7152*bitmap[i][j][2] + 0.0722*bitmap[i][j][3] )
        end
    end

    return gray_im
end

function ConvertToColorImage( gray_im )
    local size_x, size_y = #gray_im, #gray_im[1]
    local bitmap = Allocate_Bitmap( size_x, size_y )         -- this function is defined at http://rosettacode.org/wiki/Basic_bitmap_storage#Lua

    for i = 1, size_x do
        for j = 1, size_y do
            bitmap[i][j] = { gray_im[i][j], gray_im[i][j], gray_im[i][j] }
        end
    end

    return bitmap
end


bundle agent __main__
{
  vars:
      "number_of_list_elements"
        int => randomint( "0", 100 ),
        unless => isvariable( "$(this.promiser)" );

      "idx"
        slist => expandrange( "[0-$(number_of_list_elements)]", 1 ),
        unless => isvariable( "$(this.promiser)" );

      "number[$(idx)]"
        int => randomint( "0", "100" ),
        unless => isvariable( "$(this.promiser)" );

      "numbers" slist => sort( getvalues( number ), int );

  methods:
      "Get the greatest value"
        usebundle => greatest_value( @(numbers) ),
        useresult => "returned";

  reports:
      "'$(returned[max])' is the largest number in $(with)"
        with => join( ",", numbers );

}
bundle agent greatest_value(list_of_values)
{
   reports:
      "$(with)"
        with => max( list_of_values, int ),
        bundle_return_value_index => "max";
}


(max 1 2 3 4) ; evaluates to 4
;; If the values are already in a collection, use apply:
(apply max [1 2 3 4]) ; evaluates to 4


% This "maximum" procedure is fully general, as long as
% the container type has an elements iterator and the
% data type is comparable.
% It raises an exception ("empty") if there are no elements.

maximum = proc [T,U: type] (a: T) returns (U)
          signals (empty)
          where T has elements: itertype (T) yields (U),
                U has gt: proctype (U,U) returns (bool)
    max: U
    seen: bool := false

    for item: U in T$elements(a) do
        if ~seen cor item > max then
            max := item
            seen := true
        end
    end
    if (~seen) then
        signal empty
    else
        return(max)
    end
end maximum

start_up = proc ()
    po: stream := stream$primary_output()

    % try it on an array of ints
    ints: array[int] := array[int]$[1,5,17,2,53,99,61,3]
    imax: int := maximum[array[int], int](ints)
    stream$putl(po, "maximum int: " || int$unparse(imax))

    % try it on a sequence of reals
    reals: sequence[real] := sequence[real]$[-0.5, 2.6, 3.14, 2.72]
    rmax: real := maximum[sequence[real], real](reals)
    stream$putl(po, "maximum real: " || real$unparse(rmax))
end start_up


export function encode (number) {
    return number ^ (number >> 1)
}

export function decode (encodedNumber) {
    let number = encodedNumber

    while (encodedNumber >>= 1) {
        number ^= encodedNumber
    }

    return number
}


grayencode(n::Integer) = n ⊻ (n >> 1)
function graydecode(n::Integer)
    r = n
    while (n >>= 1) != 0
        r ⊻= n
    end
    return r
end


// version 1.0.6

object Gray {
    fun encode(n: Int) = n xor (n shr 1)

    fun decode(n: Int): Int {
        var p  = n
        var nn = n
        while (nn != 0) {
            nn = nn shr 1
            p = p xor nn
        }
        return p
    }
}

fun main(args: Array<String>) {
    println("Number\tBinary\tGray\tDecoded")
    for (i in 0..31) {
        print("$i\t${Integer.toBinaryString(i)}\t")
        val g = Gray.encode(i)
        println("${Integer.toBinaryString(g)}\t${Gray.decode(g)}")
    }
}


import "/big" for BigInt, BigInts

var primes = [2, 3, 5].map { |p| BigInt.new(p) }.toList

var hamming = Fn.new { |size|
    if (size < 1) Fiber.abort("size must be at least 1")
    var ns = List.filled(size, null)
    ns[0] = BigInt.one
    var next = primes.toList
    var indices = List.filled(3, 0)
    for (m in 1...size) {
        ns[m] = BigInts.min(next)
        for (i in 0..2) {
            if (ns[m] == next[i]) {
                indices[i] = indices[i] + 1
                next[i] = primes[i] * ns[indices[i]]
            }
        }
    }
    return ns
}

var h = hamming.call(1e6)
System.print("The first 20 Hamming numbers are:")
System.print(h[0..19])
System.print()
System.print("The 1,691st Hamming number is:")
System.print(h[1690])
System.print()
System.print("The 1,000,000th Hamming number is:")
System.print(h[999999])


function gss(arr::Vector{<:Number})
    smax = hmax = tmax = 0
    for head in eachindex(arr), tail in head:length(arr)
        s = sum(arr[head:tail])
        if s > smax
            smax = s
            hmax, tmax = head, tail
        end
    end
    return arr[hmax:tmax]
end

arr = [-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1]
subseq = gss(arr)
s = sum(subseq)

println("Greatest subsequential sum of $arr:\n → $subseq with sum $s")


// version 1.1

fun gss(seq: IntArray): Triple<Int, Int, Int> {
    if (seq.isEmpty()) throw IllegalArgumentException("Array cannot be empty")
    var sum: Int
    var maxSum = seq[0]
    var first = 0
    var last = 0
    for (i in 1 until seq.size) {
        sum = 0
        for (j in i until seq.size) {
            sum += seq[j]
            if (sum > maxSum) {
                maxSum = sum
                first = i
                last = j
            }
        }
    }
    return Triple(maxSum, first, last)
}

fun main(args: Array<String>) {
  val seq = intArrayOf(-1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , -1)
  val(maxSum, first, last) = gss(seq)
  if (maxSum > 0) {
      println("Maximum subsequence is from indices $first to $last")
      print("Elements are : ")
      for (i in first .. last) print("${seq[i]} ")
      println("\nSum is $maxSum")
  }
  else
      println("Maximum subsequence is the empty sequence which has a sum of 0")
}


with(ImageTools):
#conversion forward
dimensions:=[upperbound(img)];
gray := Matrix(dimensions[1], dimensions[2]);
for i from 1 to dimensions[1] do
	for j from 1 to dimensions[2] do
		gray[i,j] := 0.2126 * img[i,j,1] + 0.7152*img[i,j,2] + 0.0722*img[i,j,3]:
	end do:
end do:
#display the result
Embed(Create(gray)):
#conversion backward
x:=Create(gray);
ToRGB(x);
#display the result
Embed(x);


toGrayscale[rgb_Image] := ImageApply[#.{0.2126, 0.7152, 0.0722}&, rgb]
toFakeRGB[L_Image] := ImageApply[{#, #, #}&, L]


function [grayImage] = colortograyscale(inputImage)
   grayImage = rgb2gray(inputImage);


import bitmap
import lenientops

type

  GrayImage* = object
    w*, h*: Index
    pixels*: seq[Luminance]

proc newGrayImage*(width, height: int): GrayImage =
  ## Create a gray image with given width and height.
  new(result)
  result.w = width
  result.h = height
  result.pixels.setLen(width * height)

iterator indices*(img: GrayImage): Point =
  ## Yield the pixels coordinates as tuples.
  for y in 0 ..< img.h:
    for x in 0 ..< img.w:
      yield (x, y)

proc `[]`*(img: GrayImage; x, y: int): Luminance =
  ## Get a pixel luminance value.
  img.pixels[y * img.w + x]

proc `[]=`*(img: GrayImage; x, y: int; lum: Luminance) =
  ## Set a pixel luminance to given value.
  img.pixels[y * img.w + x] = lum

proc fill*(img: GrayImage; lum: Luminance) =
  ## Set the pixels to a given luminance.
  for x, y in img.indices:
    img[x, y] = lum

func toGrayLuminance(color: Color): Luminance =
  ## Compute the luminance from RGB value.
  Luminance(0.2126 * color.r + 0.7152 * color.g + 0.0722 * color.b + 0.5)

func toGrayImage*(img: Image): GrayImage =
  ##
  result = newGrayImage(img.w, img.h)
  for pt in img.indices:
    result[pt.x, pt.y] = img[pt.x, pt.y].toGrayLuminance()

func toImage*(img: GrayImage): Image =
  result = newImage(img.w, img.h)
  for pt in img.indices:
    let lum = img[pt.x, pt.y]
    result[pt.x, pt.y] = (lum, lum, lum)

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  import ppm_write

  # Create a RGB image.
  var image = newImage(100, 50)
  image.fill(color(128, 128, 128))
  for row in 10..20:
    for col in 0..<image.w:
      image[col, row] = color(0, 255, 0)
  for row in 30..40:
    for col in 0..<image.w:
      image[col, row] = color(0, 0, 255)

  # Convert it to grayscale.
  var grayImage = image.toGrayImage()

  # Convert it back to RGB in order to save it in PPM format using the available procedure.
  var convertedImage = grayImage.toImage()
  convertedImage.writePPM("output_gray.ppm")


let to_grayscale ~img:(_, r_channel, g_channel, b_channel) =
  let width = Bigarray.Array2.dim1 r_channel
  and height = Bigarray.Array2.dim2 r_channel in

  let gray_channel =
    let kind = Bigarray.int8_unsigned
    and layout = Bigarray.c_layout
    in
    (Bigarray.Array2.create kind layout width height)
  in
  for y = 0 to pred height do
    for x = 0 to pred width do
      let r = r_channel.{x,y}
      and g = g_channel.{x,y}
      and b = b_channel.{x,y} in
      let v = (2_126 * r +  7_152 * g + 722 * b) / 10_000 in
      gray_channel.{x,y} <- v;
    done;
  done;
  (gray_channel)


#!/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 );
  }


# max(var [value1 value2...]) sets var to the maximum of a list of
# integers. If list is empty, sets var to NO.
function(max var)
  set(first YES)
  set(choice NO)
  foreach(item ${ARGN})
    if(first)
      set(choice ${item})
      set(first NO)
    elseif(choice LESS ${item})
      set(choice ${item})
    endif()
  endforeach(item)
  set(${var} ${choice} PARENT_SCOPE)
endfunction(max)

set(list 33 11 44 22 66 55)
max(maximum ${list})
message(STATUS "maximum of ${list} => ${maximum}")


    for r =0 to 31
        print " Decimal "; using( "###", r); " is ";
        B$ =dec2Bin$( r)
        print " binary "; B$; ". Binary "; B$;
        G$ =Bin2Gray$( dec2Bin$( r))
        print " is "; G$; " in Gray code, or ";
        B$ =Gray2Bin$( G$)
        print B$; " in pure binary."
    next r

    end

    function Bin2Gray$( bin$)   '   Given a binary number as a string, returns Gray code as a string.
        g$ =left$( bin$, 1)
        for i =2 to len( bin$)
            bitA    =val( mid$( bin$, i -1, 1))
            bitB    =val( mid$( bin$, i,    1))
            AXorB   =bitA xor bitB
            g$      =g$ +str$( AXorB)
        next i
        Bin2Gray$ =g$
    end function

    function Gray2Bin$( g$)     '   Given a Gray code as a string, returns equivalent binary num.
                                '      as a string
        gl =len(   g$)
        b$ =left$( g$, 1)
        for i =2 to len( g$)
            bitA    =val( mid$( b$, i -1, 1))
            bitB    =val( mid$( g$, i,    1))
            AXorB   =bitA xor bitB
            b$      =b$ +str$( AXorB)
        next i
        Gray2Bin$ =right$( b$, gl)
    end function

    function dec2Bin$( num) '   Given an integer decimal, returns binary equivalent as a string
        n =num
        dec2Bin$ =""
        while ( num >0)
            dec2Bin$    =str$( num mod 2) +dec2Bin$
            num         =int( num /2)
        wend
        if ( n >255) then nBits =16 else nBits =8
        dec2Bin$ =right$( "0000000000000000" +dec2Bin$, nBits)  '   Pad to 8 bit or 16 bit
    end function

    function bin2Dec( b$)   '   Given a binary number as a string, returns decimal equivalent num.
        t =0
        d =len( b$)
        for k =d to 1 step -1
            t   =t +val( mid$( b$, k, 1)) *2^( d -k)
        next k
        bin2Dec =t
    end function


dim h(1000000)
for i =1 to 20
    print hamming(i)," ";
next i

print
print "Hamming List First(1691)   = ",hamming(1691)
end

sub hamming(limit)
    local x2,x3,x5,i,j,k,n

    h(0) =1
    x2 = 2: x3 = 3: x5 =5
    i  = 0: j  = 0: k  =0
    for n =1 to limit
        h(n)  = min(x2, min(x3, x5))
        if x2 = h(n) then i = i +1: x2 =2 *h(i):end if
        if x3 = h(n) then j = j +1: x3 =3 *h(j):end if
        if x5 = h(n) then k = k +1: x5 =5 *h(k):end if
    next n
    return h(limit -1)
end sub


'Greatest_subsequential_sum

N= 20   'number of elements

randomize 0.52
for K = 1 to 5
    a$ = using("##",int(rnd(1)*12)-5)
    for i=2 to N
        a$ = a$ +","+using("##",int(rnd(1)*12)-5)
    next
    call maxsumseq a$
next K

sub maxsumseq a$
    sum=0
    maxsum=0
    sumStart=1
    end1 =0
    start1 =1

    token$="*"
    i=0
    while 1
        i=i+1
        token$=word$(a$, i, ",")
        if token$ ="" then exit while    'end of stream
        x=val(token$)
        sum=sum+x
        if maxsum<sum then
             maxsum = sum
             start1 = sumStart
             end1 = i
        else
            if sum <0 then
                sum=0
                sumStart = i+1
            end if
        end if
    wend
    print "sequence: ";a$
    print "          ";
    for i=1 to start1-1:   print "   "; :next
    for i= start1 to end1: print "---"; :next
    print
    if end1 >0 then
        print "Maximum sum subsequense: ";start1 ;" to "; end1
    else
        print "Maximum sum subsequense: is empty"
    end if
    print "Maximum sum ";maxsum
    print
end sub


functor
import
   Array2D
export
   ToGraymap
   FromGraymap
define
   fun {ToGraymap bitmap(Arr)}
      graymap({Array2D.map Arr Luminance})
   end

   fun {Luminance Color}
      F = {Record.map Color Int.toFloat}
   in
      0.2126*F.1 + 0.7152*F.2 + 0.0722*F.3
   end

   fun {FromGraymap graymap(Arr)}
      bitmap({Array2D.map Arr ToColor})
   end

   fun {ToColor Lum}
      L = {Float.toInt Lum}
   in
      color(L L L)
   end
end


#! /usr/bin/perl

use strict;
use Image::Imlib2;

sub tograyscale
{
    my $img = shift;
    my $gimg = Image::Imlib2->new($img->width, $img->height);
    for ( my $x = 0; $x < $gimg->width; $x++ ) {
	for ( my $y = 0; $y < $gimg->height; $y++ ) {
	    my ( $r, $g, $b, $a ) = $img->query_pixel($x, $y);
	    my $gray = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
	    # discard alpha info...
	    $gimg->set_color($gray, $gray, $gray, 255);
	    $gimg->draw_point($x, $y);
	}
    }
    return $gimg;
}

my $animage = Image::Imlib2->load("Lenna100.jpg");
my $gscale = tograyscale($animage);
$gscale->set_quality(80);
$gscale->save("Lennagray.jpg");

exit 0;


# using Math library
max1 = (list) ->
 Math.max.apply null, list

# using no libraries
max2 = (list) ->
 maxVal = list[0]
 for value in list
  maxVal = value if value > maxVal
 maxVal

# Test it
a = [0,1,2,5,4];
alert(max1(a)+". The answer is "+max2(a));


implement Gray;

include "sys.m"; sys: Sys;
	print: import sys;
include "draw.m";

Gray: module {
	init: fn(nil: ref Draw->Context, args: list of string);
	# Export gray and grayinv so that this module can be used as either a
	# standalone program or as a library:
	gray: fn(n: int): int;
	grayinv: fn(n: int): int;
};

init(nil: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	for(i := 0; i < 32; i++) {
		g := gray(i);
		f := grayinv(g);
		print("%2d  %5s  %2d  %5s  %5s  %2d\n", i, binstr(i), g, binstr(g), binstr(f), f);
	}
}

gray(n: int): int
{
	return n ^ (n >> 1);
}

grayinv(n: int): int
{
	r := 0;
	while(n) {
		r ^= n;
		n >>= 1;
	}
	return r;
}

binstr(n: int): string
{
	if(!n)
		return "0";
	s := "";
	while(n) {
		s = (string (n&1)) + s;
		n >>= 1;
	}
	return s;
}