F first_avail_int(data)
   ‘return lowest int 0... not in data’
   V d = Set(data)
   L(i) 0..
      I i !C d
         R i

F greedy_colour(name, connections)
   DefaultDict[Int, [Int]] graph

   L(connection) connections.split(‘ ’)
      I ‘-’ C connection
         V (n1, n2) = connection.split(‘-’).map(Int)
         graph[n1].append(n2)
         graph[n2].append(n1)
      E
         graph[Int(connection)] = [Int]()

   // Greedy colourisation algo
   V order = sorted(graph.keys())
   [Int = Int] colour
   V neighbours = graph
   L(node) order
      V used_neighbour_colours = neighbours[node].filter(nbr -> nbr C @colour).map(nbr -> @colour[nbr])
      colour[node] = first_avail_int(used_neighbour_colours)

   print("\n"name)
   V canonical_edges = Set[(Int, Int)]()
   L(n1, neighbours) sorted(graph.items())
      I !neighbours.empty
         L(n2) neighbours
            V edge = tuple_sorted((n1, n2))
            I edge !C canonical_edges
               print(‘       #.-#.: Colour: #., #.’.format(n1, n2, colour[n1], colour[n2]))
               canonical_edges.add(edge)
      E
         print(‘         #.: Colour: #.’.format(n1, colour[n1]))
   V lc = Set(colour.values()).len
   print("    #Nodes: #.\n    #Edges: #.\n  #Colours: #.".format(colour.len, canonical_edges.len, lc))

L(name, connections) [
      (‘Ex1’, ‘0-1 1-2 2-0 3’),
      (‘Ex2’, ‘1-6 1-7 1-8 2-5 2-7 2-8 3-5 3-6 3-8 4-5 4-6 4-7’),
      (‘Ex3’, ‘1-4 1-6 1-8 3-2 3-6 3-8 5-2 5-4 5-8 7-2 7-4 7-6’),
      (‘Ex4’, ‘1-6 7-1 8-1 5-2 2-7 2-8 3-5 6-3 3-8 4-5 4-6 4-7’)]
   greedy_colour(name, connections)


hamming=function(hamms,limit) {
  tmp=hamms
  for(h in c(2,3,5)) {
    tmp=c(tmp,h*hamms)
  }
  tmp=unique(tmp[tmp<=limit])
  if(length(tmp)>length(hamms)) {
    hamms=hamming(tmp,limit)
  }
  hamms
}
h <- sort(hamming(1,limit=2^31-1))
print(h[1:20])
print(h[length(h)])


seq = -1,-2,3,5,6,-2,-1,4,-4,2,-1
max := sum := start := 0
Loop Parse, seq, `,
   If (max < sum+=A_LoopField)
      max := sum, a := start, b := A_Index
   Else If sum <= 0
      sum := 0, start := A_Index
; read out the best subsequence
Loop Parse, seq, `,
   s .= A_Index > a && A_Index <= b ? A_LoopField "," : ""
MsgBox % "Max = " max "`n[" SubStr(s,1,-1) "]"


Local $iArray[11] = [-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1]
GREAT_SUB($iArray)
Local $iArray[5] = [-1, -2, -3, -4, -5]
GREAT_SUB($iArray)
Local $iArray[15] = [7, -6, -8, 5, -2, -6, 7, 4, 8, -9, -3, 2, 6, -4, -6]
GREAT_SUB($iArray)

Func GREAT_SUB($iArray)
	Local $iSUM = 0, $iBEGIN_MAX = 0, $iEND_MAX = -1, $iMAX_SUM = 0
	For $i = 0 To UBound($iArray) - 1
		$iSUM = 0
		For $k = $i To UBound($iArray) - 1
			$iSUM += $iArray[$k]
			If $iSUM > $iMAX_SUM Then
				$iMAX_SUM = $iSUM
				$iEND_MAX = $k
				$iBEGIN_MAX = $i
			EndIf
		Next
	Next
	ConsoleWrite("> Array: [")
	For $i = 0 To UBound($iArray) - 1
		If $iArray[$i] > 0 Then ConsoleWrite("+")
		ConsoleWrite($iArray[$i])
		If $i <> UBound($iArray) - 1 Then ConsoleWrite(",")
	Next
	ConsoleWrite("]" & @CRLF & "+>Maximal subsequence: [")
	$iSUM = 0
	For $i = $iBEGIN_MAX To $iEND_MAX
		$iSUM += $iArray[$i]
		If $iArray[$i] > 0 Then ConsoleWrite("+")
		ConsoleWrite($iArray[$i])
		If $i <> $iEND_MAX Then ConsoleWrite(",")
	Next
	ConsoleWrite("]" & @CRLF & "!>SUM of subsequence: " & $iSUM & @CRLF)
EndFunc   ;==>GREAT_SUB


package main

import (
    "fmt"
    "sort"
)

type graph struct {
    nn  int     // number of nodes
    st  int     // node numbering starts from
    nbr [][]int // neighbor list for each node
}

type nodeval struct {
    n int // number of node
    v int // valence of node i.e. number of neighbors
}

func contains(s []int, n int) bool {
    for _, e := range s {
        if e == n {
            return true
        }
    }
    return false
}

func newGraph(nn, st int) graph {
    nbr := make([][]int, nn)
    return graph{nn, st, nbr}
}

// Note that this creates a single 'virtual' edge for an isolated node.
func (g graph) addEdge(n1, n2 int) {
    n1, n2 = n1-g.st, n2-g.st // adjust to starting node number
    g.nbr[n1] = append(g.nbr[n1], n2)
    if n1 != n2 {
        g.nbr[n2] = append(g.nbr[n2], n1)
    }
}

// Uses 'greedy' algorithm.
func (g graph) greedyColoring() []int {
    // create a slice with a color for each node, starting with color 0
    cols := make([]int, g.nn) // all zero by default including the first node
    for i := 1; i < g.nn; i++ {
        cols[i] = -1 // mark all nodes after the first as having no color assigned (-1)
    }
    // create a bool slice to keep track of which colors are available
    available := make([]bool, g.nn) // all false by default
    // assign colors to all nodes after the first
    for i := 1; i < g.nn; i++ {
        // iterate through neighbors and mark their colors as available
        for _, j := range g.nbr[i] {
            if cols[j] != -1 {
                available[cols[j]] = true
            }
        }
        // find the first available color
        c := 0
        for ; c < g.nn; c++ {
            if !available[c] {
                break
            }
        }
        cols[i] = c // assign it to the current node
        // reset the neighbors' colors to unavailable
        // before the next iteration
        for _, j := range g.nbr[i] {
            if cols[j] != -1 {
                available[cols[j]] = false
            }
        }
    }
    return cols
}

// Uses Welsh-Powell algorithm.
func (g graph) wpColoring() []int {
    // create nodeval for each node
    nvs := make([]nodeval, g.nn)
    for i := 0; i < g.nn; i++ {
        v := len(g.nbr[i])
        if v == 1 && g.nbr[i][0] == i { // isolated node
            v = 0
        }
        nvs[i] = nodeval{i, v}
    }
    // sort the nodevals in descending order by valence
    sort.Slice(nvs, func(i, j int) bool {
        return nvs[i].v > nvs[j].v
    })
    // create colors slice with entries for each node
    cols := make([]int, g.nn)
    for i := range cols {
        cols[i] = -1 // set all nodes to no color (-1) initially
    }
    currCol := 0 // start with color 0
    for f := 0; f < g.nn-1; f++ {
        h := nvs[f].n
        if cols[h] != -1 { // already assigned a color
            continue
        }
        cols[h] = currCol
        // assign same color to all subsequent uncolored nodes which are
        // not connected to a previous colored one
    outer:
        for i := f + 1; i < g.nn; i++ {
            j := nvs[i].n
            if cols[j] != -1 { // already colored
                continue
            }
            for k := f; k < i; k++ {
                l := nvs[k].n
                if cols[l] == -1 { // not yet colored
                    continue
                }
                if contains(g.nbr[j], l) {
                    continue outer // node j is connected to an earlier colored node
                }
            }
            cols[j] = currCol
        }
        currCol++
    }
    return cols
}

func main() {
    fns := [](func(graph) []int){graph.greedyColoring, graph.wpColoring}
    titles := []string{"'Greedy'", "Welsh-Powell"}
    nns := []int{4, 8, 8, 8}
    starts := []int{0, 1, 1, 1}
    edges1 := [][2]int{{0, 1}, {1, 2}, {2, 0}, {3, 3}}
    edges2 := [][2]int{{1, 6}, {1, 7}, {1, 8}, {2, 5}, {2, 7}, {2, 8},
        {3, 5}, {3, 6}, {3, 8}, {4, 5}, {4, 6}, {4, 7}}
    edges3 := [][2]int{{1, 4}, {1, 6}, {1, 8}, {3, 2}, {3, 6}, {3, 8},
        {5, 2}, {5, 4}, {5, 8}, {7, 2}, {7, 4}, {7, 6}}
    edges4 := [][2]int{{1, 6}, {7, 1}, {8, 1}, {5, 2}, {2, 7}, {2, 8},
        {3, 5}, {6, 3}, {3, 8}, {4, 5}, {4, 6}, {4, 7}}
    for j, fn := range fns {
        fmt.Println("Using the", titles[j], "algorithm:\n")
        for i, edges := range [][][2]int{edges1, edges2, edges3, edges4} {
            fmt.Println("  Example", i+1)
            g := newGraph(nns[i], starts[i])
            for _, e := range edges {
                g.addEdge(e[0], e[1])
            }
            cols := fn(g)
            ecount := 0 // counts edges
            for _, e := range edges {
                if e[0] != e[1] {
                    fmt.Printf("    Edge  %d-%d -> Color %d, %d\n", e[0], e[1],
                        cols[e[0]-g.st], cols[e[1]-g.st])
                    ecount++
                } else {
                    fmt.Printf("    Node  %d   -> Color %d\n", e[0], cols[e[0]-g.st])
                }
            }
            maxCol := 0 // maximum color number used
            for _, col := range cols {
                if col > maxCol {
                    maxCol = col
                }
            }
            fmt.Println("    Number of nodes  :", nns[i])
            fmt.Println("    Number of edges  :", ecount)
            fmt.Println("    Number of colors :", maxCol+1)
            fmt.Println()
        }
    }
}


#lang racket
(require racket/stream)
(define first stream-first)
(define rest  stream-rest)

(define (merge s1 s2)
  (define x1 (first s1))
  (define x2 (first s2))
  (cond [(= x1 x2) (merge s1 (rest s2))]
        [(< x1 x2) (stream-cons x1 (merge (rest s1) s2))]
        [else      (stream-cons x2 (merge s1 (rest s2)))]))

(define (mult k) (λ(x) (* x k)))

(define hamming
  (stream-cons
   1 (merge (stream-map (mult 2) hamming)
            (merge (stream-map (mult 3) hamming)
                   (stream-map (mult 5) hamming)))))

(for/list ([i 20] [x hamming]) x)
(stream-ref hamming 1690)
(stream-ref hamming 999999)


# Finds the subsequence of ary[1] to ary[len] with the greatest sum.
# Sets subseq[1] to subseq[n] and returns n. Also sets subseq["sum"].
# An empty subsequence has sum 0.
function maxsubseq(subseq, ary, len,    b, bp, bs, c, cp, i) {
	b = 0		# best sum
	c = 0		# current sum
	bp = 0		# position of best subsequence
	bn = 0		# length of best subsequence
	cp = 1		# position of current subsequence

	for (i = 1; i <= len; i++) {
		c += ary[i]
		if (c < 0) {
			c = 0
			cp = i + 1
		}
		if (c > b) {
			b = c
			bp = cp
			bn = i + 1 - cp
		}
	}

	for (i = 1; i <= bn; i++)
		subseq[i] = ary[bp + i - 1]
	subseq["sum"] = b
	return bn
}


      DIM A%(11) : A%() = 0, 1, 2, -3, 3, -1, 0, -4, 0, -1, -4, 2
      PRINT FNshowarray(A%()) " -> " FNmaxsubsequence(A%())
      DIM B%(10) : B%() = -1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1
      PRINT FNshowarray(B%()) " -> " FNmaxsubsequence(B%())
      DIM C%(4) : C%() = -1, -2, -3, -4, -5
      PRINT FNshowarray(C%()) " -> " FNmaxsubsequence(C%())
      END

      DEF FNmaxsubsequence(a%())
      LOCAL a%, b%, i%, j%, m%, s%, a$
      a% = 1
      FOR i% = 0 TO DIM(a%(),1)
        s% = 0
        FOR j% = i% TO DIM(a%(),1)
          s% += a%(j%)
          IF s% > m% THEN
            m% = s%
            a% = i%
            b% = j%
          ENDIF
        NEXT
      NEXT i%
      IF a% > b% THEN = "[]"
      a$ = "["
      FOR i% = a% TO b%
        a$ += STR$(a%(i%)) + ", "
      NEXT
      = LEFT$(LEFT$(a$)) + "]"

      DEF FNshowarray(a%())
      LOCAL i%, a$
      a$ = "["
      FOR i% = 0 TO DIM(a%(),1)
        a$ += STR$(a%(i%)) + ", "
      NEXT
      = LEFT$(LEFT$(a$)) + "]"


import Data.Maybe
import Data.List
import Control.Monad.State
import qualified Data.Map as M
import Text.Printf

------------------------------------------------------------
-- Primitive graph representation

type Node = Int
type Color = Int
type Graph = M.Map Node [Node]

nodes :: Graph -> [Node]
nodes = M.keys

adjacentNodes :: Graph -> Node -> [Node]
adjacentNodes g n = fromMaybe [] $ M.lookup n g

degree :: Graph -> Node -> Int
degree g = length . adjacentNodes g

fromList :: [(Node, [Node])] -> Graph
fromList  = foldr add M.empty
  where
    add (a, bs) g = foldr (join [a]) (join bs a g) bs
    join = flip (M.insertWith (++))

readGraph :: String -> Graph
readGraph = fromList . map interprete . words
  where
    interprete s = case span (/= '-') s of
      (a, "") -> (read a, [])
      (a, '-':b) -> (read a, [read b])

------------------------------------------------------------
-- Graph coloring functions

uncolored :: Node -> State [(Node, Color)] Bool
uncolored n = isNothing <$> colorOf n

colorOf :: Node -> State [(Node, Color)] (Maybe Color)
colorOf n = gets (lookup n)

greedyColoring :: Graph -> [(Node, Color)]
greedyColoring g = mapM_ go (nodes g) `execState` []
  where
    go n = do
      c <- colorOf n
      when (isNothing c) $ do
        adjacentColors <- nub . catMaybes <$> mapM colorOf (adjacentNodes g n)
        let newColor = head $ filter (`notElem` adjacentColors) [1..]
        modify ((n, newColor) :)
      filterM uncolored (adjacentNodes g n) >>= mapM_ go

wpColoring :: Graph -> [(Node, Color)]
wpColoring g = go [1..] nodesList `execState` []
  where
    nodesList = sortOn (negate . degree g) (nodes g)

    go _ [] = pure ()
    go (c:cs) ns = do
      mark c ns
      filterM uncolored ns >>= go cs

    mark c [] = pure () :: State [(Node, Color)] ()
    mark c (n:ns) = do
      modify ((n, c) :)
      mark c (filter (`notElem` adjacentNodes g n) ns)


my $limit = 32;

sub powers_of ($radix) { 1, |[\*] $radix xx * }

my @hammings =
  (   powers_of(2)[^ $limit ]       X*
      powers_of(3)[^($limit * 2/3)] X*
      powers_of(5)[^($limit * 1/2)]
   ).sort;

say @hammings[^20];
say @hammings[1690]; # zero indexed


#include "stdio.h"

typedef struct Range {
    int start, end, sum;
} Range;

Range maxSubseq(const int sequence[], const int len) {
    int maxSum = 0, thisSum = 0, i = 0;
    int start = 0, end = -1, j;

    for (j = 0; j < len; j++) {
        thisSum += sequence[j];
        if (thisSum < 0) {
            i = j + 1;
            thisSum = 0;
        } else if (thisSum > maxSum) {
            maxSum = thisSum;
            start = i;
            end   = j;
        }
    }

    Range r;
    if (start <= end && start >= 0 && end >= 0) {
        r.start = start;
        r.end = end + 1;
        r.sum = maxSum;
    } else {
        r.start = 0;
        r.end = 0;
        r.sum = 0;
    }
    return r;
}

int main(int argc, char **argv) {
    int a[] = {-1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , -1};
    int alength = sizeof(a)/sizeof(a[0]);

    Range r = maxSubseq(a, alength);
    printf("Max sum = %d\n", r.sum);
    int i;
    for (i = r.start; i < r.end; i++)
        printf("%d ", a[i]);
    printf("\n");

    return 0;
}


parse=: {{
  ref=: 2$L:1(;:each cut y) -.L:1 ;:'-'
  labels=: /:~~.;ref
  sparse=. (*:#labels) > 20*#ref
  graph=: (+.|:) 1 (labels i.L:1 ref)} $.^:sparse 0$~2##labels
}}

greedy=: {{
  colors=. (#y)#a:
  for_node.y do.
    color=. <{.(-.~ [:i.1+#) ~.;node#colors
    colors=. color node_index} colors
  end.
  ;colors
}}


using Random

"""Useful constants for the colors to be selected for nodes of the graph"""
const colors4 = ["blue", "red", "green", "yellow"]
const badcolor = "black"
@assert(!(badcolor in colors4))

"""
    struct graph

undirected simple graph
constructed from its name and a string listing of point to point connections
"""
mutable struct Graph
    name::String
    g::Dict{Int, Vector{Int}}
    nodecolor::Dict{Int, String}
    function Graph(nam::String, s::String)
        gdic = Dict{Int, Vector{Int}}()
        for p in eachmatch(r"(\d+)-(\d+)|(\d+)(?!\s*-)" , s)
            if p != nothing
                if p[3] != nothing
                    n3 = parse(Int, p[3])
                    get!(gdic, n3, [])
                else
                    n1, n2 = parse(Int, p[1]), parse(Int, p[2])
                    p1vec = get!(gdic, n1, [])
                    !(n2 in p1vec) && push!(p1vec, n2)
                    p2vec = get!(gdic, n2, [])
                    !(n1 in p2vec) && push!(p2vec, n1)
                end
            end
        end
        new(nam, gdic, Dict{Int, String}())
    end
end

"""
    tryNcolors!(gr::Graph, N, maxtrials)

Try up to maxtrials to get a coloring with <= N colors
"""
function tryNcolors!(gr::Graph, N, maxtrials)
    t, mintrial, minord = N, N + 1, Dict()
    for _ in 1:maxtrials
        empty!(gr.nodecolor)
        ordering = shuffle(collect(keys(gr.g)))
        for node in ordering
            usedneighborcolors = [gr.nodecolor[c] for c in gr.g[node] if haskey(gr.nodecolor, c)]
            gr.nodecolor[node] = badcolor
            for c in colors4[1:N]
                if !(c in usedneighborcolors)
                    gr.nodecolor[node] = c
                    break
                end
            end
        end
        t = length(unique(values(gr.nodecolor)))
        if t < mintrial
            mintrial = t
            minord = deepcopy(gr.nodecolor)
        end
    end
    if length(minord) > 0
        gr.nodecolor = minord
    end
end

"""
    prettyprintcolors(gr::graph)

print out the colored nodes in graph
"""
function prettyprintcolors(gr::Graph)
    println("\nColors for the graph named ", gr.name, ":")
    edgesdone = Vector{Vector{Int}}()
    for (node, neighbors) in gr.g
        if !isempty(neighbors)
            for n in neighbors
                edge = node < n ? [node, n] : [n, node]
                if !(edge in edgesdone)
                    println("    ", edge[1], "-", edge[2], " Color: ",
                        gr.nodecolor[edge[1]], ", ", gr.nodecolor[edge[2]])
                    push!(edgesdone, edge)
                end
            end
        else
            println("    ", node, ": ", gr.nodecolor[node])
        end
    end
    println("\n", length(unique(keys(gr.nodecolor))), " nodes, ",
        length(edgesdone), " edges, ",
        length(unique(values(gr.nodecolor))), " colors.")
end

for (name, txt) in [("Ex1", "0-1 1-2 2-0 3"),
    ("Ex2", "1-6 1-7 1-8 2-5 2-7 2-8 3-5 3-6 3-8 4-5 4-6 4-7"),
    ("Ex3", "1-4 1-6 1-8 3-2 3-6 3-8 5-2 5-4 5-8 7-2 7-4 7-6"),
    ("Ex4", "1-6 7-1 8-1 5-2 2-7 2-8 3-5 6-3 3-8 4-5 4-6 4-7")]
    exgraph = Graph(name, txt)
    tryNcolors!(exgraph, 4, 100)
    prettyprintcolors(exgraph)
end


ClearAll[ColorGroups]
ColorGroups[g_Graph] := Module[{h, cols, indset, diffcols},
  h = g;
  cols = {};
  While[! EmptyGraphQ[h], maxd = RandomChoice[VertexList[h]];
   indset = Flatten[FindIndependentVertexSet[{h, maxd}]];
   AppendTo[cols, indset];
   h = VertexDelete[h, indset];
   ];
  AppendTo[cols, VertexList[h]];
  diffcols = Length[cols];
  cols = Catenate[Map[Thread][Rule @@@ Transpose[{cols, Range[Length[cols]]}]]];
  Print[Column[Row[{"Edge ", #1, " to ", #2, " has colors ", #1 /. cols, " and ", #2 /. cols }] & @@@ EdgeList[g]]];
  Print[Grid[{{"Vertices: ", VertexCount[g]}, {"Edges: ", EdgeCount[g]}, {"Colors used: ", diffcols}}]]
  ]
ColorGroups[Graph[Range[0, 3], {0 \[UndirectedEdge] 1, 1 \[UndirectedEdge] 2,
   2 \[UndirectedEdge] 0}]]
ColorGroups[Graph[Range[8], {1 \[UndirectedEdge] 6, 1 \[UndirectedEdge] 7,
   1 \[UndirectedEdge] 8, 2 \[UndirectedEdge] 5,
   2 \[UndirectedEdge] 7, 2 \[UndirectedEdge] 8,
   3 \[UndirectedEdge] 5, 3 \[UndirectedEdge] 6,
   3 \[UndirectedEdge] 8, 4 \[UndirectedEdge] 5,
   4 \[UndirectedEdge] 6, 4 \[UndirectedEdge] 7}]]
ColorGroups[Graph[Range[8], {1 \[UndirectedEdge] 4, 1 \[UndirectedEdge] 6,
   1 \[UndirectedEdge] 8, 3 \[UndirectedEdge] 2,
   3 \[UndirectedEdge] 6, 3 \[UndirectedEdge] 8,
   5 \[UndirectedEdge] 2, 5 \[UndirectedEdge] 4,
   5 \[UndirectedEdge] 8, 7 \[UndirectedEdge] 2,
   7 \[UndirectedEdge] 4, 7 \[UndirectedEdge] 6}]]
ColorGroups[Graph[Range[8], {1 \[UndirectedEdge] 6, 7 \[UndirectedEdge] 1,
   8 \[UndirectedEdge] 1, 5 \[UndirectedEdge] 2,
   2 \[UndirectedEdge] 7, 2 \[UndirectedEdge] 8,
   3 \[UndirectedEdge] 5, 6 \[UndirectedEdge] 3,
   3 \[UndirectedEdge] 8, 4 \[UndirectedEdge] 5,
   4 \[UndirectedEdge] 6, 4 \[UndirectedEdge] 7}]]


import algorithm, sequtils, strscans, strutils, tables

const NoColor = 0

type

  Color = range[0..63]

  Node = ref object
    num: Natural          # Node number.
    color: Color          # Node color.
    degree: Natural       # Node degree.
    dsat: Natural         # Node Dsaturation.
    neighbors: seq[Node]  # List of neighbors.

  Graph = seq[Node]       # List of nodes ordered by number.

#---------------------------------------------------------------------------------------------------

proc initGraph(graphRepr: string): Graph =
  ## Initialize the graph from its string representation.

  var mapping: Table[Natural, Node]   # Temporary mapping.
  for elem in graphRepr.splitWhitespace():
    var num1, num2: int
    if elem.scanf("$i-$i", num1, num2):
      let node1 = mapping.mgetOrPut(num1, Node(num: num1))
      let node2 = mapping.mgetOrPut(num2, Node(num: num2))
      node1.neighbors.add node2
      node2.neighbors.add node1
    elif elem.scanf("$i", num1):
      discard mapping.mgetOrPut(num1, Node(num: num1))
    else:
      raise newException(ValueError, "wrong description: " & elem)

  for node in mapping.values:
    node.degree = node.neighbors.len
  result = sortedByIt(toSeq(mapping.values), it.num)

#---------------------------------------------------------------------------------------------------

proc numbers(nodes: seq[Node]): string =
  ## Return the numbers of a list of nodes.
  for node in nodes:
    result.addSep(" ")
    result.add($node.num)

#---------------------------------------------------------------------------------------------------

proc `$`(graph: Graph): string =
  ## Return the description of the graph.

  var maxColor = NoColor
  for node in graph:
    stdout.write "Node ", node.num, ":   color = ", node.color
    if node.color > maxColor: maxColor = node.color
    if node.neighbors.len > 0:
      echo "   neighbors = ", sortedByIt(node.neighbors, it.num).numbers
    else:
      echo ""
  echo "Number of colors: ", maxColor

#---------------------------------------------------------------------------------------------------

proc `<`(node1, node2: Node): bool =
  ## Comparison of nodes, by dsaturation first, then by degree.
  if node1.dsat == node2.dsat: node1.degree < node2.degree
  else: node1.dsat < node2.dsat

#---------------------------------------------------------------------------------------------------

proc getMaxDsatNode(nodes: var seq[Node]): Node =
  ## Return the node with the greatest dsaturation.
  let idx = nodes.maxIndex()
  result = nodes[idx]
  nodes.delete(idx)

#---------------------------------------------------------------------------------------------------

proc minColor(node: Node): COLOR =
  ## Return the minimum available color for a node.
  var colorUsed: set[Color]
  for neighbor in node.neighbors:
    colorUsed.incl neighbor.color
  for color in 1..Color.high:
    if color notin colorUsed: return color

#---------------------------------------------------------------------------------------------------

proc distinctColorsCount(node: Node): Natural =
  ## Return the number of distinct colors of the neighbors of a node.
  var colorUsed: set[Color]
  for neighbor in node.neighbors:
    colorUsed.incl neighbor.color
  result = colorUsed.card

#---------------------------------------------------------------------------------------------------

proc updateDsats(node: Node) =
  ## Update the dsaturations of the neighbors of a node.
  for neighbor in node.neighbors:
    if neighbor.color == NoColor:
      neighbor.dsat = neighbor.distinctColorsCount()

#---------------------------------------------------------------------------------------------------

proc colorize(graphRepr: string) =
  ## Colorize a graph.

  let graph = initGraph(graphRepr)
  var nodes = sortedByIt(graph, -it.degree)   # Copy or graph sorted by decreasing degrees.
  while nodes.len > 0:
    let node = nodes.getMaxDsatNode()
    node.color = node.minColor()
    node.updateDsats()

  echo "Graph: ", graphRepr
  echo graph

#---------------------------------------------------------------------------------------------------

when isMainModule:
  colorize("0-1 1-2 2-0 3")
  colorize("1-6 1-7 1-8 2-5 2-7 2-8 3-5 3-6 3-8 4-5 4-6 4-7")
  colorize("1-4 1-6 1-8 3-2 3-6 3-8 5-2 5-4 5-8 7-2 7-4 7-6")
  colorize("1-6 7-1 8-1 5-2 2-7 2-8 3-5 6-3 3-8 4-5 4-6 4-7")


use strict;
use warnings;
no warnings 'uninitialized';
use feature 'say';
use constant True => 1;
use List::Util qw(head uniq);

sub GraphNodeColor {
    my(%OneMany, %NodeColor, %NodePool, @ColorPool);
    my(@data) = @_;

    for (@data) {
        my($a,$b) = @$_;
        push @{$OneMany{$a}}, $b;
        push @{$OneMany{$b}}, $a;
    }

    @ColorPool = 0 .. -1 + scalar %OneMany;
    $NodePool{$_} = True for keys %OneMany;

    if ($OneMany{''}) { # skip islanders for now
        delete $NodePool{$_} for @{$OneMany{''}};
        delete $NodePool{''};
    }

    while (%NodePool) {
        my $color = shift @ColorPool;
        my %TempPool = %NodePool;

        while (my $n = head 1, sort keys %TempPool) {
            $NodeColor{$n} = $color;
            delete $TempPool{$n};
            delete $TempPool{$_} for @{$OneMany{$n}} ; # skip neighbors as well
            delete $NodePool{$n};
        }

        if ($OneMany{''}) { # islanders use an existing color
            $NodeColor{$_} = head 1, sort values %NodeColor for @{$OneMany{''}};
        }
    }
    %NodeColor
}

my @DATA = (
    [ [1,2],[2,3],[3,1],[4,undef],[5,undef],[6,undef] ],
    [ [1,6],[1,7],[1,8],[2,5],[2,7],[2,8],[3,5],[3,6],[3,8],[4,5],[4,6],[4,7] ],
    [ [1,4],[1,6],[1,8],[3,2],[3,6],[3,8],[5,2],[5,4],[5,8],[7,2],[7,4],[7,6] ],
    [ [1,6],[7,1],[8,1],[5,2],[2,7],[2,8],[3,5],[6,3],[3,8],[4,5],[4,6],[4,7] ]
);

for my $d (@DATA) {
    my %result = GraphNodeColor @$d;

    my($graph,$colors);
    $graph  .= '(' . join(' ', @$_) . '), ' for @$d;
    $colors .= ' ' . $result{$$_[0]} . '-' . ($result{$$_[1]} // '') . '   ' for @$d;

    say 'Graph  : ' . $graph =~ s/,\s*$//r;
    say 'Colors : ' . $colors;
    say 'Nodes  : ' . keys %result;
    say 'Edges  : ' . @$d;
    say 'Unique : ' . uniq values %result;
    say '';
}


define hamming use $limit
    [ ] as $h
    1 $h 0 set
    2 as $x2   3 as $x3    5 as $x5
    0 as $i    0 as $j     0 as $k
    1 $limit 1 + 1 range each as $n
        $x3 $x5 min $x2 min    $h $n   set
        $h $n get   $x2 =  if
            $i  1 +   as $i
            $h $i get    2 *     as $x2
        $h $n get   $x3 =  if
            $j  1 +   as $j
            $h $j get    3 *     as $x3
        $h $n get   $x5 =  if
            $k  1 +   as $k
            $h $k get    5 *     as $x5
    $h   $limit 1 -   get

1 21 1 range each as $lim
    $lim hamming print " " print
"\n" print

"Hamming(1691) is: " print    1691 hamming print    "\n" print

# Raven can't handle > 2^31 using integers
#
#"Hamming(1000000) is: " print   1000000 hamming print    "\n" print


using System;

namespace Tests_With_Framework_4
{
    class Program
    {
        static void Main(string[] args)
        {
            int[] integers = { -1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1 }; int length = integers.Length;
            int maxsum, beginmax, endmax, sum; maxsum = beginmax = sum = 0; endmax = -1;

            for (int i = 0; i < length; i++)
            {
                sum = 0;
                for (int k = i; k < length; k++)
                {
                    sum += integers[k];
                    if (sum > maxsum)
                    {
                        maxsum = sum;
                        beginmax = i;
                        endmax = k;
                    }
                }
            }

            for (int i = beginmax; i <= endmax; i++)
                Console.WriteLine(integers[i]);

            Console.ReadKey();
        }
    }
}


-- demo\rosetta\Graph_colouring.exw
with javascript_semantics
constant tests = split("""
0-1 1-2 2-0 3
1-6 1-7 1-8 2-5 2-7 2-8 3-5 3-6 3-8 4-5 4-6 4-7
1-4 1-6 1-8 3-2 3-6 3-8 5-2 5-4 5-8 7-2 7-4 7-6
1-6 7-1 8-1 5-2 2-7 2-8 3-5 6-3 3-8 4-5 4-6 4-7
""","\n",true)

function colour(sequence nodes, links, colours, soln, integer best, next, used=0)
-- fill/try each colours[next], recursing as rqd and saving any improvements.
-- nodes/links are read-only here, colours is the main workspace, soln/best are
-- the results, next is 1..length(nodes), and used is length(unique(colours)).
-- On really big graphs I might consider making nodes..best static, esp colours,
-- in which case you will probably also want a "colours[next] = 0" reset below.
    integer c = 1
    colours = deep_copy(colours)
    while c<best do
        bool avail = true
        for i=1 to length(links[next]) do
            if colours[links[next][i]]==c then
                avail = false
                exit
            end if
        end for
        if avail then
            colours[next] = c
            integer newused = used + (find(c,colours)==next)
            if next<length(nodes) then
                {best,soln} = colour(nodes,links,colours,soln,best,next+1,newused)
            elsif newused<best then
                {best,soln} = {newused,deep_copy(colours)}
            end if
        end if
        c += 1
    end while
    return {best,soln}
end function

function add_node(sequence nodes, links, string n)
    integer rdx = find(n,nodes)
    if rdx=0 then
        nodes = append(nodes,n)
        links = append(links,{})
        rdx = length(nodes)
    end if
    return {nodes, links, rdx}
end function

for t=1 to length(tests) do
    string tt = tests[t]
    sequence lt = split(tt," "),
             nodes = {},
             links = {}
    integer linkcount = 0, left, right
    for l=1 to length(lt) do
        sequence ll = split(lt[l],"-")
        {nodes, links, left} = add_node(deep_copy(nodes),deep_copy(links),ll[1])
        if length(ll)=2 then
            {nodes, links, right} = add_node(deep_copy(nodes),deep_copy(links),ll[2])
            links[left] = deep_copy(links[left])&right
            links[right] = deep_copy(links[right])&left
            linkcount += 1
        end if
    end for
    integer ln = length(nodes)
    printf(1,"test%d: %d nodes, %d edges, ",{t,ln,linkcount})
    sequence colours = repeat(0,ln),
             soln = tagset(ln) -- fallback solution
    integer next = 1, best = ln
    printf(1,"%d colours:%v\n",colour(nodes,links,colours,soln,best,next))
end for


/*REXX program computes  Hamming numbers:  1 ──► 20,  # 1691,  and  the  one millionth. */
numeric digits 100                               /*ensure enough decimal digits.        */
call hamming       1, 20                         /*show the 1st ──► twentieth Hamming #s*/
call hamming    1691                             /*show the 1,691st Hamming number.     */
call hamming 1000000                             /*show the  1 millionth Hamming number.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hamming: procedure; parse arg x,y;         if y==''  then y= x;       w= length(y)
                                   #2= 1;     #3= 1;      #5= 1;      @.= 0;        @.1= 1
            do n=2  for y-1
            @.n= min(2*@.#2,  3*@.#3,  5*@.#5)   /*pick the minimum of 3 Hamming numbers*/
            if 2*@.#2 == @.n   then #2= #2 + 1   /*number already defined?  Use next #. */
            if 3*@.#3 == @.n   then #3= #3 + 1   /*   "      "       "       "    "  "  */
            if 5*@.#5 == @.n   then #5= #5 + 1   /*   "      "       "       "    "  "  */
            end   /*n*/                          /* [↑]  maybe assign next 3 Hamming#s. */
                         do j=x  to y;     say  'Hamming('right(j, w)") ="    @.j
                         end   /*j*/

         say right( 'length of last Hamming number ='     length(@.y), 70);        say
         return


#include <utility>   // for std::pair
#include <iterator>  // for std::iterator_traits
#include <iostream>  // for std::cout
#include <ostream>   // for output operator and std::endl
#include <algorithm> // for std::copy
#include <iterator>  // for std::output_iterator

// Function template max_subseq
//
// Given a sequence of integers, find a subsequence which maximizes
// the sum of its elements, that is, the elements of no other single
// subsequence add up to a value larger than this one.
//
// Requirements:
// * ForwardIterator is a forward iterator
// * ForwardIterator's value_type is less-than comparable and addable
// * default-construction of value_type gives the neutral element
//   (zero)
// * operator+ and operator< are compatible (i.e. if a>zero and
//   b>zero, then a+b>zero, and if a<zero and b<zero, then a+b<zero)
// * [begin,end) is a valid range
//
// Returns:
//   a pair of iterators describing the begin and end of the
//   subsequence
template<typename ForwardIterator>
 std::pair<ForwardIterator, ForwardIterator>
 max_subseq(ForwardIterator begin, ForwardIterator end)
{
  typedef typename std::iterator_traits<ForwardIterator>::value_type
    value_type;

  ForwardIterator seq_begin = begin, seq_end = seq_begin;
  value_type seq_sum = value_type();
  ForwardIterator current_begin = begin;
  value_type current_sum = value_type();

  value_type zero = value_type();

  for (ForwardIterator iter = begin; iter != end; ++iter)
  {
    value_type value = *iter;
    if (zero < value)
    {
      if (current_sum < zero)
      {
        current_sum = zero;
        current_begin = iter;
      }
    }
    else
    {
      if (seq_sum < current_sum)
      {
        seq_begin = current_begin;
        seq_end = iter;
        seq_sum = current_sum;
      }
    }
    current_sum += value;
  }

  if (seq_sum < current_sum)
  {
    seq_begin = current_begin;
    seq_end = end;
    seq_sum = current_sum;
  }

  return std::make_pair(seq_begin, seq_end);
}

// the test array
int array[] = { -1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1 };

// function template to find the one-past-end pointer to the array
template<typename T, int N> int* end(T (&arr)[N]) { return arr+N; }

int main()
{
  // find the subsequence
  std::pair<int*, int*> seq = max_subseq(array, end(array));

  // output it
  std::copy(seq.first, seq.second, std::ostream_iterator<int>(std::cout, " "));
  std::cout << std::endl;

  return 0;
}


import re
from collections import defaultdict
from itertools import count

connection_re = r"""
    (?: (?P<N1>\d+) - (?P<N2>\d+) | (?P<N>\d+) (?!\s*-))
    """

class Graph:

    def __init__(self, name, connections):
        self.name = name
        self.connections = connections
        g = self.graph = defaultdict(list)  # maps vertex to direct connections

        matches = re.finditer(connection_re, connections,
                              re.MULTILINE | re.VERBOSE)
        for match in matches:
            n1, n2, n = match.groups()
            if n:
                g[n] += []
            else:
                g[n1].append(n2)    # Each the neighbour of the other
                g[n2].append(n1)

    def greedy_colour(self, order=None):
        "Greedy colourisation algo."
        if order is None:
            order = self.graph      # Choose something
        colour = self.colour = {}
        neighbours = self.graph
        for node in order:
            used_neighbour_colours = (colour[nbr] for nbr in neighbours[node]
                                      if nbr in colour)
            colour[node] = first_avail_int(used_neighbour_colours)
        self.pp_colours()
        return colour

    def pp_colours(self):
        print(f"\n{self.name}")
        c = self.colour
        e = canonical_edges = set()
        for n1, neighbours in sorted(self.graph.items()):
            if neighbours:
                for n2 in neighbours:
                    edge = tuple(sorted([n1, n2]))
                    if edge not in canonical_edges:
                        print(f"       {n1}-{n2}: Colour: {c[n1]}, {c[n2]}")
                        canonical_edges.add(edge)
            else:
                print(f"         {n1}: Colour: {c[n1]}")
        lc = len(set(c.values()))
        print(f"    #Nodes: {len(c)}\n    #Edges: {len(e)}\n  #Colours: {lc}")

def first_avail_int(data):
    "return lowest int 0... not in data"
    d = set(data)
    for i in count():
        if i not in d:
            return i

if __name__ == '__main__':
    for name, connections in [
            ('Ex1', "0-1 1-2 2-0 3"),
            ('Ex2', "1-6 1-7 1-8 2-5 2-7 2-8 3-5 3-6 3-8 4-5 4-6 4-7"),
            ('Ex3', "1-4 1-6 1-8 3-2 3-6 3-8 5-2 5-4 5-8 7-2 7-4 7-6"),
            ('Ex4', "1-6 7-1 8-1 5-2 2-7 2-8 3-5 6-3 3-8 4-5 4-6 4-7"),
            ]:
        g = Graph(name, connections)
        g.greedy_colour()


sub GraphNodeColor(@RAW) {
   my %OneMany = my %NodeColor;
   for @RAW { %OneMany{$_[0]}.push: $_[1] ; %OneMany{$_[1]}.push: $_[0] }
   my @ColorPool = "0", "1" … ^+%OneMany.elems; # as string
   my %NodePool  = %OneMany.BagHash; # this DWIM is nice
   if %OneMany<NaN>:exists { %NodePool{$_}:delete for %OneMany<NaN>, NaN } # pending
   while %NodePool.Bool {
      my $color = @ColorPool.shift;
      my %TempPool = %NodePool;
      while (my \n = %TempPool.keys.sort.first) {
         %NodeColor{n} = $color;
         %TempPool{n}:delete;
         %TempPool{$_}:delete for @(%OneMany{n}) ; # skip neighbors as well
         %NodePool{n}:delete;
      }
   }
   if %OneMany<NaN>:exists { # islanders use an existing color
      %NodeColor{$_} = %NodeColor.values.sort.first for @(%OneMany<NaN>)
   }
   return %NodeColor
}

my \DATA = [
   [<0 1>,<1 2>,<2 0>,<3 NaN>,<4 NaN>,<5 NaN>],
   [<1 6>,<1 7>,<1 8>,<2 5>,<2 7>,<2 8>,<3 5>,<3 6>,<3 8>,<4 5>,<4 6>,<4 7>],
   [<1 4>,<1 6>,<1 8>,<3 2>,<3 6>,<3 8>,<5 2>,<5 4>,<5 8>,<7 2>,<7 4>,<7 6>],
   [<1 6>,<7 1>,<8 1>,<5 2>,<2 7>,<2 8>,<3 5>,<6 3>,<3 8>,<4 5>,<4 6>,<4 7>],
];

for DATA {
   say "DATA   : ", $_;
   say "Result : ";
   my %out = GraphNodeColor $_;
   say "$_[0]-$_[1]:\t Color %out{$_[0]} ",$_[1].isNaN??''!!%out{$_[1]} for @$_;
   say "Nodes  : ", %out.keys.elems;
   say "Edges  : ", $_.elems;
   say "Colors : ", %out.values.Set.elems;
}


see "h(1) = 1" + nl
for nr = 1 to 19
     see "h(" + (nr+1) + ") = " + hamming(nr) + nl
next
see "h(1691) = " + hamming(1690) + nl
see nl

func hamming limit
     h = list(1690)
     h[1] =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]  i = i +1  x2 =2 *h[i] ok
         if x3 = h[n]  j = j +1  x3 =3 *h[j] ok
         if x5 = h[n]  k = k +1  x5 =5 *h[k] ok
     next
     hamming = h[limit]
     return hamming


BEGIN # calculate values of the Goldbach function G where G(n) is the number #
      # of prime pairs that sum to n, n even and > 2                         #
      # generates an ASCII scatter plot of G(n) up to G(2000)                #
      # (Goldbach's Comet)                                                   #
    PR read "primes.incl.a68" PR          # include prime utilities          #
    INT max prime = 1 000 000;            # maximum number we will consider  #
    INT max plot  =     2 000;            # maximum G value for the comet    #
    []BOOL prime = PRIMESIEVE max prime;  # sieve of primes to max prime     #
    [ 0 : max plot ]INT g2;               # table of G values: g2[n] = G(2n) #
    # construct the table of G values #
    FOR n FROM LWB g2 TO UPB g2 DO g2[ n ] := 0 OD;
    g2[ 4 ] := 1;                     # 4 is the only sum of two even primes #
    FOR p FROM 3 BY 2 TO max plot OVER 2 DO
        IF prime[ p ] THEN
            g2[ p + p ] +:= 1;
            FOR q FROM p + 2 BY 2 TO max plot - p DO
                IF prime[ q ] THEN
                    g2[ p + q ] +:= 1
                FI
            OD
        FI
    OD;
    # show the first hundred G values #
    INT c := 0;
    FOR n FROM 4 BY 2 TO 202 DO
        print( ( whole( g2[ n ], -4 ) ) );
        IF ( c +:= 1 ) = 10 THEN print( ( newline ) ); c := 0 FI
    OD;
    # show G( 1 000 000 ) #
    INT gm := 0;
    FOR p FROM 3 TO max prime OVER 2 DO
        IF prime[ p ] THEN
            IF prime[ max prime - p ] THEN
                gm +:= 1
            FI
        FI
    OD;
    print( ( "G(", whole( max prime, 0 ), "): ", whole( gm, 0 ), newline ) );
    # find the maximum value of G up to the maximum plot size #
    INT max g := 0;
    FOR n FROM 2 BY 2 TO max plot DO
        IF g2[ n ] > max g THEN max g := g2[ n ] FI
    OD;
    # draw an ASCII scatter plot of G, each position represents 5 G values #
    # the vertical axis is n/10, the horizontal axis is G(n) #
    INT plot step = 10;
    STRING plot value = " .-+=*%$&#@";
    FOR g FROM 0 BY plot step TO max plot - plot step DO
        [ 0 : max g ]INT values;
        FOR v pos FROM LWB values TO UPB values DO values[ v pos ] := 0 OD;
        INT max v := 0;
        FOR g element FROM g BY 2 TO g + ( plot step - 1 ) DO
            INT g2 value = g2[ g element ];
            values[ g2 value ] +:= 1;
            IF g2 value > max v THEN max v := g2 value FI
        OD;
        print( ( IF g MOD 100 = 90 THEN "+" ELSE "|" FI ) );
        FOR v pos FROM 1 TO max v DO # exclude 0 values from the plot #
            print( ( plot value[ values[ v pos ] + 1 ] ) )
        OD;
        print( ( newline ) )
    OD
END


(defn max-subseq-sum [coll]
  (->> (take-while seq (iterate rest coll)) ; tails
       (mapcat #(reductions conj [] %)) ; inits
       (apply max-key #(reduce + %)))) ; max sum


max_sum_seq = (sequence) ->
  # This runs in linear time.
  [sum_start, sum, max_sum, max_start, max_end] = [0, 0, 0, 0, 0]
  for n, i in sequence
    sum += n
    if sum > max_sum
      max_sum = sum
      max_start = sum_start
      max_end = i + 1
    if sum < 0 # start new sequence
      sum = 0
      sum_start = i + 1
  sequence[max_start...max_end]

# tests
console.log max_sum_seq [-1, 0, 15, 3, -9, 12, -4]
console.log max_sum_seq [-1]
console.log max_sum_seq [4, -10, 3]


import "/dynamic" for Struct
import "/sort" for Sort
import "/fmt" for Fmt

// (n)umber of node and its (v)alence i.e. number of neighbors
var NodeVal = Struct.create("NodeVal", ["n", "v"])

class Graph {
    construct new(nn, st) {
        _nn  = nn                       // number of nodes
        _st  = st                       // node numbering starts from
        _nbr = List.filled(nn, null)    // neighbor list for each node
        for (i in 0...nn) _nbr[i] = []
    }

    nn { _nn }
    st { _st }

    // Note that this creates a single 'virtual' edge for an isolated node.
    addEdge(n1, n2) {
        // adjust to starting node number
        n1 = n1 - _st
        n2 = n2 - _st
        _nbr[n1].add(n2)
        if (n1 != n2) _nbr[n2].add(n1)
    }

    // Uses 'greedy' algorithm.
    greedyColoring {
        // create a list with a color for each node
        var cols = List.filled(_nn, -1) // -1 denotes no color assigned
        cols[0] = 0  // first node assigned color 0
        // create a bool list to keep track of which colors are available
        var available = List.filled(_nn, false)
        // assign colors to all nodes after the first
        for (i in 1..._nn) {
            // iterate through neighbors and mark their colors as available
            for (j in _nbr[i]) {
                if (cols[j] != -1) available[cols[j]] = true
            }
            // find the first available color
            var c = available.indexOf(false)
            cols[i] = c  // assign it to the current node
            // reset the neighbors' colors to unavailable
            // before the next iteration
            for (j in _nbr[i]) {
                if (cols[j] != -1) available[cols[j]] = false
            }
        }
        return cols
    }

    // Uses Welsh-Powell algorithm.
    wpColoring {
        // create NodeVal for each node
        var nvs = List.filled(_nn, null)
        for (i in 0..._nn) {
            var v = _nbr[i].count
            if (v == 1 && _nbr[i][0] == i) {  // isolated node
                v = 0
            }
            nvs[i] = NodeVal.new(i, v)
        }
        // sort the NodeVals in descending order by valence
        var cmp = Fn.new { |nv1, nv2| (nv2.v - nv1.v).sign }
        Sort.insertion(nvs, cmp) // stable sort

        // create colors list with entries for each node
        var cols = List.filled(_nn, -1)  // set all nodes to no color (-1) initially
        var currCol = 0 // start with color 0
        for (f in 0..._nn-1) {
            var h = nvs[f].n
            if (cols[h] != -1) {  // already assigned a color
                continue
            }
            cols[h] = currCol
            // assign same color to all subsequent uncolored nodes which are
            // not connected to a previous colored one
            var i = f + 1
            while (i < _nn) {
                var outer = false
                var j = nvs[i].n
                if (cols[j] != -1) {  // already colored
                    i = i + 1
                    continue
                }
                var k = f
                while (k < i) {
                    var l = nvs[k].n
                    if (cols[l] == -1) {  // not yet colored
                        k = k + 1
                        continue
                    }
                    if (_nbr[j].contains(l)) {
                        outer = true
                        break  // node j is connected to an earlier colored node
                    }
                    k = k + 1
                }
                if (!outer) cols[j] = currCol
                i = i + 1
            }
            currCol = currCol + 1
        }
        return cols
    }
}

var fns = [Fn.new { |g| g.greedyColoring }, Fn.new { |g| g.wpColoring }]
var titles = ["'Greedy'", "Welsh-Powell"]
var nns = [4, 8, 8, 8]
var starts = [0, 1, 1, 1]
var edges1 = [[0, 1], [1, 2], [2, 0], [3, 3]]
var edges2 = [[1, 6], [1, 7], [1, 8], [2, 5], [2, 7], [2, 8],
    [3, 5], [3, 6], [3, 8], [4, 5], [4, 6], [4, 7]]
var edges3 = [[1, 4], [1, 6], [1, 8], [3, 2], [3, 6], [3, 8],
    [5, 2], [5, 4], [5, 8], [7, 2], [7, 4], [7, 6]]
var edges4 = [[1, 6], [7, 1], [8, 1], [5, 2], [2, 7], [2, 8],
    [3, 5], [6, 3], [3, 8], [4, 5], [4, 6], [4, 7]]
var j = 0
for (fn in fns) {
    System.print("Using the %(titles[j]) algorithm:\n")
    var i = 0
    for (edges in [edges1, edges2, edges3, edges4]) {
        System.print("  Example %(i+1)")
        var g = Graph.new(nns[i], starts[i])
        for (e in edges) g.addEdge(e[0], e[1])
        var cols = fn.call(g)
        var ecount = 0  // counts edges
        for (e in edges) {
            if (e[0] != e[1]) {
                Fmt.print("    Edge  $d-$d -> Color $d, $d", e[0], e[1],
                    cols[e[0]-g.st], cols[e[1]-g.st])
                ecount = ecount + 1
            } else {
                Fmt.print("    Node  $d   -> Color $d\n", e[0], cols[e[0]-g.st])
            }
        }
        var maxCol = 0  // maximum color number used
        for (col in cols) {
            if (col > maxCol) maxCol = col
        }
        System.print("    Number of nodes  : %(nns[i])")
        System.print("    Number of edges  : %(ecount)")
        System.print("    Number of colors : %(maxCol+1)")
        System.print()
        i = i + 1
    }
    j = j + 1
}


hamming = Enumerator.new do |yielder|
  next_ham = 1
  queues = [[ 2, []], [3, []], [5, []] ]

  loop do
    yielder << next_ham   # or: yielder.yield(next_ham)

    queues.each {|m,queue| queue << next_ham * m}
    next_ham = queues.collect{|m,queue| queue.first}.min
    queues.each {|m,queue| queue.shift if queue.first==next_ham}
  end
end


G: function [n][
    size select 2..n/2 'x ->
        and? [prime? x][prime? n-x]
]

print "The first 100 G values:"
loop split.every: 10 map select 4..202 => even? => G 'row [
    print map to [:string] row 'item -> pad item 3
]

print ["\nG(1000000) =" G 1000000]

csv: join.with:",\n" map select 4..2000 => even? 'x ->
    ~"|x|, |G x|"

; write the CSV data to a file which we can then visualize
; via our preferred spreadsheet app
write "comet.csv" csv


# syntax: GAWK -f GOLDBACHS_COMET.AWK
BEGIN {
    print("The first 100 G numbers:")
    for (n=4; n<=202; n+=2) {
      printf("%4d%1s",g(n),++count%10?"":"\n")
    }
    n = 1000000
    printf("\nG(%d): %d\n",n,g(n))
    n = 4
    printf("G(%d): %d\n",n,g(n))
    n = 22
    printf("G(%d): %d\n",n,g(n))
    exit(0)
}
function g(n,  count,i) {
    if (n % 2 == 0) { # n must be even
      for (i=2; i<=(1/2)*n; i++) {
        if (is_prime(i) && is_prime(n-i)) {
          count++
        }
      }
    }
    return(count)
}
function is_prime(n,  d) {
    d = 5
    if (n < 2) { return(0) }
    if (n % 2 == 0) { return(n == 2) }
    if (n % 3 == 0) { return(n == 3) }
    while (d*d <= n) {
      if (n % d == 0) { return(0) }
      d += 2
      if (n % d == 0) { return(0) }
      d += 4
    }
    return(1)
}


Function isPrime(Byval ValorEval As Uinteger) As Boolean
    If ValorEval <= 1 Then Return False
    For i As Integer = 2 To Int(Sqr(ValorEval))
        If ValorEval Mod i = 0 Then Return False
    Next i
    Return True
End Function

Function g(n As Uinteger) As Uinteger
    Dim As Uinteger i, count = 0
    If (n Mod 2 = 0) Then     'n in goldbach function g(n) must be even
        For i = 2 To (1/2) * n
            If isPrime(i) And isPrime(n - i) Then count += 1
        Next i
    End If
    Return count
End Function

Print "The first 100 G numbers are:"

Dim As Uinteger col = 1
For n As Uinteger = 4 To 202 Step 2
    Print Using "####"; g(n);
    If (col Mod 10 = 0) Then Print
    col += 1
Next n

Print !"\nThe value of G(1000000) is "; g(1000000)
Sleep


(defun max-subseq (list)
  (let ((best-sum 0) (current-sum 0) (end 0))
    ;; determine the best sum, and the end of the max subsequence
    (do ((list list (rest list))
         (i 0 (1+ i)))
        ((endp list))
      (setf current-sum (max 0 (+ current-sum (first list))))
      (when (> current-sum best-sum)
        (setf end i
              best-sum current-sum)))
    ;; take the subsequence of list ending at end, and remove elements
    ;; from the beginning until the subsequence sums to best-sum.
    (let* ((sublist (subseq list 0 (1+ end)))
           (sum (reduce #'+ sublist)))
      (do ((start 0 (1+ start))
           (sublist sublist (rest sublist))
           (sum sum (- sum (first sublist))))
          ((or (endp sublist) (eql sum best-sum))
           (values best-sum sublist start (1+ end)))))))


fcn colorGraph(nodeStr){	// "0-1 1-2 2-0 3"
   numEdges,graph := 0,Dictionary();  // ( 0:(1,2), 1:L(0,2), 2:(1,0), 3:() )
   foreach n in (nodeStr.split(" ")){ // parse string to graph
      n=n - " ";
      if(n.holds("-")){
	 a,b := n.split("-");	// keep as string
	 graph.appendV(a,b); graph.appendV(b,a);
	 numEdges+=1;
      }
      else graph[n]=T;		// island
   }
   colors,colorPool := Dictionary(), ["A".."Z"].walk();
   graph.pump(Void,'wrap([(node,nbrs)]){  // ( "1",(0,2), "3",() )
      clrs:=colorPool.copy();	// all colors are available, then remove neighbours
      foreach i in (nbrs){ clrs.remove(colors.find(i)) }  // if nbr has color, color not available
      colors[node] = clrs[0];	// first available remaining color
   });
   return(graph,colors,numEdges)
}


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

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

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessResult:  .ascii "Max number is =  @ rank = @ address (hexa) = @ \n"      // message result

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

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:         .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                        // entry of program
    ldr x1,qAdrtTableNumbers
    mov x2,0
    ldr x4,[x1,x2,lsl #3]    // load first number
    mov x3,x2                // save first indice
    add x2,x2,1              // increment indice
1:
    cmp x2,#NBRANKTABLE      // indice ? maxi
    bge 2f                   // yes -> end search
    ldr x0,[x1,x2,lsl #3]    // load other number
    cmp x0,x4                // > old number max
    csel x4,x0,x4,gt         // if > x4 = x0 else x4=x4
    csel x3,x2,x3,gt         // if > x3 = x2 else x3=x3
    add x2,x2,1              // increment indice
    b 1b                     // and loop

2:
    mov x0,x4
    ldr x1,qAdrsZoneConv
    bl conversion10S         // decimal conversion
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc    // insert result at first @ character
    mov x5,x0                // save address message
    mov x0,x3
    ldr x1,qAdrsZoneConv     // conversion rank maxi
    bl conversion10S         // decimal conversion
    mov x0,x5                // message address
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc    // insert result at Second @ character
    mov x5,x0                // save message address
    ldr x0,qAdrtTableNumbers
    lsl x3,x3,3
    add x0,x0,x3
    ldr x1,qAdrsZoneConv     // conversion address maxi
    bl conversion16          // hexa conversion
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc    // insert result at third @ character
    bl affichageMess         // display message final

100:                         // standard end of the program
    mov x0,0                 // return code
    mov x8,EXIT              // request to exit program
    svc 0                    // perform the system call
qAdrtTableNumbers:    .quad  tTableNumbers
qAdrszMessResult:     .quad szMessResult
qAdrsZoneConv:        .quad sZoneConv

/******************************************************************/
/*     conversion  hexadecimal register                           */
/******************************************************************/
/* x0 contains value and x1 address zone receptrice   */
conversion16:
    stp x0,lr,[sp,-48]!        // save  registres
    stp x1,x2,[sp,32]          // save  registres
    stp x3,x4,[sp,16]          // save  registres
    mov x2,#60                 // start bit position
    mov x4,#0xF000000000000000 // mask
    mov x3,x0                  // save entry value
1:                             // start loop
    and x0,x3,x4               // value register and mask
    lsr x0,x0,x2               // right shift
    cmp x0,#10                 // >= 10 ?
    bge 2f                     // yes
    add x0,x0,#48              // no is digit
    b 3f
2:
    add x0,x0,#55              // else is a letter A-F
3:
    strb w0,[x1],#1            // load result  and + 1 in address
    lsr x4,x4,#4               // shift mask 4 bits left
    subs x2,x2,#4              // decrement counter 4 bits <= zero  ?
    bge 1b                     // no -> loop

100:                           // fin standard de la fonction
    ldp x3,x4,[sp,16]          // restaur des  2 registres
    ldp x1,x2,[sp,32]          // restaur des  2 registres
    ldp x0,lr,[sp],48          // restaur des  2 registres
    ret
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


F gray_encode(n)
   R n (+) n >> 1

F gray_decode(=n)
   V m = n >> 1
   L m != 0
      n (+)= m
      m >>= 1
   R n

print(‘DEC,   BIN =>  GRAY => DEC’)
L(i) 32
   V gray = gray_encode(i)
   V dec = gray_decode(gray)
   print(‘ #2, #. => #. => #2’.format(i, bin(i).zfill(5), bin(gray).zfill(5), dec))


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

print
print "Hamming List First(1691)   =";chr$(9);hamming(1691)
print "Hamming List Last(1000000) =";chr$(9);hamming(1000000)

end

function hamming(limit)
    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)
        if x3 = h(n) then j = j +1: x3 =3 *h(j)
        if x5 = h(n) then k = k +1: x5 =5 *h(k)
    next n
    hamming = h(limit -1)
end function


using Combinatorics
using Plots
using Primes

g(n) = iseven(n) ? count(p -> all(isprime, p), partitions(n, 2)) : error("n must be even")

println("The first 100 G numbers are: ")

foreach(p -> print(lpad(p[2], 4), p[1] % 10 == 0 ? "\n" : ""), map(g, 4:2:202) |> enumerate)

println("\nThe value of G(1000000) is ", g(1_000_000))

x = collect(2:2002)
y = map(g, 2x)
scatter(x, y, markerstrokewidth = 0, color = ["red", "blue", "green"][mod1.(x, 3)])


function T(t) return setmetatable(t, {__index=table}) end
table.range = function(t,n) local s=T{} for i=1,n do s[i]=i end return s end
table.map = function(t,f) local s=T{} for i=1,#t do s[i]=f(t[i]) end return s end
table.batch = function(t,n,f) for i=1,#t,n do local s=T{} for j=1,n do s[j]=t[i+j-1] end f(s) end return t end

function isprime(n)
  if n < 2 then return false end
  if n % 2 == 0 then return n==2 end
  if n % 3 == 0 then return n==3 end
  for f = 5, n^0.5, 6 do
    if n%f==0 or n%(f+2)==0 then return false end
  end
  return true
end

function goldbach(n)
  local count = 0
  for i = 1, n/2 do
    if isprime(i) and isprime(n-i) then
      count = count + 1
    end
  end
  return count
end

print("The first 100 G numbers:")
g = T{}:range(100):map(function(n) return goldbach(2+n*2) end)
g:map(function(n) return string.format("%2d ",n) end):batch(10,function(t) print(t:concat()) end)
print("G(1000000) = "..goldbach(1000000))


MODULE OvctGreatestSubsequentialSum;
IMPORT StdLog, Strings, Args;

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

PROCEDURE Do*;
VAR
	p: Args.Params;
	iseq: POINTER TO ARRAY OF INTEGER;
	i, res, start, end, sum: INTEGER;
BEGIN
	Args.Get(p); (* Get Params *)
	NEW(iseq,p.argc);
	(* Transform params to INTEGERs *)
	FOR i := 0 TO p.argc - 1 DO
		Strings.StringToInt(p.args[i],iseq[i],res)
	END;
	Gss(iseq,start,end,sum);
	StdLog.String("[");
	FOR i := start TO  end DO
		StdLog.Int(iseq[i]);
		IF i < end THEN StdLog.String(",") END
	END;
	StdLog.String("]=");StdLog.Int(sum);StdLog.Ln;
END Do;

END OvctGreatestSubsequentialSum.


(defun maximum (xs)
   (if (endp (rest xs))
       (first xs)
       (max (first xs)
            (maximum (rest xs)))))


BYTE FUNC Max(BYTE ARRAY tab BYTE size)
  BYTE i,res

  res=tab(0)
  FOR i=1 TO size-1
  DO
    IF res<tab(i) THEN
      res=tab(i)
    FI
  OD
RETURN (res)

PROC Main()
  BYTE i,m,size=[20]
  BYTE ARRAY tab(size)

  FOR i=0 TO size-1
  DO
    tab(i)=Rand(0)
  OD

  Print("Array:")
  FOR i=0 TO size-1
  DO
    PrintF(" %I",tab(i))
  OD
  PutE()

  m=Max(tab,size)
  PrintF("Greatest: %I%E",m)
RETURN


		org	100h
		xra	a	; set A=0
loop:		push	psw	; print number as decimal
		call	decout
		call	padding	; print padding
		pop	psw
		push	psw
		call	binout	; print number as binary
		call	padding
		pop	psw
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		mov	b,a	; gray encode
		ana	a	; clear carry
		rar		; shift right
		xra	b	; xor the original
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		push	psw
		call	binout	; print gray number as binary
		call	padding
		pop	psw
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		mov	b,a	; gray decode
decode:		ana	a	; clear carry
		jz	done	; when no more bits are left, stop
		rar		; shift right
		mov	c,a	; keep that value
		xra	b	; xor into output value
		mov	b,a	; that is the output value
		mov	a,c	; restore intermediate
		jmp	decode	; do next bit
done:		mov	a,b	; give output value
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		push	psw
		call	binout	; print decoded number as binary
		call	padding
		pop	psw
		push	psw
		call	decout	; print decoded number as decimal
		lxi	d,nl
		call	strout
		pop	psw
		inr	a	; next number
		ani	1fh	; are we there yet?
		jnz	loop	; if not, do next number
		ret
		;; Print A as two-digit number
decout:		mvi	c,10
		call	dgtout
		mvi	c,1
dgtout:		mvi	e,'0' - 1
dgtloop:	inr	e
		sub	c
		jnc	dgtloop
		add	c
		push	psw
		mvi	c,2
		call	5
		pop	psw
		ret
		;; Print A as five-bit binary number
binout:		ani	1fh
		ral
		ral
		ral
		mvi	c,5
binloop:	ral
		push	psw
		push	b
		mvi	c,2
		mvi	a,0
		aci	'0'
		mov	e,a
		call	5
		pop	b
		pop	psw
		dcr	c
		jnz	binloop
		ret
		;; Print padding
padding:	lxi	d,arrow
strout:		mvi	c,9
		jmp	5
arrow:		db	' ==> $'
nl:		db	13,10,'$'


PROC ToBinaryStr(BYTE n CHAR ARRAY s)
  BYTE i

  s(0)=8 i=8
  SetBlock(s+1,8,'0)
  WHILE n
  DO
    s(i)=(n&1)+'0
    n==RSH 1
    i==-1
  OD
RETURN

PROC PrintB2(BYTE n)
  IF n<10 THEN Put(32) FI
  PrintB(n)
RETURN

PROC PrintBin5(BYTE n)
  CHAR ARRAY s(9),sub(6)

  ToBinaryStr(n,s)
  SCopyS(sub,s,4,s(0))
  Print(sub)
RETURN

BYTE FUNC Encode(BYTE n)
RETURN (n XOR (n RSH 1))

BYTE FUNC Decode(BYTE n)
  BYTE res

  res=n
  DO
    n==RSH 1
    IF n THEN
      res==XOR n
    ELSE
      EXIT
    FI
  OD
RETURN (res)

PROC Main()
  BYTE i,g,b
  CHAR ARRAY sep=" -> "

  FOR i=0 TO 31
  DO
    PrintB2(i) Print(sep)
    PrintBin5(i) Print(sep)
    g=Encode(i)
    PrintBin5(g) Print(sep)
    b=Decode(g)
    PrintBin5(b) Print(sep)
    PrintB2(b) PutE()
  OD
RETURN


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

procedure Gray is

   Bits : constant := 5; -- Change only this line for 6 or 7-bit encodings
   subtype Values is Unsigned_8 range 0 .. 2 ** Bits - 1;
   package Values_Io is new Ada.Text_IO.Modular_IO (Values);

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

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

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


extern crate num;
num::bigint::BigUint;

use std::time::Instant;

fn basic_hamming(n: usize) -> BigUint {
    let two = BigUint::from(2u8);
    let three = BigUint::from(3u8);
    let five = BigUint::from(5u8);
    let mut h = vec![BigUint::from(0u8); n];
    h[0] = BigUint::from(1u8);
    let mut x2 = BigUint::from(2u8);
    let mut x3 = BigUint::from(3u8);
    let mut x5 = BigUint::from(5u8);
    let mut i = 0usize; let mut j = 0usize; let mut k = 0usize;

    // BigUint comparisons are expensive, so do it only as necessary...
    fn min3(x: &BigUint, y: &BigUint, z: &BigUint) -> (usize, BigUint) {
        let (cs, r1) = if y == z { (0x6, y) }
                        else if y < z { (2, y) } else { (4, z) };
        if x == r1 { (cs | 1, x.clone()) }
        else if x < r1 { (1, x.clone()) } else { (cs, r1.clone()) }
    }

    let mut c = 1;
    while c < n { // satisfy borrow checker with extra blocks: {  }
        let (cs, e1) = { min3(&x2, &x3, &x5) };
        h[c] = e1; // vector now owns the generated value
        if (cs & 1) != 0 { i += 1; x2 = &two * &h[i] }
        if (cs & 2) != 0 { j += 1; x3 = &three * &h[j] }
        if (cs & 4) != 0 { k += 1; x5 = &five * &h[k] }
        c += 1;
    }

    match h.pop() {
        Some(v) => v,
        _ => panic!("basic_hamming: arg is zero; no elements")
    }
}

fn main() {
    print!("[");
    for (i, h) in (1..21).map(basic_hamming).enumerate() {
        if i != 0 { print!(",") }
        print!(" {}", h)
    }
    println!(" ]");
    println!("{}", basic_hamming(1691));

    let strt = Instant::now();

    let rslt = basic_hamming(1000000);

    let elpsd = strt.elapsed();
    let secs = elpsd.as_secs();
    let millis = (elpsd.subsec_nanos() / 1000000)as u64;
    let dur = secs * 1000 + millis;

    let rs = rslt.to_str_radix(10);
    let mut s = rs.as_str();
    println!("{} digits:", s.len());
        while s.len() > 100 {
            let (f, r) = s.split_at(100);
            s = r;
            println!("{}", f);
        }
        println!("{}", s);

    println!("This last took {} milliseconds", dur);
}


ClearAll[GoldbachFuncion]
GoldbachFuncion[e_Integer] := Module[{ps},
  ps = Prime[Range[PrimePi[e/2]]];
  Total[Boole[PrimeQ[e - ps]]]
]
Grid[Partition[GoldbachFuncion /@ Range[4, 220, 2], 10]]
GoldbachFuncion[10^6]
DiscretePlot[GoldbachFuncion[e], {e, 4, 2000}, Filling -> None]


use strict;
use warnings;
use feature 'say';

use List::Util 'max';
use GD::Graph::bars;
use ntheory 'is_prime';

sub table { my $t = shift() * (my $c = 1 + max map {length} @_); ( sprintf( ('%'.$c.'s')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }

sub G {
    my($n) = @_;
    scalar grep { is_prime($_) and is_prime($n - $_) } 2 .. $n/2;
}

my @y;
push @y, G(2*$_ + 4) for my @x = 0..1999;

say $_ for table 10, @y;
printf "G $_: %d", G($_) for 1e6;

my @data = ( \@x, \@y);
my $graph = GD::Graph::bars->new(1200, 400);
$graph->set(
    title          => q/Goldbach's Comet/,
    y_max_value    => 170,
    x_tick_number  => 10,
    r_margin       => 10,
    dclrs          => [ 'blue' ],
) or die $graph->error;
my $gd = $graph->plot(\@data) or die $graph->error;

open my $fh, '>', 'goldbachs-comet.png';
binmode $fh;
print $fh $gd->png();
close $fh;


--
-- demo\rosetta\Goldbachs_comet.exw
-- ================================
--
-- Note: this plots n/2 vs G(n) for n=6 to 4000 by 2, matching wp and
--       Algol 68, Python, and Raku. However, while not wrong, Arturo
--       and Wren apparently plot n vs G(n) for n=6 to 2000 by 2, so
--       should you spot any (very) minor differences, that'd be why.
--
with javascript_semantics
requires("1.0.2")

constant limit = 4000
sequence primes = get_primes_le(limit)[2..$],
       goldbach = reinstate(repeat(0,limit),{4},{1})
for i=1 to length(primes) do
    for j=i to length(primes) do
        integer s = primes[i] + primes[j]
        if s>limit then exit end if
        goldbach[s] += 1
    end for
end for

sequence fhg = extract(goldbach,tagstart(4,100,2))
string fhgs = join_by(fhg,1,10," ","\n","%2d")
integer gm = sum(apply(sq_sub(1e6,get_primes_le(499999)[2..$]),is_prime))
printf(1,"The first 100 G values:\n%s\n\nG(1,000,000) = %,d\n",{fhgs,gm})

include pGUI.e
include IupGraph.e

function get_data(Ihandle /*graph*/)
    return {{tagset(limit/2,3,3),extract(goldbach,tagset(limit,6,6)),CD_RED},
            {tagset(limit/2,4,3),extract(goldbach,tagset(limit,8,6)),CD_BLUE},
            {tagset(limit/2,5,3),extract(goldbach,tagset(limit,10,6)),CD_DARK_GREEN}}
end function

IupOpen()
Ihandle graph = IupGraph(get_data,"RASTERSIZE=640x440,MARKSTYLE=PLUS")
IupSetAttributes(graph,"XTICK=%d,XMIN=0,XMAX=%d",{limit/20,limit/2})
IupSetAttributes(graph,"YTICK=20,YMIN=0,YMAX=%d",{max(goldbach)+20})
Ihandle dlg = IupDialog(graph,`TITLE="Goldbach's comet",MINSIZE=400x300`)
IupShow(dlg)
if platform()!=JS then
    IupMainLoop()
    IupClose()
end if


def subarray_sum(arr)
  max, slice = 0, [] of Int32
  arr.each_index do |i|
    (i...arr.size).each do |j|
      sum = arr[i..j].sum
      max, slice = sum, arr[i..j] if sum > max
    end
  end
  [max, slice]
end


import std.stdio;

inout(T[]) maxSubseq(T)(inout T[] sequence) pure nothrow @nogc {
    int maxSum, thisSum, i, start, end = -1;

    foreach (immutable j, immutable x; sequence) {
        thisSum += x;
        if (thisSum < 0) {
            i = j + 1;
            thisSum = 0;
        } else if (thisSum > maxSum) {
            maxSum = thisSum;
            start = i;
            end   = j;
        }
    }

    if (start <= end && start >= 0 && end >= 0)
        return sequence[start .. end + 1];
    else
        return [];
}

void main() {
    const a1 = [-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1];
    writeln("Maximal subsequence: ", a1.maxSubseq);

    const a2 = [-1, -2, -3, -5, -6, -2, -1, -4, -4, -2, -1];
    writeln("Maximal subsequence: ", a2.maxSubseq);
}


function max(... args):Number
{
	var curMax:Number = -Infinity;
	for(var i:uint = 0; i < args.length; i++)
		curMax = Math.max(curMax, args[i]);
	return curMax;
}


with Ada.Text_Io;

procedure Max_Test isco
   -- substitute any array type with a scalar element
   type Flt_Array is array (Natural range <>) of Float;

   -- Create an exception for the case of an empty array
   Empty_Array : Exception;

   function Max(Item : Flt_Array) return Float is
      Max_Element : Float := Float'First;
   begin
      if Item'Length = 0 then
         raise Empty_Array;
      end if;

      for I in Item'range loop
         if Item(I) > Max_Element then
            Max_Element := Item(I);
         end if;
      end loop;
      return Max_Element;
   end Max;

   Buf : Flt_Array := (-275.0, -111.19, 0.0, -1234568.0, 3.14159, -3.14159);
begin
   Ada.Text_IO.Put_Line(Float'Image(Max(Buf)));
end Max_Test;


integer
gray_encode(integer n)
{
    n ^ (n >> 1);
}

integer
gray_decode(integer n)
{
    integer p;

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

    p;
}


BEGIN
   OP GRAY = (BITS b) BITS : b XOR (b SHR 1);	CO Convert to Gray code CO
   OP YARG = (BITS g) BITS :			CO Convert from Gray code CO
   BEGIN
      BITS b := g, mask := g SHR 1;
      WHILE mask /= 2r0 DO b := b XOR mask; mask := mask SHR 1 OD;
      b
   END;
   FOR i FROM 0 TO 31 DO
      printf (($zd, ": ", 2(2r5d, " >= "), 2r5dl$, i, BIN i, GRAY BIN i, YARG GRAY BIN i))
   OD
END


#proto GrayEncode(_X_)
#synon _GrayEncode    *getGrayEncode
#proto GrayDecode(_X_)
#synon _GrayDecode    *getGrayDecode

#include <hbasic.h>

Begin
   Gray=0
   SizeBin(4)   // size 5 bits: 0->4
   Take (" #    BINARY   GRAY     DECODE\n")
   Take ("------------------------------\n"), and Print It
   For Up( i := 0, 31, 1)
      Print( LPad$(" ",2,Str$(i))," => ", Bin$(i)," => ")
      get Gray Encode(i) and Copy to (Gray), get Binary; then Take(" => ")
      now get Gray Decode( Gray ), get Binary, and Print It with a Newl
   Next
End

Subrutines

Gray Encode(n)
Return (XorBit( RShift(1,n), n ))

Gray Decode(n)
    p = n
    While ( n )
        n >>= 1
        p != n
    Wend
Return (p)


class Hamming extends Iterator[BigInt] {
  import scala.collection.mutable.Queue
  val qs = Seq.fill(3)(new Queue[BigInt])
  def enqueue(n: BigInt) = qs zip Seq(2, 3, 5) foreach { case (q, m) => q enqueue n * m }
  def next = {
    val n = qs map (_.head) min;
    qs foreach { q => if (q.head == n) q.dequeue }
    enqueue(n)
    n
  }
  def hasNext = true
  qs foreach (_ enqueue 1)
}


from matplotlib.pyplot import scatter, show
from sympy import isprime

def g(n):
    assert n > 2 and n % 2 == 0, 'n in goldbach function g(n) must be even'
    count = 0
    for i in range(1, n//2 + 1):
        if isprime(i) and isprime(n - i):
            count += 1
    return count

print('The first 100 G numbers are:')

col = 1
for n in range(4, 204, 2):
    print(str(g(n)).ljust(4), end = '\n' if (col % 10 == 0) else '')
    col += 1

print('\nThe value of G(1000000) is', g(1_000_000))

x = range(4, 4002, 2)
y = [g(i) for i in x]
colors = [["red", "blue", "green"][(i // 2) % 3] for i in x]
scatter([i // 2 for i in x], y, marker='.', color = colors)
show()


sub G (Int $n) { +(2..$n/2).grep: { .is-prime && ($n - $_).is-prime } }

# Task
put "The first 100 G values:\n", (^100).map({ G 2 × $_ + 4 }).batch(10)».fmt("%2d").join: "\n";

put "\nG 1_000_000 = ", G 1_000_000;

# Stretch
use SVG;
use SVG::Plot;

my @x = map 2 × * + 4, ^2000;
my @y = @x.map: &G;

'Goldbachs-Comet-Raku.svg'.IO.spurt: SVG.serialize: SVG::Plot.new(
    width       => 1000,
    height      => 500,
    background  => 'white',
    title       => "Goldbach's Comet",
    x           => @x,
    values      => [@y,],
).plot: :points;


pragma.enable("accumulator")

def maxSubseq(seq) {
  def size := seq.size()

  # Collect all intervals of indexes whose values are positive
  def intervals := {
    var intervals := []
    var first := 0
    while (first < size) {
      var next := first
      def seeing := seq[first] > 0
      while (next < size && (seq[next] > 0) == seeing) {
        next += 1
      }
      if (seeing) { # record every positive interval
        intervals with= first..!next
      }
      first := next
    }
    intervals
  }

  # For recording the best result found
  var maxValue := 0
  var maxInterval := 0..!0

  # Try all subsequences beginning and ending with such intervals.
  for firstIntervalIx => firstInterval in intervals {
    for lastInterval in intervals(firstIntervalIx) {
      def interval :=
        (firstInterval.getOptStart())..!(lastInterval.getOptBound())
      def value :=
        accum 0 for i in interval { _ + seq[i] }
      if (value > maxValue) {
        maxValue := value
        maxInterval := interval
      }
    }
  }

  return ["value" => maxValue,
          "indexes" => maxInterval]
}


T Colour
   Byte r, g, b

   F (r, g, b)
      .r = r
      .g = g
      .b = b

   F ==(other)
      R .r == other.r & .g == other.g & .b == other.b

V black = Colour(0, 0, 0)
V white = Colour(255, 255, 255)

T Bitmap
   Int width, height
   Colour background
   [[Colour]] map

   F (width = 40, height = 40, background = white)
      assert(width > 0 & height > 0)
      .width = width
      .height = height
      .background = background
      .map = (0 .< height).map(h -> (0 .< @width).map(w -> @@background))

   F fillrect(x, y, width, height, colour = black)
      assert(x >= 0 & y >= 0 & width > 0 & height > 0)
      L(h) 0 .< height
         L(w) 0 .< width
            .map[y + h][x + w] = colour

   F set(x, y, colour = black)
      .map[y][x] = colour

   F get(x, y)
      R .map[y][x]

   F togreyscale()
      L(h) 0 .< .height
         L(w) 0 .< .width
            V (r, g, b) = .get(w, h)
            V l = Int(0.2126 * r + 0.7152 * g + 0.0722 * b)
            .set(w, h, Colour(l, l, l))

   F writeppmp3()
      V magic = "P3\n"
      V comment = "# generated from Bitmap.writeppmp3\n"
      V s = magic‘’comment‘’("#. #.\n#.\n".format(.width, .height, 255))
      L(h) (.height - 1 .< -1).step(-1)
         L(w) 0 .< .width
            V (r, g, b) = .get(w, h)
            s ‘’= ‘   #3 #3 #3’.format(r, g, b)
         s ‘’= "\n"
      R s

V bitmap = Bitmap(4, 4, white)
bitmap.fillrect(1, 0, 1, 2, Colour(127, 0, 63))
bitmap.set(3, 3, Colour(0, 127, 31))
print(‘Colour:’)
print(bitmap.writeppmp3())
print(‘Grey:’)
bitmap.togreyscale()
print(bitmap.writeppmp3())


' 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


integer
lmax(list l)
{
    integer max, x;

    max = l[0];

    for (, x in l) {
        if (max < x) {
            max = x;
        }
    }

    max;
}


# substitute any array type with a scalar element #
MODE FLT = REAL;

# create an exception for the case of an empty array #
PROC raise empty array = VOID:(
  GO TO except empty array
);

PROC max = ([]FLT item)FLT:
BEGIN
   IF LWB item > UPB item THEN
      raise empty array; SKIP
   ELSE
     FLT max element := item[LWB item];

     FOR i FROM LWB item + 1 TO UPB item DO
       IF item[i] > max element THEN
         max element := item[i]
       FI
     OD;
     max element
   FI
END # max #;

test:(
  []FLT buf = (-275.0, -111.19, 0.0, -1234568.0, pi, -pi);
  print((max(buf),new line)) EXIT
  except empty array:
    SKIP
)


toGray: function [n]-> xor n shr n 1
fromGray: function [n][
    p: n
    while [n > 0][
        n: shr n 1
        p: xor p n
    ]
    return p
]

loop 0..31 'num [
    encoded: toGray num
    decoded: fromGray encoded

    print [
        pad to :string num 2 ":"
        pad as.binary num 5 "=>"
        pad as.binary encoded 5 "=>"
        pad as.binary decoded 5 ":"
        pad to :string decoded 2
    ]
]


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

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

BinString(n){
	Loop 5
		If ( n & ( 1 << (A_Index-1) ) )
			o := "1" . o
		else	o := "0" . o
	return o
}

Loop 32
	n:=A_Index-1, out .= n " : " BinString(n) " => " BinString(e:=gray_encode(n))
			. " => " BinString(gray_decode(e)) " => " BinString(n) "`n"
MsgBox % clipboard := out


(define-syntax lons
  (syntax-rules ()
    ((_ lar ldr) (delay (cons lar (delay ldr))))))

(define (lar lons)
  (car (force lons)))

(define (ldr lons)
  (force (cdr (force lons))))

(define (lap proc . llists)
  (lons (apply proc (map lar llists)) (apply lap proc (map ldr llists))))

(define (take n llist)
  (if (zero? n)
      (list)
      (cons (lar llist) (take (- n 1) (ldr llist)))))

(define (llist-ref n llist)
  (if (= n 1)
      (lar llist)
      (llist-ref (- n 1) (ldr llist))))

(define (merge llist-1 . llists)
  (define (merge-2 llist-1 llist-2)
    (cond ((null? llist-1) llist-2)
          ((null? llist-2) llist-1)
          ((< (lar llist-1) (lar llist-2))
           (lons (lar llist-1) (merge-2 (ldr llist-1) llist-2)))
          ((> (lar llist-1) (lar llist-2))
           (lons (lar llist-2) (merge-2 llist-1 (ldr llist-2))))
          (else (lons (lar llist-1) (merge-2 (ldr llist-1) (ldr llist-2))))))
  (if (null? llists)
      llist-1
      (apply merge (cons (merge-2 llist-1 (car llists)) (cdr llists)))))

(define hamming
  (lons 1
        (merge (lap (lambda (x) (* x 2)) hamming)
               (lap (lambda (x) (* x 3)) hamming)
               (lap (lambda (x) (* x 5)) hamming))))

(display (take 20 hamming))
(newline)
(display (llist-ref 1691 hamming))
(newline)
(display (llist-ref 1000000 hamming))
(newline)


import "./math" for Int
import "./trait" for Stepped
import "./fmt" for Fmt
import "io" for File

var limit = 2000
var primes = Int.primeSieve(limit-1).skip(1).toList
var goldbach = {4: 1}
for (i in Stepped.new(6..limit, 2)) goldbach[i] = 0
for (i in 0...primes.count) {
    for (j in i...primes.count) {
        var s = primes[i] + primes[j]
        if (s > limit) break
        goldbach[s] = goldbach[s] + 1
    }
}

System.print("The first 100 G values:")
var count = 0
for (i in Stepped.new(4..202, 2)) {
    count = count + 1
    Fmt.write("$2d ", goldbach[i])
    if (count % 10 == 0) System.print()
}

primes = Int.primeSieve(499999).skip(1)
var gm = 0
for (p in primes) {
    if (Int.isPrime(1e6 - p)) gm = gm + 1
}
System.print("\nG(1000000) = %(gm)")

// create .csv file for values up to 2000 for display by an external plotter
// the third field being the color (red = 0, blue = 1, green = 2)
File.create("goldbachs_comet.csv") { |file|
    for(i in Stepped.new(4..limit, 2)) {
        file.writeBytes("%(i), %(goldbach[i]), %(i/2 % 3)\n")
    }
}


func IsPrime(N); \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

int  PT(1_000_000);

func G(E);      \Ways E can be expressed as sum of two primes
int  E, C, I, J, T;
[C:= 0;  I:= 0;
loop    [J:= I;
        if PT(J) + PT(I) > E then return C;
        loop    [T:= PT(J) + PT(I);
                if T = E then C:= C+1;
                if T > E then quit;
                J:= J+1;
                ];
        I:= I+1;
        ];
];

int I, N;
[I:= 0; \make prime table
for N:= 2 to 1_000_000 do
        if IsPrime(N) then
                [PT(I):= N;  I:= I+1];
I:= 4;  \show first 100 G numbers
Format(4, 0);
for N:= 1 to 100 do
        [RlOut(0, float(G(I)));
        if rem(N/10) = 0 then CrLf(0);
        I:= I+2;
        ];
CrLf(0);
Text(0, "G(1,000,000) = ");  IntOut(0, G(1_000_000));
CrLf(0);
]


INCLUDE "H6:RGB2GRAY.ACT" ;from task Grayscale image

PROC PrintB3(BYTE x)
  IF x<10 THEN
    Print("  ")
  ELSEIF x<100 THEN
    Print(" ")
  FI
  PrintB(x)
RETURN

PROC PrintRgbImage(RgbImage POINTER img)
  BYTE x,y
  RGB c

  FOR y=0 TO img.h-1
  DO
    FOR x=0 TO img.w-1
    DO
      GetRgbPixel(img,x,y,c)
      Put(32)
      PrintB3(c.r) Put(32)
      PrintB3(c.g) Put(32)
      PrintB3(c.b) Put(32)
    OD
    PutE()
  OD
RETURN

PROC PrintGrayImage(GrayImage POINTER img)
  BYTE x,y,c

  FOR y=0 TO img.h-1
  DO
    FOR x=0 TO img.w-1
    DO
      c=GetGrayPixel(img,x,y)
      Put(32)
      PrintB3(c)
    OD
    PutE()
  OD
RETURN

PROC Main()
  BYTE ARRAY rgbdata=[
      0   0   0    0   0 255    0 255   0
    255   0   0    0 255 255  255   0 255
    255 255   0  255 255 255   31  63 127
     63  31 127  127  31  63  127  63  31]
  BYTE ARRAY graydata(12)
  BYTE width=[3],height=[4],LMARGIN=$52,oldLMARGIN
  RgbImage rgbimg
  GrayImage grayimg

  oldLMARGIN=LMARGIN
  LMARGIN=0 ;remove left margin on the screen
  Put(125) PutE() ;clear the screen
  InitRgbToGray()
  InitRgbImage(rgbimg,width,height,rgbdata)
  InitGrayImage(grayimg,width,height,graydata)

  PrintE("Original RGB image:")
  PrintRgbImage(rgbimg) PutE()

  RgbToGray(rgbimg,grayimg)
  PrintE("RGB to grayscale image:")
  PrintGrayImage(grayimg) PutE()

  GrayToRgb(grayimg,rgbimg)
  PrintE("Grayscale to RGB image:")
  PrintRgbImage(rgbimg)

  LMARGIN=oldLMARGIN ;restore left margin on the screen
RETURN


type Grayscale_Image is array (Positive range <>, Positive range <>) of Luminance;


w = 143
h = 188
name$ = "Mona_Lisa.jpg"
graphsize w,h
imgload w/2, h/2, name$
fastgraphics

for x = 0 to w-1
   for y = 0 to h-1
      p = pixel(x,y)
      b = p % 256
      p = p \256
      g = p % 256
      p = p \ 256
      r = p % 256
      l = 0.2126*r + 0.7152*g + 0.0722*b
      color rgb(l,l,l)
      plot x,y
   next y
   refresh
next x

imgsave "Grey_"+name$,"jpg"


      Width% = 200
      Height% = 200

      VDU 23,22,Width%;Height%;8,16,16,128
      *display c:\lena

      FOR y% = 0 TO Height%-1
        FOR x% = 0 TO Width%-1
          rgb% = FNgetpixel(x%,y%)
          r% = rgb% >> 16
          g% = (rgb% >> 8) AND &FF
          b% = rgb% AND &FF
          l% = INT(0.3*r% + 0.59*g% + 0.11*b% + 0.5)
          PROCsetpixel(x%,y%,l%,l%,l%)
        NEXT
      NEXT y%
      END

      DEF PROCsetpixel(x%,y%,r%,g%,b%)
      COLOUR 1,r%,g%,b%
      GCOL 1
      LINE x%*2,y%*2,x%*2,y%*2
      ENDPROC

      DEF FNgetpixel(x%,y%)
      LOCAL col%
      col% = TINT(x%*2,y%*2)
      SWAP ?^col%,?(^col%+2)
      = col%


typedef unsigned char luminance;
typedef luminance pixel1[1];
typedef struct {
   unsigned int width;
   unsigned int height;
   luminance *buf;
} grayimage_t;
typedef grayimage_t *grayimage;

grayimage alloc_grayimg(unsigned int, unsigned int);
grayimage tograyscale(image);
image tocolor(grayimage);


begin
    % simple list type                                                       %
    record IntList( integer val; reference(IntList) next );

    % find the maximum element of an IntList, returns 0 for an empty list    %
    integer procedure maxElement( reference(IntList) value list ) ;
        begin
            integer maxValue;
            reference(IntList) listPos;
            maxValue := 0;
            listPos  := list;
            if listPos not = null then begin
                % non-empty list                                             %
                maxValue := val(listPos);
                listPos  := next(listPos);
                while listPos not = null do begin
                    if val(listPos) > maxValue then maxValue := val(listPos);
                    listPos := next(listPos)
                end while_listPos_ne_null ;
            end if_listPos_ne_null ;
            maxValue
        end maxElement ;

    % test the maxElement procedure                                          %
    write( maxElement( IntList( -767, IntList( 2397, IntList( 204, null ) ) ) ) )

end.


#include <hopper.h>
main:
  lst=0
  max=0
  file="datos.txt"

  {","}             toksep
  {file}            statsfile
  {file}            load
                    mov        (lst)
  {0}               reshape    (lst)
  {lst}             array      (SORT)
  [end]             get        (lst)
                    mov        (max)
  {"Maximo = "}
  {max}
  {"\n"}            print
exit(0)


# Tested using GAWK

function bits2str(bits,        data, mask)
{
    # Source: https://www.gnu.org/software/gawk/manual/html_node/Bitwise-Functions.html
    if (bits == 0)
        return "0"

    mask = 1
    for (; bits != 0; bits = rshift(bits, 1))
        data = (and(bits, mask) ? "1" : "0") data

    while ((length(data) % 8) != 0)
        data = "0" data

    return data
}

function gray_encode(n){
    # Source: https://en.wikipedia.org/wiki/Gray_code#Converting_to_and_from_Gray_code
    return xor(n,rshift(n,1))
}

function gray_decode(n){
    # Source: https://en.wikipedia.org/wiki/Gray_code#Converting_to_and_from_Gray_code
    mask = rshift(n,1)
    while(mask != 0){
        n = xor(n,mask)
        mask = rshift(mask,1)
    }
    return n
}

BEGIN{
    for (i=0; i < 32; i++)
        printf "%-3s => %05d => %05d => %05d\n",i, bits2str(i),bits2str(gray_encode(i)), bits2str(gray_decode(gray_encode(i)))
}


:: Gray Code Task from Rosetta Code
:: Batch File Implementation

@echo off
rem -------------- define batch file macros with parameters appended
rem more info: https://www.dostips.com/forum/viewtopic.php?f=3&t=2518
setlocal disabledelayedexpansion	% == required for macro ==%
(set \n=^^^
%== this creates escaped line feed for macro ==%
)

rem convert to binary (unsigned)
rem argument: natnum bitlength outputvar
rem note: if natnum is negative, then !outputvar! is empty
set tobinary=for %%# in (1 2) do if %%#==2 (  %\n%
   for /f "tokens=1,2,3" %%a in ("!args!") do (  %\n%
      set "natnum=%%a"^&set "bitlength=%%b"^&set "outputvar=%%c")  %\n%
   set "!outputvar!="  %\n%
   if !natnum! geq 0 (  %\n%
      set "currnum=!natnum!"  %\n%
      for /l %%m in (1,1,!bitlength!) do (  %\n%
         set /a "bit=!currnum!%%2"  %\n%
         for %%v in (!outputvar!) do set "!outputvar!=!bit!!%%v!"  %\n%
         set /a "currnum/=2"  %\n%
      )  %\n%
   )  %\n%
) else set args=

goto :main-thing  %== jump to the main thing ==%
rem -------------- usual "call" sections
rem the sad disadvantage of using these is that they are slow (TnT)

rem gray code encoder
rem argument: natnum outputvar
:encoder
set /a "%~2=%~1^(%~1>>1)"
goto :eof

rem gray code decoder
rem argument: natnum outputvar
:decoder
set "inp=%~1" & set "%~2=0"
:while-loop-1
if %inp% gtr 0 (
   set /a "%~2^=%inp%, inp>>=1"
   goto while-loop-1
)
goto :eof

rem -------------- main thing
:main-thing
setlocal enabledelayedexpansion
echo(# -^> bin -^> enc -^> dec
for /l %%n in (0,1,31) do (
   %tobinary% %%n 5 bin
   call :encoder "%%n" "enc"
   %tobinary% !enc! 5 gray
   call :decoder "!enc!" "dec"
   %tobinary% !dec! 5 rebin
   echo(%%n -^> !bin! -^> !gray! -^> !rebin!
)
exit /b 0


$ include "seed7_05.s7i";
  include "bigint.s7i";

const func bigInteger: min (in bigInteger: a, in bigInteger: b, in bigInteger: c) is func
  result
    var bigInteger: min is 0_;
  begin
    if a < b then
      min := a;
    else
      min := b;
    end if;
    if c < min then
      min := c;
    end if;
  end func;

const func bigInteger: hamming (in integer: n) is func
  result
    var bigInteger: hammingNum is 1_;
  local
    var array bigInteger: hammingNums is 0 times 0_;
    var integer: index is 0;
    var bigInteger: x2 is 2_;
    var bigInteger: x3 is 3_;
    var bigInteger: x5 is 5_;
    var integer: i is 1;
    var integer: j is 1;
    var integer: k is 1;
  begin
    hammingNums := n times 1_;
    for index range 2 to n do
      hammingNum := min(x2, x3, x5);
      hammingNums[index] := hammingNum;
      if x2 = hammingNum then
        incr(i);
        x2 := 2_ * hammingNums[i];
      end if;
      if x3 = hammingNum then
        incr(j);
        x3 := 3_ * hammingNums[j];
      end if;
      if x5 = hammingNum then
        incr(k);
        x5 := 5_ * hammingNums[k];
      end if;
    end for;
  end func;

const proc: main is func
  local
    var integer: n is 0;
  begin
    for n range 1 to 20 do
      write(hamming(n) <& " ");
    end for;
    writeln;
    writeln(hamming(1691));
    writeln(hamming(1000000));
  end func;


(lib 'struct)
(struct result (score starter))

;; the score of  i in sequence ( .. i j ...)  is max (i , i + score (j))
;; to compute score of (a b .. x y z) :
;; start with score(z) and compute scores of y , z , ..c, b , a.
;; this is O(n)

;; return value of sub-sequence
(define (max-max L into: result)
(define value
	(if
	(empty? L) -Infinity
	(max (first L)  (+ (first L) (max-max (cdr L) result )))))

    (when (> value (result-score result))
		(set-result-score! result value) ;; remember best score
		(set-result-starter! result L))  ;; and its location
	value)

;; return (best-score (best sequence))
(define (max-seq L)
	(define best (result -Infinity null))
	(max-max L into: best)
	(define score (result-score best))

	(list score
	(for/list (( n (result-starter best)))
			   #:break (zero? score)
			   (set! score (- score n))
			   n)))

(define L '(-1 -2 3 5 6 -2 -1 4 -4 2 -1))
(max-seq L)
    → (15 (3 5 6 -2 -1 4))


Bitmap tImage = new Bitmap("spectrum.bmp");

for (int x = 0; x < tImage.Width; x++)
{
	for (int y = 0; y < tImage.Height; y++)
	{
		Color tCol = tImage.GetPixel(x, y);

		// L = 0.2126·R + 0.7152·G + 0.0722·B
		double L = 0.2126 * tCol.R + 0.7152 * tCol.G + 0.0722 * tCol.B;
		tImage.SetPixel(x, y, Color.FromArgb(Convert.ToInt32(L), Convert.ToInt32(L), Convert.ToInt32(L)));
	}
}

// Save
tImage.Save("spectrum2.bmp");


(import '[java.io File]
        '[javax.imageio ImageIO]
        '[java.awt Color]
        '[java.awt.image BufferedImage]))

(defn rgb-to-gray [color-image]
  (let [width (.getWidth color-image)]
    (partition width
               (for [x (range width)
                     y (range (.getHeight color-image))]
                 (let [rgb (.getRGB color-image x y)
                       rgb-object (new Color rgb)
                       r (.getRed rgb-object)
                       g (.getGreen rgb-object)
                       b (.getBlue rgb-object)
                       a (.getAlpha rgb-object)]
                   ;Compute the grayscale value an return it: L = 0.2126·R + 0.7152·G + 0.0722·B
                   (+ (* r 0.2126) (* g 0.7152) (* b 0.0722)))))))

(defn write-matrix-to-image [matrix filename]
  (ImageIO/write
   (let [height (count matrix)
         width (count (first matrix))
         output-image (new BufferedImage width height BufferedImage/TYPE_BYTE_GRAY)]
     (doseq [row-index    (range height)
             column-index (range width)]
       (.setRGB output-image column-index row-index (.intValue (nth (nth matrix row-index) column-index))))
     output-image)
   "png"
   (new File filename)))

(println
  (write-matrix-to-image
    (rgb-to-gray
      (ImageIO/read (new File "test.jpg")))
    "test-gray-cloj.png"))