function square(x)
    return x * x
end

function mean(a)
    local s = 0
    local c = 0
    for i,v in pairs(a) do
        s = s + v
        c = c + 1
    end
    return s / c
end

function averageSquareDiff(a, predictions)
    local results = {}
    for i,x in pairs(predictions) do
        table.insert(results, square(x - a))
    end
    return mean(results)
end

function diversityTheorem(truth, predictions)
    local average = mean(predictions)
    print("average-error: " .. averageSquareDiff(truth, predictions))
    print("crowd-error: " .. square(truth - average))
    print("diversity: " .. averageSquareDiff(average, predictions))
end

function main()
    diversityTheorem(49, {48, 47, 51})
    diversityTheorem(49, {48, 47, 51, 42})
end

main()


img:=PPM(640,480);
R:=100; R2:=R*R;           //radius, in pixels; radius squared
X0:=640/2; Y0:=480/2;      //coordinates of center of screen
foreach Y in ([-R..R]){    //for all the coordinates near the circle
   foreach X in ([-R..R]){ // which is under the sphere
      D2:=X*X + Y*Y;
      C:=0;                //default color is black
      if(D2<=R2){          //coordinate is inside circle under sphere
	 Z:=(R2-D2).toFloat().sqrt();//height of point on surface of sphere above X,Y
	 C=0x82+Z-(X+Y)/2; //color is proportional; offset X and Y, and
      }                    // shift color to upper limit of its range
      img[X+X0,Y+Y0]=C.shiftLeft(8)+C; //green + blue = cyan
   }
}
img.write(File("foo.ppm","wb"));


1 REM fast
50 REM spheer with hidden lines and rotation
100 CLS
110 PRINT "sphere with lenght&wide-circles"
120 PRINT "_______________________________"''
200 INPUT "rotate x-as:";a
210 INPUT "rotate y-as:";b
220 INPUT "rotate z-as:";c
225 INPUT "distance lines(10-45):";d
230 LET u=128: LET v=87: LET r=87: LET bm=PI/180: LET h=.5
240 LET s1=SIN (a*bm): LET s2=SIN (b*bm): LET s3=SIN (c*bm)
250 LET c1=COS (a*bm): LET c2=COS (b*bm): LET c3=COS (c*bm)
260 REM calc rotate matrix
270 LET ax=c2*c3: LET ay=-c2*s3: LET az=s2
280 LET bx=c1*s3+s1*s2*c3
290 LET by=c1*c3-s1*s2*s3: LET bz=-s1*c2
300 LET cx=s1*s3-c1*s2*c3
310 LET cy=s1*c3+c1*s2*s3: LET cz=c1*c2
400 REM draw outer
410 CLS : CIRCLE u,v,r
500 REM draw lenght-circle
510 FOR l=0 TO 180-d STEP d
515 LET f1=0
520 FOR p=0 TO 360 STEP 5
530 GO SUB 1000: REM xx,yy,zz calc
540 IF yy>0 THEN LET f2=0: LET f1=0: GO TO 580
550 LET xb=INT (u+xx+h): LET yb=INT (v+zz+h): LET f2=1
560 IF f1=0 THEN LET x1=xb: LET y1=yb: LET f1=1: GO TO 580
570 PLOT x1,y1: DRAW xb-x1,yb-y1: LET x1=xb: LET y1=yb: LET f1=f2
580 NEXT p
590 NEXT l
600 REM draw wide-circle
610 FOR p=-90+d TO 90-d STEP d
615 LET f1=0
620 FOR l=0 TO 360 STEP 5
630 GO SUB 1000: REM xx,yy,zz
640 IF yy>0 THEN LET f2=0: LET f1=0: GO TO 680
650 LET xb=INT (u+xx+h): LET yb=INT (v+zz+h): LET f2=1
660 IF f1=0 THEN LET x1=xb: LET y1=yb: LET f1=1: GO TO 680
670 PLOT x1,y1: DRAW xb-x1,yb-y1: LET x1=xb: LET y1=yb: LET f1=f2
680 NEXT l
690 NEXT p
700 PRINT #0;"...press any key...": PAUSE 0: RUN
999 REM sfere-coordinates>>>Cartesis Coordinate
1000 LET x=r*COS (p*bm)*COS (l*bm)
1010 LET y=r*COS (p*bm)*SIN (l*bm)
1020 LET z=r*SIN (p*bm)
1030 REM p(x,y,z) rotate to p(xx,yy,zz)
1040 LET xx=ax*x+ay*y+az*z
1050 LET yy=bx*x+by*y+bz*z
1060 LET zz=cx*x+cy*y+cz*z
1070 RETURN


use Collection;

class Program {
  function : Main(args : String[]) ~ Nil {
    list := List->New();
    list->AddFront("first");
    list->AddBack("last");
    list->Insert("middle");

    list->Forward();
    do {
      list->Get()->As(String)->PrintLine();
      list->Previous();
    }
    while(list->Get() <> Nil);
  }
}


Object Class new: DNode(value, mutable prev, mutable next)

DNode method: initialize  := next := prev := value ;
DNode method: value  @value ;
DNode method: prev  @prev ;
DNode method: next  @next ;
DNode method: setPrev := prev ;
DNode method: setNext  := next ;
DNode method: <<  @value << ;

DNode method: insertAfter(node)
   node setPrev(self)
   node setNext(@next)
   @next ifNotNull: [ @next setPrev(node) ]
   node := next ;

// Double linked list definition
Collection Class new: DList(mutable head, mutable tail)
DList method: head  @head ;
DList method: tail  @tail ;

DList method: insertFront(v)
| p |
   @head ->p
   DNode new(v, null, p) := head
   p ifNotNull: [ p setPrev(@head) ]
   @tail ifNull: [ @head := tail ] ;

DList method: insertBack(v)
| n |
   @tail ->n
   DNode new(v, n, null) := tail
   n ifNotNull: [ n setNext(@tail) ]
   @head ifNull: [ @tail := head ] ;

DList method: forEachNext
   dup ifNull: [ drop @head ifNull: [ false ] else: [ @head @head true] return ]
   next dup ifNull: [ drop false ] else: [ dup true ] ;

DList method: forEachPrev
   dup ifNull: [ drop @tail ifNull: [ false ] else: [ @tail @tail true] return ]
   prev dup ifNull: [ drop false ] else: [ dup true ] ;

: test      // ( -- aDList )
| dl dn |
   DList new ->dl
   dl insertFront("A")
   dl insertBack("B")
   dl head insertAfter(DNode new("C", null , null))
   dl ;


/* NetRexx */
options replace format comments java crossref symbols nobinary

ir = InetAddress
addresses = InetAddress[] InetAddress.getAllByName('www.kame.net')
loop ir over addresses
  if ir <= Inet4Address then do
    say 'IPv4 :' ir.getHostAddress
    end
  if ir <= Inet6Address then do
    say 'IPv6 :' ir.getHostAddress
    end
  end ir


(define (dnsLookup site , ipv)
    ;; captures current IPv mode
    (set 'ipv (net-ipv))
    ;; IPv mode agnostic lookup
    (println "IPv4: " (begin (net-ipv 4) (net-lookup site)))
    (println "IPv6: " (begin (net-ipv 6) (net-lookup site)))
    ;; returns newLISP to previous IPv mode
    (net-ipv ipv)
)

(dnsLookup "www.kame.net")


import nativesockets

iterator items(ai: ptr AddrInfo): ptr AddrInfo =
  var current = ai
  while current != nil:
    yield current
    current = current.aiNext

proc main() =
  let addrInfos = getAddrInfo("www.kame.net", Port 80, AfUnspec)
  defer: freeAddrInfo addrInfos

  for i in addrInfos:
    echo getAddrString i.aiAddr

when isMainModule: main()


MODULE DNSQuery;
IMPORT
  IO:Address,
  Out := NPCT:Console;

PROCEDURE Do() RAISES Address.UnknownHostException;
VAR
  ip: Address.Inet;
BEGIN
  ip := Address.GetByName("www.kame.net");
  Out.String(ip.ToString());Out.Ln
END Do;

BEGIN
  Do;
END DNSQuery.


use System.IO.Net;

class Rosetta {
  function : Main(args : String[]) ~ Nil {
    resoloved := TCPSocket->Resolve("www.kame.net");
    each(i : resoloved) {
      resoloved[i]->PrintLine();
    };
  }
}


# From Julia 1.0's online docs. File countheads.jl available to all machines:

function count_heads(n)
    c::Int = 0
    for i = 1:n
        c += rand(Bool)
    end
    c
end


$ ./bin/lfe
Erlang/OTP 17 [erts-6.2] [source] [64-bit] [smp:4:4] [async-threads:10] [hipe] [kernel-poll:false]

LFE Shell V6.2 (abort with ^G)
>


import os, nanomsg

proc sendMsg(s: cint, msg: string) =
  echo "SENDING \"",msg,"\""
  let bytes = s.send(msg.cstring, msg.len + 1, 0)
  assert bytes == msg.len + 1

proc recvMsg(s: cint) =
  var buf: cstring
  let bytes = s.recv(addr buf, MSG, 0)
  if bytes > 0:
    echo "RECEIVED \"",buf,"\""
    discard freemsg buf

proc sendRecv(s: cint, msg: string) =
  var to: cint = 100
  discard s.setSockOpt(SOL_SOCKET, RCVTIMEO, addr to, sizeof to)
  while true:
    s.recvMsg
    sleep 1000
    s.sendMsg msg

proc node0(url: string) =
  var s = socket(AF_SP, nanomsg.PAIR)
  assert s >= 0
  let res = s.bindd url
  assert res >= 0
  s.sendRecv "node0"
  discard s.shutdown 0

proc node1(url: string) =
  var s = socket(AF_SP, nanomsg.PAIR)
  assert s >= 0
  let res = s.connect url
  assert res >= 0
  s.sendRecv "node1"
  discard s.shutdown 0

if paramStr(1) == "node0":
  node0 paramStr(2)
elif paramStr(1) == "node1":
  node1 paramStr(2)


#import <Foundation/Foundation.h>
// our protocol allows "sending" "strings", but we can implement
// everything we could for a "local" object
@protocol ActionObjectProtocol
- (NSString *)sendMessage: (NSString *)msg;
@end


/* NetRexx */
options replace format comments java crossref symbols binary

import javax.swing.Timer

-- .+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
class RClockSwing public extends JFrame
  -- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
  properties constant
    K_TITLE = String "Clock"
    isTrue = boolean (1 == 1)
    isFalse = \isTrue
  properties inheritable
    content = Container

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method RClockSwing() public
    this(K_TITLE)
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method RClockSwing(title = String) public
    super(title)
    initFrame()
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method initFrame() private
    content = getContentPane()
    content.setLayout(BorderLayout())
    content.add(RClockSwing.Panel(), BorderLayout.CENTER)
    setResizable(isFalse)
    pack()
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method main(args = String[]) public static
    clockFace = JFrame
    clockFace = RClockSwing()
    clockFace.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE)
    clockFace.setVisible(isTrue)
    return

--..+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
class RClockSwing.Panel shared extends JPanel implements ActionListener
  properties constant
    degrees450 = double Math.PI * 2.5
    degrees006 = double Math.PI / 30.0
    degrees030 = double degrees006 * 5
    size = int 350
    spacing = int 10
    diameter = int size - 2 * spacing
    x1 = int diameter / 2 + spacing
    y1 = int diameter / 2 + spacing

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method Panel() public
    super()
    initPanel()
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method initPanel() public
    setPreferredSize(Dimension(size, size))
    setBackground(Color.WHITE)
    ptimer = Timer(1000, this)
    ptimer.start()
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method paintComponent(gr = Graphics) public
    super.paintComponent(gr)
    g2 = Graphics2D gr
    g2.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
    gr.setColor(Color.black)
    gr.drawOval(spacing, spacing, diameter, diameter)
    cdate = Calendar.getInstance()
    hours   = cdate.get(Calendar.HOUR)
    minutes = cdate.get(Calendar.MINUTE)
    seconds = cdate.get(Calendar.SECOND)
    angle = double degrees450 - (degrees006 * seconds)
    drawHand(gr, angle, int (diameter / 2 - 10), Color.red)
    minsecs = double (minutes + seconds / 60.0)
    angle = degrees450 - (degrees006 * minsecs)
    drawHand(gr, angle, int (diameter / 3), Color.black)
    hourmins = double (hours + minsecs / 60.0)
    angle = degrees450 - (degrees030 * hourmins)
    drawHand(gr, angle, int (diameter / 4), Color.black)
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method drawHand(gr = Graphics, angle = double, radius = int, color = Color) public
    x2 = x1 + (int (radius * Math.cos(angle)))
    y2 = y1 + (int (radius * Math.sin(-angle)))
    gr.setColor(color)
    gr.drawLine(x1, y1, x2, y2)
    return

  -- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  method actionPerformed(evt = ActionEvent) public
    repaint()
    return


real
dp(list a, list b)
{
    real p, v;
    integer i;

    p = 0;
    for (i, v in a) {
        p += v * b[i];
    }

    p;
}

integer
main(void)
{
    o_(dp(list(1r, 3r, -5r), list(4r, -2r, -1r)), "\n");

    0;
}


MODE DOTFIELD = REAL;
MODE DOTVEC = [1:0]DOTFIELD;

# The "Spread Sheet" way of doing a dot product:
  o Assume bounds are equal, and start at 1
  o Ignore round off error
#
PRIO SSDOT = 7;
OP SSDOT = (DOTVEC a,b)DOTFIELD: (
  DOTFIELD sum := 0;
  FOR i TO UPB a DO sum +:= a[i]*b[i] OD;
  sum
);

# An improved dot-product version:
  o Handles sparse vectors
  o Improves summation by gathering round off error
    with no additional multiplication - or LONG - operations.
#
OP * = (DOTVEC a,b)DOTFIELD: (
  DOTFIELD sum := 0, round off error:= 0;
  FOR i
# Assume bounds may not be equal, empty members are zero (sparse) #
    FROM LWB (LWB a > LWB b | a | b )
    TO UPB (UPB a < UPB b | a | b )
  DO
    DOTFIELD org = sum, prod = a[i]*b[i];
    sum +:= prod;
    round off error +:= sum - org - prod
  OD;
  sum - round off error
);

# Test: #
DOTVEC a=(1,3,-5), b=(4,-2,-1);

print(("a SSDOT b = ",fixed(a SSDOT b,0,real width), new line));
print(("a   *   b = ",fixed(a   *   b,0,real width), new line))


Const pi As Double = 4 * Atn(1)
Dim Shared As Double angulo = 0

Sub giro (grados As Double)
    angulo += grados*pi/180
End Sub

Sub dragon (longitud As Double, division As Integer, d As Double)
    If division = 0 Then
        Line - Step (Cos(angulo)*longitud, Sin(angulo)*longitud), Int(Rnd * 7)
    Else
        giro d*45
        dragon longitud/1.4142136, division-1, 1
        giro -d*90
        dragon longitud/1.4142136, division-1, -1
        giro d*45
    End If
End Sub

'--- Programa Principal ---
Screen 12
Pset (150,180), 0
dragon 400, 12, 1
Bsave "Dragon_curve_FreeBASIC.bmp",0
Sleep


ClearAll[DiversityPredictionTheorem]
DiversityPredictionTheorem[trueval_?NumericQ, estimates_List] :=
 Module[{avg, avgerr, crowderr, diversity},
  avg = Mean[estimates];
  avgerr = Mean[(estimates - trueval)^2];
  crowderr = (trueval - avg)^2;
  diversity = Mean[(estimates - avg)^2];
  <|
   "TrueValue" -> trueval,
   "CrowdEstimates" -> estimates,
   "AverageError" -> avgerr,
   "CrowdError" -> crowderr,
   "Diversity" -> diversity
   |>
  ]
DiversityPredictionTheorem[49, {48, 47, 51}] // Dataset
DiversityPredictionTheorem[49, {48, 47, 51, 42}] // Dataset


import strutils, math, stats

func meanSquareDiff(refValue: float; estimates: seq[float]): float =
  ## Compute the mean of the squares of the differences
  ## between estimated values and a reference value.
  for estimate in estimates:
    result += (estimate - refValue)^2
  result /= estimates.len.toFloat

const Samples = [(trueValue: 49.0, estimates: @[48.0, 47.0, 51.0]),
                 (trueValue: 49.0, estimates: @[48.0, 47.0, 51.0, 42.0])]

for (trueValue, estimates, ) in Samples:
  let m = mean(estimates)
  echo "True value:           ", trueValue
  echo "Estimates:            ", estimates.join(", ")
  echo "Average error:        ", meanSquareDiff(trueValue, estimates)
  echo "Crowd error:          ", (m - trueValue)^2
  echo "Prediction diversity: ", meanSquareDiff(m, estimates)
  echo ""


sub diversity {
    my($truth, @pred) = @_;
    my($ae,$ce,$cp,$pd,$stats);

    $cp += $_/@pred for @pred;      # collective prediction
    $ae = avg_error($truth, @pred); # average individual error
    $ce = ($cp - $truth)**2;        # collective error
    $pd = avg_error($cp, @pred);    # prediction diversity

    my $fmt = "%13s: %6.3f\n";
    $stats  = sprintf $fmt, 'average-error', $ae;
    $stats .= sprintf $fmt, 'crowd-error',   $ce;
    $stats .= sprintf $fmt, 'diversity',     $pd;
}

sub avg_error {
    my($m, @v) = @_;
    my($avg_err);
    $avg_err += ($_ - $m)**2 for @v;
    $avg_err/@v;
}

print diversity(49, qw<48 47 51>) . "\n";
print diversity(49, qw<48 47 51 42>);


with javascript_semantics
function mean(sequence s)
    return sum(s)/length(s)
end function

function variance(sequence s, atom d)
    return mean(sq_power(sq_sub(s,d),2))
end function

function diversity_theorem(atom reference, sequence observations)
    atom average_error = variance(observations,reference),
         average = mean(observations),
         crowd_error = power(reference-average,2),
         diversity = variance(observations,average)
    return {{"average_error",average_error},
            {"crowd_error",crowd_error},
            {"diversity",diversity}}
end function

procedure test(atom reference, sequence observations)
    sequence res = diversity_theorem(reference, observations)
    for i=1 to length(res) do
        printf(1," %14s : %g\n",res[i])
    end for
end procedure
test(49, {48, 47, 51})
test(49, {48, 47, 51, 42})


BEGIN # find some Disarium numbers - numbers whose digit position-power sums  #
      # are equal to the number, e.g. 135 = 1^1 + 3^2 + 5^3                   #
    # compute the nth powers of 0-9                                           #
    [ 1 : 9, 0 : 9 ]INT power;
    FOR d FROM 0 TO 9 DO power[ 1, d ] := d OD;
    FOR n FROM 2 TO 9 DO
        power[ n, 0 ] := 0;
        FOR d TO 9 DO
            power[ n, d ] := power[ n - 1, d ] * d
        OD
    OD;
    # print the first few Disarium numbers                                    #
    INT max disarium  = 19;
    INT count        :=  0;
    INT power of ten := 10;
    INT length       :=  1;
    FOR n FROM 0 WHILE count < max disarium DO
        IF n = power of ten THEN
            # the number of digits just increased                             #
            power of ten *:= 10;
            length       +:=  1
        FI;
        # form the digit power sum                                            #
        INT v   := n;
        INT dps := 0;
        FOR p FROM length BY -1 TO 1 DO
            dps +:= power[ p, v MOD 10 ];
            v OVERAB 10
        OD;
        IF dps = n THEN
            # n is Disarium                                                   #
            count +:= 1;
            print( ( " ", whole( n, 0 ) ) )
        FI
    OD
END


define structure
   1 Node,
      2 value        fixed decimal,
      2 back_pointer handle(Node),
      2 fwd_pointer  handle(Node);


$list = New-Object -TypeName 'Collections.Generic.LinkedList[PSCustomObject]'

for($i=1; $i -lt 10; $i++)
{
   $list.AddLast([PSCustomObject]@{ID=$i; X=100+$i;Y=200+$i}) | Out-Null
}

$list


DataSection
  ;the list of words that will be added to the list
  words:
  Data.s "One", "Two", "Three", "Four", "Five", "Six", "EndOfData"
EndDataSection

Procedure displayList(List x.s(), title$)
  ;display all elements from list of strings
  Print(title$)
  ForEach x()
    Print(x() + " ")
  Next
  PrintN("")
EndProcedure

OpenConsole()

NewList a.s() ;create a new list of strings

;add words to the head of list
Restore words
Repeat
  Read.s a$
  If a$ <> "EndOfData"
    ResetList(a()) ;Move to head of list
    AddElement(a())
    a() = a$
  EndIf
Until a$ = "EndOfData"
displayList(a(),"Insertion at Head: ")

ClearList(a())
;add words to the tail of list
Restore words
LastElement(a()) ;Move to the tail of the list
Repeat
  Read.s a$
  If a$ <> "EndOfData"
    AddElement(a()) ;after insertion the new position is still at the tail
    a() = a$
  EndIf
Until a$ = "EndOfData"
displayList(a(),"Insertion at Tail: ")

ClearList(a())
;add words to the middle of list
Restore words
ResetList(a()) ;Move to the tail of the list
Repeat
  Read.s a$
  If a$ <> "EndOfData"
    c = CountList(a())
    If c > 1
      SelectElement(a(),Random(c - 2)) ;insert after a random element but before tail
    Else
      FirstElement(a())
    EndIf
    AddElement(a())
    a() = a$
  EndIf
Until a$ = "EndOfData"
displayList(a(),"Insertion in Middle: ")

Repeat: Until Inkey() <> ""


let dns_query ~host ~ai_family =
  let opts = [
    Unix.AI_FAMILY ai_family;
    Unix.AI_SOCKTYPE Unix.SOCK_DGRAM;
  ] in
  let addr_infos = Unix.getaddrinfo host "" opts in
  match addr_infos with
  | [] -> failwith "dns_query"
  | ai :: _ ->
    match ai.Unix.ai_addr with
    | Unix.ADDR_INET (addr, _) -> (Unix.string_of_inet_addr addr)
    | Unix.ADDR_UNIX addr -> failwith "addr_unix"

let () =
  let host = "www.kame.net" in
  Printf.printf "primary addresses of %s are:\n" host;

  Printf.printf " IPv4 address: %s\n" (dns_query host Unix.PF_INET);
  Printf.printf " IPv6 address: %s\n" (dns_query host Unix.PF_INET6);
;;


use feature 'say';
use Socket qw(getaddrinfo getnameinfo);

my ($err, @res) = getaddrinfo('orange.kame.net', 0, { protocol=>Socket::IPPROTO_TCP } );
die "getaddrinfo error: $err" if $err;

say ((getnameinfo($_->{addr}, Socket::NI_NUMERICHOST))[1]) for @res


without js
include builtins\cffi.e

constant AF_UNSPEC = 0,
--       AF_INET = 2,
--       AF_INET6 = 23,
--       SOCK_STREAM = 1,
         SOCK_DGRAM = 2,
--       IPPROTO_TCP = 6,
         NI_MAXHOST = 1025,
         NI_NUMERICHOST = iff(platform()=LINUX?1:2)

constant tWAD = """
typedef struct WSAData {
  WORD           wVersion;
  WORD           wHighVersion;
  char           szDescription[257];
  char           szSystemStatus[129];
  unsigned short iMaxSockets;
  unsigned short iMaxUdpDg;
  char           *lpVendorInfo;
} WSADATA, *LPWSADATA;
""",
tWAS = """
int WSAStartup(
  _In_   WORD wVersionRequested,
  _Out_  LPWSADATA lpWSAData
);
""",
tWAC = """
int WSACleanup(void);
""",
tAI_W="""
typedef struct addrinfo {
  int             ai_flags;
  int             ai_family;
  int             ai_socktype;
  int             ai_protocol;
  size_t          ai_addrlen;
  char            *ai_canonname;
  struct sockaddr  *ai_addr;
  struct addrinfo  *ai_next;
} ADDRINFOA, *PADDRINFOA;
""",
tAI_L="""
typedef struct addrinfo {
    int              ai_flags;
    int              ai_family;
    int              ai_socktype;
    int              ai_protocol;
    int              ai_addrlen;
    struct sockaddr *ai_addr;
    char            *ai_canonname;
    struct addrinfo *ai_next;
};
""",
tGAI = """
int getaddrinfo(
  _In_opt_  PCSTR pNodeName,
  _In_opt_  PCSTR pServiceName,
  _In_opt_  const ADDRINFOA *pHints,
  _Out_     PADDRINFOA *ppResult
);
""",
--int getaddrinfo(const char *node, const char *service,
--                     const struct addrinfo *hints,
--                     struct addrinfo **res);
tGNI = """
int getnameinfo(
  _In_   sockaddr *sa,
  _In_   int salen,
  _Out_  char *host,
  _In_   DWORD hostlen,
  _Out_  char *serv,
  _In_   DWORD servlen,
  _In_   int flags
);
""",
--int getnameinfo(const struct sockaddr *addr, socklen_t addrlen,
--                     char *host, socklen_t hostlen,
--                     char *serv, socklen_t servlen, int flags);
tFAI = """
void freeaddrinfo(
  _In_  struct addrinfo *ai
);
"""
--void freeaddrinfo(struct addrinfo *res);

integer xgetaddrinfo = NULL, xgetnameinfo, xfreeaddrinfo, idAI,
        xwsastartup, xwsacleanup, error

function get_name_info(string fqdn)
    if xgetaddrinfo=NULL then
        atom lib
        if platform()=WINDOWS then
            integer idWAD = define_struct(tWAD)
            atom pWAD = allocate_struct(idWAD,cleanup:=true)
            lib = open_dll("Ws2_32.dll")
            xwsastartup = define_cffi_func(lib,tWAS)
            xwsacleanup = define_cffi_func(lib,tWAC)
            error = c_func(xwsastartup,{#00020002,pWAD})
            if error then ?9/0 end if
            idAI = define_struct(tAI_W)
        elsif platform()=LINUX then
            lib = open_dll("libc.so.6")
            idAI = define_struct(tAI_L)
        end if
        xgetaddrinfo = define_cffi_func(lib,tGAI)
        xgetnameinfo = define_cffi_func(lib,tGNI)
        xfreeaddrinfo = define_cffi_proc(lib,tFAI)
    end if
    atom hints = allocate_struct(idAI,cleanup:=true),
         res = allocate(machine_word(),cleanup:=true),
         host = allocate(NI_MAXHOST,cleanup:=true)
    set_struct_field(idAI,hints,"ai_family",AF_UNSPEC)
--  set_struct_field(idAI,hints,"ai_socktype",SOCK_STREAM)
    set_struct_field(idAI,hints,"ai_socktype",SOCK_DGRAM)
    error = c_func(xgetaddrinfo,{fqdn,NULL,hints,res})
    if error then ?9/0 end if
    res = peekNS(res,machine_word(),false)
    atom ptr = res
    sequence results = {}
    while ptr!=NULL do
        atom addr = get_struct_field(idAI,ptr,"ai_addr")
        integer len = get_struct_field(idAI,ptr,"ai_addrlen")
        error = c_func(xgetnameinfo,{addr, len, host, NI_MAXHOST, NULL, 0, NI_NUMERICHOST})
        if error then ?9/0 end if
        results = append(results,peek_string(host))
        ptr = get_struct_field(idAI,ptr,"ai_next")
    end while
    c_proc(xfreeaddrinfo,{res})
    return results
end function

procedure WSACleanup()
    if platform()=WINDOWS then
        error = c_func(xwsacleanup,{})
        if error then crash("WSACleanup failed: %d\n",{error}) end if
    end if
end procedure

?get_name_info("www.kame.net")
WSACleanup()


open Printf

let create_logger () =
  def log(text) & logs(l) =
      printf "Logged: %s\n%!" text;
      logs((text, Unix.gettimeofday ())::l) & reply to log

   or search(text) & logs(l) =
      logs(l) & reply List.filter (fun (line, _) -> line = text) l to search
  in
    spawn logs([]);
    (log, search)

def wait() & finished() = reply to wait

let register name service = Join.Ns.register Join.Ns.here name service

let () =
  let log, search = create_logger () in
    register "log" log;
    register "search" search;
    Join.Site.listen (Unix.ADDR_INET (Join.Site.get_local_addr(), 12345));
    wait ()


declare
  functor ServerCode
  export
     port:Prt
  define
     Stream
     Prt = {NewPort ?Stream}
     thread
	for Request#Reply in Stream do
	   case Request
	   of echo(Data)        then Reply = Data
	   [] compute(Function) then Reply = {Function}
	   end
	end
     end
  end

  %% create the server on some machine
  %% (just change "localhost" to some machine
  %% that you can use with a passwordless rsh login
  %% and that has the same Mozart version installed)
  RM = {New Remote.manager init(host:localhost)}

  %% execute the code encapsulated in the ServerCode functor
  Server = {RM apply(ServerCode $)}

  %% Shortcut: send a message to Server and receive a reply
  fun {Send X}
     {Port.sendRecv Server.port X}
  end
in
  %% echo
  {System.showInfo "Echo reply: "#{Send echo(hello)}}

  %% compute
  {System.showInfo "Result of computation: "#
   {Send compute(fun {$} 8 div 4 end)}}

  %% shut down server
  {RM close}


import times, os

const
  t = ["⡎⢉⢵","⠀⢺⠀","⠊⠉⡱","⠊⣉⡱","⢀⠔⡇","⣏⣉⡉","⣎⣉⡁","⠊⢉⠝","⢎⣉⡱","⡎⠉⢱","⠀⠶⠀"]
  b = ["⢗⣁⡸","⢀⣸⣀","⣔⣉⣀","⢄⣀⡸","⠉⠉⡏","⢄⣀⡸","⢇⣀⡸","⢰⠁⠀","⢇⣀⡸","⢈⣉⡹","⠀⠶ "]

while true:
  let x = getClockStr()
  stdout.write "\e[H\e[J"
  for c in x: stdout.write t[c.ord - '0'.ord]
  echo ""
  for c in x: stdout.write b[c.ord - '0'.ord]
  echo ""
  sleep 1000


#!/usr/bin/env ocaml
#load "unix.cma"
#load "graphics.cma"
open Graphics

let pi = 4.0 *. atan 1.0
let angle v max = float v /. max *. 2.0 *. pi

let () =
  open_graph "";
  set_window_title "OCaml Clock";
  resize_window 256 256;
  auto_synchronize false;
  let w = size_x ()
  and h = size_y () in
  let rec loop () =
    clear_graph ();

    let point radius r a =
      let x = int_of_float (radius *. sin a)
      and y = int_of_float (radius *. cos a) in
      fill_circle (w/2+x) (h/2+y) r;
    in
    set_color (rgb 192 192 192);
    point 84.0 8 0.0;
    point 84.0 8 (angle  90 360.0);
    point 84.0 8 (angle 180 360.0);
    point 84.0 8 (angle 270 360.0);
    set_color (rgb 224 224 224);
    point 84.0 6 (angle  30 360.0);
    point 84.0 6 (angle  60 360.0);
    point 84.0 6 (angle 120 360.0);
    point 84.0 6 (angle 150 360.0);
    point 84.0 6 (angle 210 360.0);
    point 84.0 6 (angle 240 360.0);
    point 84.0 6 (angle 300 360.0);
    point 84.0 6 (angle 330 360.0);

    set_line_width 9;
    set_color (rgb 192 192 192);
    draw_circle (w/2) (h/2) 100;

    let tm = Unix.localtime (Unix.gettimeofday ()) in
    let sec = angle tm.Unix.tm_sec 60.0 in
    let min = angle tm.Unix.tm_min 60.0 in
    let hour = angle (tm.Unix.tm_hour * 60 + tm.Unix.tm_min) (24.0 *. 60.0) in
    let hour = hour *. 2.0 in

    let hand t radius width color =
      let x = int_of_float (radius *. sin t)
      and y = int_of_float (radius *. cos t) in
      set_line_width width;
      set_color color;
      moveto (w/2) (h/2);  rlineto x y;
    in
    hand sec  90.0 2 (rgb 0 128 255);
    hand min  82.0 4 (rgb 0 0 128);
    hand hour 72.0 6 (rgb 255 0 128);

    synchronize ();
    Unix.sleep 1;
    loop ()
  in
  try loop ()
  with _ -> close_graph ()


begin
    % computes the dot product of two equal length integer vectors            %
    % (single dimension arrays ) the length of the vectors must be specified  %
    % in length.                                                              %
    integer procedure integerDotProduct( integer array a ( * )
                                       ; integer array b ( * )
                                       ; integer value length
                                       ) ;
    begin
        integer product;
        product := 0;
        for i := 1 until length do product := product + ( a(i) * b(i) );
        product
    end integerDotProduct ;

    % declare two vectors of length 3                                         %
    integer array v1, v2 ( 1 :: 3 );
    % initialise the vectors                                                  %
    v1(1) :=  1; v1(2) :=  3; v1(3) := -5;
    v2(1) :=  4; v2(2) := -2; v2(3) := -1;
    % output the dot product                                                  %
    write( integerDotProduct( v1, v2, 3 ) )
end.


----------------------- DOT PRODUCT -----------------------

-- dotProduct :: [Number] -> [Number] -> Number
on dotProduct(xs, ys)
    if length of xs = length of ys then
        sum(zipWith(my mul, xs, ys))
    else
        missing value -- arrays of differing dimension
    end if
end dotProduct

-------------------------- TEST ---------------------------
on run

    dotProduct([1, 3, -5], [4, -2, -1])

    --> 3
end run

-------------------- GENERIC FUNCTIONS --------------------

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- mul :: Num -> Num -> Num
on mul(a, b)
    a * b
end mul

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- sum :: [Number] -> Number
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(length of xs, length of ys)
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys)
        end repeat
        return lst
    end tell
end zipWith


# Return the position of the highest 1-bit in n.
# The least significant bit is position 0.
# For example n=13 is binary "1101" and the high bit is pos=3.
# If n==0 then the return is 0.
# Arranging the test as n>=2 avoids infinite recursion if n==NaN (any
# comparison involving NaN is always false).
#
high_bit_pos(n) = (n>=2 ? 1+high_bit_pos(int(n/2)) : 0)

# Return 0 or 1 for the bit at position "pos" in n.
# pos==0 is the least significant bit.
#
bit(n,pos) = int(n / 2**pos) & 1

# dragon(n) returns a complex number which is the position of the
# dragon curve at integer point "n".  n=0 is the first point and is at
# the origin {0,0}.  Then n=1 is at {1,0} which is x=1,y=0, etc.  If n
# is not an integer then the point returned is for int(n).
#
# The calculation goes by bits of n from high to low.  Gnuplot doesn't
# have iteration in functions, but can go recursively from
# pos=high_bit_pos(n) down to pos=0, inclusive.
#
# mul() rotates by +90 degrees (complex "i") at bit transitions 0->1
# or 1->0.  add() is a vector (i+1)**pos for each 1-bit, but turned by
# factor "i" when in a "reversed" section of curve, which is when the
# bit above is also a 1-bit.
#
dragon(n) = dragon_by_bits(n, high_bit_pos(n))
dragon_by_bits(n,pos) \
  = (pos>=0 ? add(n,pos) + mul(n,pos)*dragon_by_bits(n,pos-1)  : 0)

add(n,pos) = (bit(n,pos) ? (bit(n,pos+1) ? {0,1} * {1,1}**pos   \
                                         :         {1,1}**pos)  \
              : 0)
mul(n,pos) = (bit(n,pos) == bit(n,pos+1) ? 1 : {0,1})

# Plot the dragon curve from 0 to "length" with line segments.
# "trange" and "samples" are set so the parameter t runs through
# integers t=0 to t=length inclusive.
#
# Any trange works, it doesn't have to start at 0.  But must have
# enough "samples" that all integers t in the range are visited,
# otherwise vertices in the curve would be missed.
#
length=256
set trange [0:length]
set samples length+1
set parametric
set key off
plot real(dragon(t)),imag(dragon(t)) with lines


Define.f ref=49.0, mea
NewList argV.f()

Macro put
  Print(~"\n["+StrF(ref)+"]"+#TAB$)
  ForEach argV() : Print(StrF(argV())+#TAB$) : Next
  PrintN(~"\nAverage Error : "+StrF(vari(argV(),ref),5))
  PrintN("Crowd Error   : "+StrF((ref-mea)*(ref-mea),5))
  PrintN("Diversity     : "+StrF(vari(argV(),mea),5))
EndMacro

Macro LetArgV(v)
  AddElement(argV()) : argV()=v
EndMacro

Procedure.f mean(List x.f())
  Define.f m
  ForEach x() : m+x() : Next
  ProcedureReturn m/ListSize(x())
EndProcedure

Procedure.f vari(List x.f(),r.f)
  NewList nx.f()
  ForEach x() : AddElement(nx()) : nx()=(r-x())*(r-x()) : Next
  ProcedureReturn mean(nx())
EndProcedure

If OpenConsole()=0 : End 1 : EndIf
Gosub SetA : ClearList(argV())
Gosub SetB : Input()
End

SetA:
  LetArgV(48.0) : LetArgV(47.0) : LetArgV(51.0)
  mea=mean(argV()) : put
Return

SetB:
  LetArgV(48.0) : LetArgV(47.0) : LetArgV(51.0) : LetArgV(42.0)
  mea=mean(argV()) : put
Return


'''Diversity prediction theorem'''

from itertools import chain
from functools import reduce

#  diversityValues :: Num a => a -> [a] ->
#  { mean-Error :: a, crowd-error :: a, diversity :: a }
def diversityValues(x):
    '''The mean error, crowd error and
       diversity, for a given observation x
       and a non-empty list of predictions ps.
    '''
    def go(ps):
        mp = mean(ps)
        return {
            'mean-error': meanErrorSquared(x)(ps),
            'crowd-error': pow(x - mp, 2),
            'diversity': meanErrorSquared(mp)(ps)
        }
    return go

# meanErrorSquared :: Num -> [Num] -> Num
def meanErrorSquared(x):
    '''The mean of the squared differences
       between the observed value x and
       a non-empty list of predictions ps.
    '''
    def go(ps):
        return mean([
            pow(p - x, 2) for p in ps
        ])
    return go

# ------------------------- TEST -------------------------
# main :: IO ()
def main():
    '''Observed value: 49,
       prediction lists: various.
    '''

    print(unlines(map(
        showDiversityValues(49),
        [
            [48, 47, 51],
            [48, 47, 51, 42],
            [50, '?', 50, {}, 50],  # Non-numeric values.
            []                      # Missing predictions.
        ]
    )))
    print(unlines(map(
        showDiversityValues('49'),  # String in place of number.
        [
            [50, 50, 50],
            [40, 35, 40],
        ]
    )))

# ---------------------- FORMATTING ----------------------

# showDiversityValues :: Num -> [Num] -> Either String String
def showDiversityValues(x):
    '''Formatted string representation
       of diversity values for a given
       observation x and a non-empty
       list of predictions p.
    '''
    def go(ps):
        def showDict(dct):
            w = 4 + max(map(len, dct.keys()))

            def showKV(a, kv):
                k, v = kv
                return a + k.rjust(w, ' ') + (
                    ' : ' + showPrecision(3)(v) + '\n'
                )
            return 'Predictions: ' + showList(ps) + ' ->\n' + (
                reduce(showKV, dct.items(), '')
            )

        def showProblem(e):
            return (
                unlines(map(indented(1), e)) if (
                    isinstance(e, list)
                ) else indented(1)(repr(e))
            ) + '\n'

        return 'Observation:  ' + repr(x) + '\n' + (
            either(showProblem)(showDict)(
                bindLR(numLR(x))(
                    lambda n: bindLR(numsLR(ps))(
                        compose(Right, diversityValues(n))
                    )
                )
            )
        )
    return go

# ------------------ GENERIC FUNCTIONS -------------------

# Left :: a -> Either a b
def Left(x):
    '''Constructor for an empty Either (option type) value
       with an associated string.
    '''
    return {'type': 'Either', 'Right': None, 'Left': x}

# Right :: b -> Either a b
def Right(x):
    '''Constructor for a populated Either (option type) value'''
    return {'type': 'Either', 'Left': None, 'Right': x}

# bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
def bindLR(m):
    '''Either monad injection operator.
       Two computations sequentially composed,
       with any value produced by the first
       passed as an argument to the second.
    '''
    def go(mf):
        return (
            mf(m.get('Right')) if None is m.get('Left') else m
        )
    return go

# compose :: ((a -> a), ...) -> (a -> a)
def compose(*fs):
    '''Composition, from right to left,
       of a series of functions.
    '''
    def go(f, g):
        def fg(x):
            return f(g(x))
        return fg
    return reduce(go, fs, identity)

# concatMap :: (a -> [b]) -> [a] -> [b]
def concatMap(f):
    '''A concatenated list over which a function has been mapped.
       The list monad can be derived by using a function f which
       wraps its output in a list,
       (using an empty list to represent computational failure).
    '''
    def go(xs):
        return chain.from_iterable(map(f, xs))
    return go

# either :: (a -> c) -> (b -> c) -> Either a b -> c
def either(fl):
    '''The application of fl to e if e is a Left value,
       or the application of fr to e if e is a Right value.
    '''
    return lambda fr: lambda e: fl(e['Left']) if (
        None is e['Right']
    ) else fr(e['Right'])

# identity :: a -> a
def identity(x):
    '''The identity function.'''
    return x

# indented :: Int -> String -> String
def indented(n):
    '''String indented by n multiples
       of four spaces.
    '''
    return lambda s: (4 * ' ' * n) + s

# mean :: [Num] -> Float
def mean(xs):
    '''Arithmetic mean of a list
       of numeric values.
    '''
    return sum(xs) / float(len(xs))

# numLR :: a -> Either String Num
def numLR(x):
    '''Either Right x if x is a float or int,
       or a Left explanatory message.'''
    return Right(x) if (
        isinstance(x, (float, int))
    ) else Left(
        'Expected number, saw: ' + (
            str(type(x)) + ' ' + repr(x)
        )
    )

# numsLR :: [a] -> Either String [Num]
def numsLR(xs):
    '''Either Right xs if all xs are float or int,
       or a Left explanatory message.'''
    def go(ns):
        ls, rs = partitionEithers(map(numLR, ns))
        return Left(ls) if ls else Right(rs)
    return bindLR(
        Right(xs) if (
            bool(xs) and isinstance(xs, list)
        ) else Left(
            'Expected a non-empty list, saw: ' + (
                str(type(xs)) + ' ' + repr(xs)
            )
        )
    )(go)

# partitionEithers :: [Either a b] -> ([a],[b])
def partitionEithers(lrs):
    '''A list of Either values partitioned into a tuple
       of two lists, with all Left elements extracted
       into the first list, and Right elements
       extracted into the second list.
    '''
    def go(a, x):
        ls, rs = a
        r = x.get('Right')
        return (ls + [x.get('Left')], rs) if None is r else (
            ls, rs + [r]
        )
    return reduce(go, lrs, ([], []))

# showList :: [a] -> String
def showList(xs):
    '''Compact string representation of a list'''
    return '[' + ','.join(str(x) for x in xs) + ']'

# showPrecision :: Int -> Float -> String
def showPrecision(n):
    '''A string showing a floating point number
       at a given degree of precision.'''
    def go(x):
        return str(round(x, n))
    return go

# unlines :: [String] -> String
def unlines(xs):
    '''A single string derived by the intercalation
       of a list of strings with the newline character.'''
    return '\n'.join(xs)

# MAIN ---
if __name__ == '__main__':
    main()


begin % find some Disarium numbers - numbers whose digit position-power sums  %
      % are equal to the number, e.g. 135 = 1^1 + 3^2 + 5^3                   %
    integer array power ( 1 :: 9, 0 :: 9 );
    integer MAX_DISARIUM;
    integer count, powerOfTen, length, n;
    % compute the nth powers of 0-9                                           %
    for d := 0 until 9 do power( 1, d ) := d;
    for n := 2 until 9 do begin
        power( n, 0 ) := 0;
        for d := 1 until 9 do power( n, d ) := power( n - 1, d ) * d
    end for_n;
    % print the first few Disarium numbers                                    %
    MAX_DISARIUM := 19;
    count        :=  0;
    powerOfTen   := 10;
    length       :=  1;
    n            :=  0;
    while count < MAX_DISARIUM do begin
        integer v, dps;
        if n = powerOfTen then begin
            % the number of digits just increased                             %
            powerOfTen := powerOfTen * 10;
            length     := length     +  1
        end if_m_eq_powerOfTen ;
        % form the digit power sum                                            %
        v   := n;
        dps := 0;
        for p := length step -1 until 1 do begin
            dps := dps + power( p, v rem 10 );
            v   := v div 10;
        end FOR_P;
        if dps = n then begin
            % n is Disarium                                                   %
            count := count + 1;
            writeon( i_w := 1, s_w := 0, " ", n )
        end if_dps_eq_n ;
        n := n + 1
    end
end.


disarium?: function [x][
    j: 0
    psum: sum map digits x 'dig [
        j: j + 1
        dig ^ j
    ]
    return psum = x
]

cnt: 0
i: 0
while [cnt < 18][
    if disarium? i [
        print i
        cnt: cnt + 1
    ]
    i: i + 1
]


from collections import deque

some_list = deque(["a", "b", "c"])
print(some_list)

some_list.appendleft("Z")
print(some_list)

for value in reversed(some_list):
    print(value)


#lang racket
(define-struct dlist (head tail) #:mutable #:transparent)
(define-struct dlink (content prev next) #:mutable #:transparent)

(define (insert-between dlist before after data)
  ; Insert a fresh link containing DATA after existing link
  ; BEFORE if not nil and before existing link AFTER if not nil
  (define new-link (make-dlink data before after))
  (if before
      (set-dlink-next! before new-link)
      (set-dlist-head! dlist new-link))
  (if after
      (set-dlink-prev! after new-link)
      (set-dlist-tail! dlist new-link))
    new-link)

(define (insert-before dlist dlink data)
  ; Insert a fresh link containing DATA before existing link DLINK
  (insert-between dlist (dlink-prev dlink) dlink data))

(define (insert-after dlist dlink data)
  ; Insert a fresh link containing DATA after existing link DLINK
  (insert-between dlist dlink (dlink-next dlink) data))

(define (insert-head dlist data)
  ; Insert a fresh link containing DATA at the head of DLIST
  (insert-between dlist #f (dlist-head dlist) data))

(define (insert-tail dlist data)
  ; Insert a fresh link containing DATA at the tail of DLIST
  (insert-between dlist (dlist-tail dlist) #f data))

(define (remove-link dlist dlink)
  ; Remove link DLINK from DLIST and return its content
  (let ((before (dlink-prev dlink))
        (after (dlink-next dlink)))
    (if before
        (set-dlink-next! before after)
        (set-dlist-head! dlist after))
    (if after
        (set-dlink-prev! after before)
        (set-dlist-tail! dlist before))))

(define (dlist-elements dlist)
  ; Returns the elements of DLIST as a list
  (define (extract-values dlink acc)
    (if dlink
        (extract-values (dlink-next dlink) (cons (dlink-content dlink) acc))
        acc))
  (reverse (extract-values (dlist-head dlist) '())))

(let ((dlist (make-dlist #f #f)))
  (insert-head dlist 1)
  (insert-tail dlist 4)
  (insert-after dlist (dlist-head dlist) 2)
  (let* ((next-to-last (insert-before dlist (dlist-tail dlist) 3))
         (bad-link (insert-before dlist next-to-last 42)))
    (remove-link dlist bad-link))
  (dlist-elements dlist))


role DLElem[::T] {
    has DLElem[T] $.prev is rw;
    has DLElem[T] $.next is rw;
    has T $.payload = T;

    method pre-insert(T $payload) {
	die "Can't insert before beginning" unless $!prev;
	my $elem = ::?CLASS.new(:$payload);
	$!prev.next = $elem;
	$elem.prev = $!prev;
	$elem.next = self;
	$!prev = $elem;
	$elem;
    }

    method post-insert(T $payload) {
	die "Can't insert after end" unless $!next;
	my $elem = ::?CLASS.new(:$payload);
	$!next.prev = $elem;
	$elem.next = $!next;
	$elem.prev = self;
	$!next = $elem;
	$elem;
    }

    method delete {
	die "Can't delete a sentinel" unless $!prev and $!next;
	$!next.prev = $!prev;
	$!prev.next = $!next;	# conveniently returns next element
    }
}

role DLList[::DLE] {
    has DLE $.first;
    has DLE $.last;

    submethod BUILD {
	$!first = DLE.new;
	$!last = DLE.new;
	$!first.next = $!last;
	$!last.prev = $!first;
    }

    method list { ($!first.next, *.next ...^ !*.next).map: *.payload }
    method reverse { ($!last.prev, *.prev ...^ !*.prev).map: *.payload }
}

class DLElem_Int does DLElem[Int] {}
class DLList_Int does DLList[DLElem_Int] {}

my $dll = DLList_Int.new;

$dll.first.post-insert(1).post-insert(2).post-insert(3);
$dll.first.post-insert(0);

$dll.last.pre-insert(41).pre-insert(40).prev.delete;  # (deletes 3)
$dll.last.pre-insert(42);

say $dll.list;     # 0 1 2 40 41 42
say $dll.reverse;  # 42 41 40 2 1 0


<?php
  $ipv4_record = dns_get_record("www.kame.net",DNS_A);
  $ipv6_record = dns_get_record("www.kame.net",DNS_AAAA);
  print "ipv4: " . $ipv4_record[0]["ip"] . "\n";
  print "ipv6: " . $ipv6_record[0]["ipv6"] . "\n";
?>


(make
   (in '(host "www.kame.net")
      (while (from "address ")
         (link (till "^J" T)) ) ) )


> array ips = Protocols.DNS.gethostbyname("www.kame.net")[1] || ({});
> write(ips*"\n");


$DNS = Resolve-DnsName -Name www.kame.net
Write-Host "IPv4:" $DNS.IP4Address "`nIPv6:" $DNS.IP6Address


>>> import socket
>>> ips = set(i[4][0] for i in socket.getaddrinfo('www.kame.net', 80))
>>> for ip in ips: print ip
...
2001:200:dff:fff1:216:3eff:feb1:44d7
203.178.141.194


#include <Rcpp.h>
#include <arpa/inet.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netdb.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

using namespace Rcpp ;

// [[Rcpp::export]]
CharacterVector getNameInfo(std::string fqdn) {

  struct addrinfo hints, *res, *res0;
	int error;
	char host[NI_MAXHOST];

  memset(&hints, 0, sizeof hints);
	hints.ai_family = PF_UNSPEC;
	hints.ai_socktype = SOCK_DGRAM;

	error = getaddrinfo(fqdn.c_str(), NULL, &hints, &res0);
	if (error) { return(NA_STRING);	}

  int i = 0 ;
	for (res = res0; res; res = res->ai_next) {
  	error = getnameinfo(res->ai_addr, res->ai_addrlen,
		    host, sizeof host, NULL, 0, NI_NUMERICHOST);
		if (!error) { i++ ; }
	}

  CharacterVector results(i) ;

  i = 0;

  for (res = res0; res; res = res->ai_next) {
		error = getnameinfo(res->ai_addr, res->ai_addrlen,
		    host, sizeof host, NULL, 0, NI_NUMERICHOST);
		if (!error) { results[i++] = host ; }
	}

  freeaddrinfo(res0);

  return(results) ;

}


use Data::Dumper;
use IO::Socket::INET;
use Safe;

sub get_data {
	my $sock = new IO::Socket::INET
		LocalHost =>	"localhost",
		LocalPort =>	"10000",
		Proto =>	"tcp",
		Listen =>	1,
		Reuse =>	1;
	unless ($sock) { die "Socket creation failure" }
	my $cli = $sock->accept();

	# of course someone may be tempted to send you 'system("rm -rf /")',
	# to be safe(r), use Safe::
	my $safe = new Safe;
	my $x = $safe->reval(join("", <$cli>));
	close $cli;
	close $sock;
	return $x;
}

sub send_data {
	my $host = shift;
	my $data = shift;
	my $sock = new IO::Socket::INET
		PeerAddr =>	"$host:10000",
		Proto =>	"tcp",
		Reuse =>	1;

	unless ($sock) { die "Socket creation failure" }

	print $sock Data::Dumper->Dump([$data]);
	close $sock;
}

if (@ARGV) {
	my $x = get_data();
	print "Got data\n", Data::Dumper->Dump([$x]);
} else {
	send_data('some_host', { a=>100, b=>[1 .. 10] });
}


without js -- (zmq dll/so)
puts(1, "durapub:\n")
include zmq/zmq.e

atom context = zmq_init(1)
zmq_assert(context, "zmq_init")

--// subscriber tells us when it's ready here
atom sync = zmq_socket(context, ZMQ_PULL)
zmq_bind(sync, "tcp://*:5564")

--// send update via this socket
atom publisher = zmq_socket(context, ZMQ_PUB)
zmq_bind(publisher, "tcp://*:5565")

--// broadcast 10 updates, with pause
for update_nbr = 1 to 10 do
    string s = sprintf("Update %d", { update_nbr })
    zmq_s_send(publisher, s)
    sleep(1)
end for

zmq_s_send(publisher, "END")
sleep(1)

zmq_close(sync)
zmq_close(publisher)
zmq_term(context)


/* REXX ---------------------------------------------------------------
* 09.02.2014 Walter Pachl with a little, well considerable, help from
*                         a friend (Mark Miesfeld)
* 1) downstripped an example contained in the ooRexx distribution
* 2) constructed the squares for seconds, minutes, and hours
* 3) constructed second-, minute- and hour hand
* 5) removed lots of unnecessary code (courtesy mark Miesfeld again)
* 6) painted the background white
* 7) display date as well as time as text
* 21.02.2014 Attempts to add a minimize icon keep failing
*--------------------------------------------------------------------*/
 d = .drawDlg~new
 if d~initCode <> 0 then do
    say 'The Draw dialog was not created correctly.  Aborting.'
    return d~initCode
 end
 d~execute("SHOWTOP")
 return 0

::requires "ooDialog.cls"
::requires 'rxmath' library

::class 'drawDlg' subclass UserDialog

::attribute interrupted unguarded

::method init
   expose walterFont

   forward class (super) continue
   -- colornames:
   --  1 dark red      7 light grey   13 red
   --  2 dark green    8 pale green   14 light green
   --  3 dark yellow   9 light blue   15 yellow
   --  4 dark blue    10 white        16 blue
   --  5 purple       11 grey         17 pink
   --  6 blue grey    12 dark grey    18 turquoise

   self~interrupted = .true

   -- Create a font to write the nice big letters and digits
   opts = .directory~new
   opts~weight = 700
   walterFont = self~createFontEx("Arial",14,opts)

-- if \self~createcenter(200, 230,"Walter's Clock","MINIMIZEBOX", ,"System",14) then
   if \self~createcenter(200, 230,"Walter's Clock",,,"System",14) then
      self~initCode = 1
-- self~connectDraw(100, "clock", .true)

::method defineDialog
-- self~createPushButton(/*IDC_PB_DRAW*/100,0,0,240,200,"NOTAB OWNERDRAW") -- The drawing surface.
-- self~createPushButton(/*IDC_PB_DRAW*/100,0,0,240,180,"DISABLED NOTAB") -- better. ???
   self~createPushButton(/*IDC_PB_DRAW*/100,0,0,200,200,"DISABLED NOTAB") -- better. ???

   self~createPushButton(IDCANCEL,160,212, 35, 12,,"&Cancel")

::method initDialog unguarded
   expose x y dc myPen change
   change = 0
   x = self~factorx
   y = self~factory
   dc = self~getButtonDC(100)
 --+  myPen   = self~createPen(1,'solid',0)
   t    = .TimeSpan~fromMicroSeconds(500000) -- .5 seconds
   msg  = .Message~new(self, 'clock')
   alrm = .Alarm~new(t, msg)

::method interrupt unguarded

   self~interrupted = .true

::method cancel unguarded   -- Stop the drawing program and quit.
   expose x y
   self~hide
   self~interrupted = .true
   return self~cancel:super

::method leaving unguarded  -- Best place to clean up resources
   expose dc myPen walterFont

 --+  self~deleteObject(myPen)
   self~freeButtonDC(/*IDC_PB_DRAW*/100,dc)
   self~deleteFont(walterFont)

::method clock unguarded                           /* draw individual pixels */
   expose x y dc myPen change walterFont
-- Say 'clock started'
   mx = trunc(20*x); my = trunc(20*y); size = 400

 --+  curPen = self~objectToDC(dc, myPen)

   -- Select the nice big letters and digits into the device context to use to
   -- to write with:
   curFont = self~fontToDC(dc, walterFont)

   -- Create a white brush and select it into the device to paint with.
   whiteBrush = self~createBrush(10)
   curBrush   = self~objectToDC(dc, whiteBrush)

-- Paint the drawing area surface with the white brush
--   self~rectangle(dc, 1, 1, 500, 450, 'FILL') -- how does that relate to the 180 above ???
--   self~rectangle(dc, 1, 1, 480, 400, 'FILL') -- how does that relate to the 180 above ???

   button = self~newPushButton(100)
   clRect = button~clientRect;  -- Say clRect
   self~rectangle(dc, clRect~left+10, clRect~top+10, clRect~right-10, clRect~bottom-10, 'FILL')

   self~transparentText(dc)
   self~writeDirect(dc, 55,20*y,"Walter's Clock")
   self~writeDirect(dc,236, 56,'12')
   self~writeDirect(dc,428,220,'3')
   self~writeDirect(dc,245,375,'6')
   self~writeDirect(dc, 60,220,'9')
   self~opaqueText(dc)

   -- These 5 lines just have the effect of showing "Walter's Clock" first
   -- for a brief instant before the other drawing shows.  If you want it all
   -- to show at once, then remove this.
/*
   if change \= 2 then do
     call msSleep 1000
     change = 2
     end
*/
   self~interrupted = .false

   sec=0
   min=0
   hhh=0
   fact=rxCalcPi()/180
   Parse Value '-1 -1 -1 -1' With hho mmo sso hopo

   do dalpha=0 To 359 by 30 until self~interrupted
     alpha = dalpha*fact
     zxa=trunc(250+124*rxCalcSin(alpha,,'R'))
     zya=trunc(230-110*rxCalcCos(alpha,,'R'))
     hhh=right(hhh,2,0)
     hhh.hhh=right(zxa,3) right(zya,3)
     hhh+=1
     self~draw_square(dc,zxa,zya,3,5)
     self~draw_square(dc,zxa,zya,2,10)
     End
   Do a=0 To 59
     a=right(a,2,0)
     alpha=a*6*fact
     sin.a=rxCalcSin(alpha,,'R')
     cos.a=rxCalcCos(alpha,,'R')
     sin.0mhh.a=sin.a
     cos.0mhh.a=cos.a
     End
   Do hoi=0 To 12*60-1
     hoi=right(hoi,3,0)
     alpha=(hoi/2)*fact
     sin.0hoh.hoi=rxCalcSin(alpha,,'R')
     cos.0hoh.hoi=rxCalcCos(alpha,,'R')
     End
   do dalpha=0 To 359 by 6 until self~interrupted
      alpha = dalpha*fact
      zxa=trunc(250+165*rxCalcSin(alpha,,'R'))
      zya=trunc(230-140*rxCalcCos(alpha,,'R'))
      sec=right(min,2,0)
      sec.sec=right(zxa,3) right(zya,3)
      sec+=1
      self~draw_square(dc,zxa,zya,3,5)
      self~draw_square(dc,zxa,zya,2,10)
      zxa=trunc(250+140*rxCalcSin(alpha,,'R'))
      zya=trunc(230-125*rxCalcCos(alpha,,'R'))
      min=right(min,2,0)
      min.min=right(zxa,3) right(zya,3)
      --Call lineout 'pos.xxx',right(min,2) 'min='min.min
      min+=1
      self~draw_square(dc,zxa,zya,3,5)
      self~draw_square(dc,zxa,zya,2,10)
      End

   do dalpha=0 by 6 until self~interrupted
      alpha=dalpha*fact
      zxa=trunc(250+165*rxCalcSin(alpha,,'R'))
      zya=trunc(230-140*rxCalcCos(alpha,,'R'))
      time=time()
      parse Var time hh ':' mm ':' ss
      If hh>=12 Then hh=right(hh-12,2,0)
      self~writeDirect(dc, 355,40,time)
      date=date()
      self~writeDirect(dc, 355,60,date)
      If hh<>hho Then Do
        If hho>=0 Then Do
          Parse Var hhh.hho hx hy
          self~draw_square(dc,hx,hy,2,10)
          End
        Parse Var hhh.hh hx hy
        self~draw_square(dc,hx,hy,2,2)
        End
      If mm<>mmo Then Do
        If mmo>=0 Then Do
          Parse Var min.mmo mx my
          self~draw_square(dc,mx,my,2,10)
          End
        Parse Var min.mm mx my
        self~draw_square(dc,mx,my,2,2)
        End
      If ss<>sso Then Do
        If sso>=0 Then Do
          Parse Var sec.sso sx sy
          self~draw_square(dc,sx,sy,2,10)
          self~draw_second_hand(dc,sso,sin.,cos.,10)
          End
        Parse Var sec.ss sx sy
        self~draw_square(dc,sx,sy,2, 2)
        self~draw_second_hand(dc,ss,sin.,cos.,16)
        self~draw_square(dc,250,230,4,1)
        hop=right(hh*60+mm,3,0)
        self~draw_hour_hand(dc,hop,sin.,cos.,13)
        self~draw_minute_hand(dc,mm,sin.,cos.,14)
        End
      If mm<>mmo Then Do
        If hopo>=0 Then
          self~draw_hour_hand(dc,hopo,sin.,cos.,10)
        hop=right(hh*60+mm,3,0)
        self~draw_hour_hand(dc,hop,sin.,cos.,13)
        hopo=hop
        If mmo>=0 Then
          self~draw_minute_hand(dc,mmo,sin.,cos.,10)
        self~draw_minute_hand(dc,mm,sin.,cos.,14)
        End
      self~draw_square(dc,250,230,4,1)
      hho=hh
      mmo=mm
      sso=ss

      call msSleep 100
      self~pause
   end
--   if kpix >= size then kpix = 1

   self~interrupted = .true
 --+  self~objectToDC(dc, curPen)
   self~objectToDC(dc, curBrush)

::method pause
   j = msSleep(10)

::method draw_square
  Use Arg dc, x, y, d, c
  Do zx=x-d to x+d
    Do zy=y-d to y+d
      self~drawPixel(dc, zx, zy, c)
      End
    End

::method draw_hour_hand
  Use Arg dc, hp, sin., cos., color
  Do p=1 To 60
    zx=trunc(250+p*sin.0hoh.hp)
    zy=trunc(230-p*cos.0hoh.hp)
    self~draw_square(dc, zx, zy, 2, color)
    End

::method draw_minute_hand
  Use Arg dc, mp, sin., cos., color
  Do p=1 To 80
    zx=trunc(250+p*sin.0mhh.mp)
    zy=trunc(230-p*cos.0mhh.mp)
    self~draw_square(dc, zx, zy, 1, color)
    End

::method draw_second_hand
  Use Arg dc, sp, sin., cos., color
  Do p=1 To 113
    zx=trunc(250+p*sin.sp)
    zy=trunc(230-p*(140/165)*cos.sp)
    self~draw_square(dc, zx, zy, 0, color)
    End

::method quot
  Parse Arg x,y
  If y=0 Then Return '??'
  Else Return x/y


dotProduct: function [a,b][
    [ensure equal? size a size b]

    result: 0
    loop 0..(size a)-1 'i [
        result: result + a\[i] * b\[i]
    ]
    return result
]

print dotProduct @[1, 3, neg 5] @[4, neg 2, neg 1]
print dotProduct [1 2 3] [4 5 6]


Vet1 := "1,3,-5"
Vet2 := "4 , -2 , -1"
MsgBox % DotProduct( Vet1 , Vet2 )

;---------------------------

DotProduct( VectorA , VectorB )
{
  Sum := 0
  StringSplit, ArrayA, VectorA, `,, %A_Space%
  StringSplit, ArrayB, VectorB, `,, %A_Space%
  If ( ArrayA0 <> ArrayB0 )
    Return ERROR
  While ( A_Index <= ArrayA0 )
    Sum += ArrayA%A_Index% * ArrayB%A_Index%
  Return Sum
}


package main

import (
    "fmt"
    "image"
    "image/color"
    "image/draw"
    "image/png"
    "math"
    "os"
)

// separation of the the two endpoints
// make this a power of 2 for prettiest output
const sep = 512
// depth of recursion.  adjust as desired for different visual effects.
const depth = 14

var s = math.Sqrt2 / 2
var sin = []float64{0, s, 1, s, 0, -s, -1, -s}
var cos = []float64{1, s, 0, -s, -1, -s, 0, s}
var p = color.NRGBA{64, 192, 96, 255}
var b *image.NRGBA

func main() {
    width := sep * 11 / 6
    height := sep * 4 / 3
    bounds := image.Rect(0, 0, width, height)
    b = image.NewNRGBA(bounds)
    draw.Draw(b, bounds, image.NewUniform(color.White), image.ZP, draw.Src)
    dragon(14, 0, 1, sep, sep/2, sep*5/6)
    f, err := os.Create("dragon.png")
    if err != nil {
        fmt.Println(err)
        return
    }
    if err = png.Encode(f, b); err != nil {
        fmt.Println(err)
    }
    if err = f.Close(); err != nil {
        fmt.Println(err)
    }
}

func dragon(n, a, t int, d, x, y float64) {
    if n <= 1 {
        // Go packages used here do not have line drawing functions
        // so we implement a very simple line drawing algorithm here.
        // We take advantage of knowledge that we are always drawing
        // 45 degree diagonal lines.
        x1 := int(x + .5)
        y1 := int(y + .5)
        x2 := int(x + d*cos[a] + .5)
        y2 := int(y + d*sin[a] + .5)
        xInc := 1
        if x1 > x2 {
            xInc = -1
        }
        yInc := 1
        if y1 > y2 {
            yInc = -1
        }
        for x, y := x1, y1; ; x, y = x+xInc, y+yInc {
            b.Set(x, y, p)
            if x == x2 {
                break
            }
        }
        return
    }
    d *= s
    a1 := (a - t) & 7
    a2 := (a + t) & 7
    dragon(n-1, a1, 1, d, x, y)
    dragon(n-1, a2, -1, d, x+d*cos[a1], y+d*sin[a1])
}


diversityStats <- function(trueValue, estimates)
{
  collectivePrediction <- mean(estimates)
  data.frame("True Value" = trueValue,
             as.list(setNames(estimates, paste("Guess", seq_along(estimates)))), #Guesses, each with a title and column.
             "Average Error" = mean((trueValue - estimates)^2),
             "Crowd Error" = (trueValue - collectivePrediction)^2,
             "Prediction Diversity" = mean((estimates - collectivePrediction)^2))
}
diversityStats(49, c(48, 47, 51))
diversityStats(49, c(48, 47, 51, 42))


#lang racket

(define (mean l)
  (/ (apply + l) (length l)))

(define (diversity-theorem truth predictions)
  (define μ (mean predictions))
  (define (avg-sq-diff a)
    (mean (map (λ (p) (sqr (- p a))) predictions)))
  (hash 'average-error (avg-sq-diff truth)
        'crowd-error (sqr (- truth μ))
        'diversity (avg-sq-diff μ)))

(println (diversity-theorem 49 '(48 47 51)))
(println (diversity-theorem 49 '(48 47 51 42)))


sub diversity-calc($truth, @pred) {
    my $ae = avg-error($truth, @pred); # average individual error
    my $cp = ([+] @pred)/[email protected]pred;       # collective prediction
    my $ce = ($cp - $truth)**2;        # collective error
    my $pd = avg-error($cp, @pred);    # prediction diversity
    return $ae, $ce, $pd;
}

sub avg-error ($m, @v) { ([+] (@v X- $m) X**2) / +@v }

sub diversity-format (@stats) {
    gather {
        for <average-error crowd-error diversity> Z @stats -> ($label,$value) {
            take $label.fmt("%13s") ~ ':' ~ $value.fmt("%7.3f");
        }
    }
}

.say for diversity-format diversity-calc(49, <48 47 51>);
.say for diversity-format diversity-calc(49, <48 47 51 42>);


outline2table(db, Delim:= "`t"){
	oNum:=[], oMID:=[], oNod := [], oKid := [], oPnt := [], oMbr := [], oLvl := []
	oCrl := ["#ffffe6;", "#ffebd2;", "#f0fff0;", "#e6ffff;", "#ffeeff;"]
	col := 0, out := "", anc := ""

	; create numerical index for each line
	for i, line in StrSplit(db, "`n", "`r")
	{
		RegExMatch(line, "^(\t*)(.*)$", m)
		out .= m1 . i "`n"
		oNum[i] := m2
	}
	db := Trim(out, "`n")

	; create list of members, parents, kids and their ancestors
	for i, mbr in StrSplit(db, "`n", "`r")
	{
		lvl := 1
		While (SubStr(mbr, 1, 1) = Delim)
			lvl++,	mbr := SubStr(mbr, 2)

		if (pLvl >= lvl) && pMbr
			col++
			, oMbr[pLvl, pMbr] .=  "col:" col ",anc:" anc
			, oKid[pLvl, pMbr] .=  "col:" col ",anc:" anc

		if (pLvl > lvl) && pMbr
			loop % pLvl - lvl
				anc := RegExReplace(anc, "\d+_?$")

		if (pLvl < lvl) && pMbr
			anc .= pMbr "_"
			, oMbr[pLvl, pMbr] .= "col:" col+1 ",anc:" anc
			, oPnt[pLvl, pMbr] .= "col:" col+1 ",anc:" anc

		pLvl	:= lvl
		pMbr	:= mbr
		;~ oMID[lvl] := TV_Add(mbr, oMID[lvl-1], "Expand")
	}
	; last one on the list
	col++
	oMbr[pLvl, pMbr] .= "col:" col ",anc:" anc
	oKid[pLvl, pMbr] .= "col:" col ",anc:" anc

	; setup node color
	clr := 1
	for lvl, obj in oMbr
		for node, str in obj
			if (lvl <= 2)
				oNod[node, "clr"] := clr++
			else
				oNod[node, "clr"] := oNod[StrSplit(str, "_").2, "clr"]

	; setup node level/column/width
	for lvl, obj in oKid
		for node, str in obj
		{
			x := StrSplit(str, ",")
			col := StrReplace(x.1, "col:")
			anc := Trim(StrReplace(x.2, "anc:"), "_")
			for j, a in StrSplit(anc, "_")
				oNod[a, "wid"] := (oNod[a, "wid"]?oNod[a, "wid"]:0) + 1

			oNod[node, "lvl"] := lvl
			oNod[node, "col"] := col
			oNod[node, "wid"] := 1
		}

	for lvl, obj in oPnt
		for node, str in obj
		{
			x := StrSplit(str, ",")
			col := StrReplace(x.1, "col:")
			anc := Trim(StrReplace(x.2, "anc:"), "_")
			oNod[node, "lvl"] := lvl
			oNod[node, "col"] := col
		}

	; setup members by level
	for node, obj in oNod
		oLvl[obj["lvl"], node] := 1

	maxW := 0
	for node in oLvl[1]
		maxW += oNod[node, "wid"]

	; setup HTML
	html := "
`n"
	for lvl, obj in oLvl
	{
		pCol := 1
		html .= "
`n"
		for node, bool in obj
		{
			while (oNod[node, "col"] <> pCol)
				pCol++, html .= "`t<td style=""background: #F9F9F9;""></td>`n"
			pCol += oNod[node, "wid"]
			if !cNum := Mod(oNod[node, "clr"], 5)
				cNum := 5
			html .= "`t<td style=""background: " oCrl[cNum] """ colspan=""" oNod[node, "wid"] """>" oNum[node] "</td>`n"
		}
		while (pCOl <= maxW)
			pCol++, html .= "`t<td style=""background: #F9F9F9;""></td>`n"
		html .= "
`n"
	}
	html .= "
"

	; setup wikitable
	wTable := "{| class=""wikitable"" style=""text-align: center;""`n"
	for lvl, obj in oLvl
	{
		pCol := 1
		wTable .= "|-`n"
		for node, bool in obj
		{
			while (oNod[node, "col"] <> pCol)
				pCol++, wTable .= "|  | `n"
			pCol += oNod[node, "wid"]
			if !cNum := Mod(oNod[node, "clr"], 5)
				cNum := 5
			wTable .= "| style=""background: " oCrl[cNum] """ colspan=""" oNod[node, "wid"] " |" oNum[node] "`n"
		}
		while (pCOl <= maxW)
			pCol++, wTable .= "|  | `n"

	}
	wTable .= "|}`n"
	return [html, wTable]
}


# syntax: GAWK -f DISARIUM_NUMBERS.AWK
BEGIN {
    stop = 19
    printf("The first %d Disarium numbers:\n",stop)
    while (count < stop) {
      if (is_disarium(n)) {
        printf("%d ",n)
        count++
      }
      n++
    }
    printf("\n")
    exit(0)
}
function is_disarium(n,  leng,sum,x) {
    x = n
    leng = length(n)
    while (x != 0) {
      sum += (x % 10) ^ leng
      leng--
      x = int(x/10)
    }
    return((sum == n) ? 1 : 0)
}


function isDisarium(n)
	digitos = length(string(n))
	suma = 0
	x = n
	while x <> 0
		suma += (x % 10) ^ digitos
		digitos -= 1
		x = x \ 10
	end while
	if suma = n then return True else return False
end function

limite = 19
cont = 0 : n = 0
print "The first"; limite; " Disarium numbers are:"
while cont < limite
	if isDisarium(n) then
		print n; " ";
		cont += 1
	endif
	n += 1
end while
end


#include <vector>
#include <iostream>
#include <cmath>
#include <algorithm>

std::vector<int> decompose( int n ) {
   std::vector<int> digits ;
   while ( n != 0 ) {
      digits.push_back( n % 10 ) ;
      n /= 10 ;
   }
   std::reverse( digits.begin( ) , digits.end( ) ) ;
   return digits ;
}

bool isDisarium( int n ) {
   std::vector<int> digits( decompose( n ) ) ;
   int exposum = 0 ;
   for ( int i = 1 ; i < digits.size( ) + 1 ; i++ ) {
      exposum += static_cast<int>( std::pow(
               static_cast<double>(*(digits.begin( ) + i - 1 )) ,
               static_cast<double>(i) )) ;
   }
   return exposum == n ;
}

int main( ) {
   std::vector<int> disariums ;
   int current = 0 ;
   while ( disariums.size( ) != 18 ){
      if ( isDisarium( current ) )
         disariums.push_back( current ) ;
      current++ ;
   }
   for ( int d : disariums )
      std::cout << d << " " ;
   std::cout << std::endl ;
   return 0 ;
}


        ╔═════════════════════════════════════════════════════════════════════════╗
        ║        ☼☼☼☼☼☼☼☼☼☼☼ Functions of the  List Manager ☼☼☼☼☼☼☼☼☼☼☼           ║
        ║   @init      ─── initializes the List.                                  ║
        ║                                                                         ║
        ║   @size      ─── returns the size of the List  [could be a  0  (zero)]. ║
        ║                                                                         ║
        ║   @show      ─── shows (displays) the complete List.                    ║
        ║   @show k,1  ─── shows (displays) the  Kth  item.                       ║
        ║   @show k,m  ─── shows (displays)  M  items,  starting with  Kth  item. ║
        ║   @show ,,─1 ─── shows (displays) the complete List backwards.          ║
        ║                                                                         ║
        ║   @get  k    ─── returns the  Kth  item.                                ║
        ║   @get  k,m  ─── returns the  M  items  starting with the  Kth  item.   ║
        ║                                                                         ║
        ║   @put  x    ─── adds the  X  items to the  end  (tail) of the List.    ║
        ║   @put  x,0  ─── adds the  X  items to the start (head) of the List.    ║
        ║   @put  x,k  ─── adds the  X  items to before of the  Kth  item.        ║
        ║                                                                         ║
        ║   @del  k    ─── deletes the item  K.                                   ║
        ║   @del  k,m  ─── deletes the   M  items  starting with item  K.         ║
        ╚═════════════════════════════════════════════════════════════════════════╝


# Project : Doubly-linked list/Definition

test = [1, 5, 7, 0, 3, 2]
insert(test, 0, 9)
insert(test, len(test), 4)
item = len(test)/2
insert(test, item, 6)
showarray(test)

func showarray(vect)
        svect = ""
        for n = 1 to len(vect)
              svect = svect + vect[n] + " "
        next
        svect = left(svect, len(svect) - 1)
        see svect


(cond-expand
  (r7rs)
  (chicken (import r7rs)))

(import (scheme base))
(import (scheme write))
(import (scheme case-lambda))
(import (scheme process-context))

;; A doubly-linked list will be represented by a reference to any of
;; its nodes. This is possible because the "root node" is marked as
;; such.
(define-record-type <dllist>
  (%dllist root? prev next element)
  dllist?
  (root? dllist-root?)
  (prev dllist-prev %dllist-set-prev!)
  (next dllist-next %dllist-set-next!)
  (element %dllist-element))

(define (dllist-element node)
  ;; Get the element in a node. It is an error if the node is the
  ;; root.
  (when (dllist-root? node)
    (display "dllist-element of a root node\n" (current-error-port))
    (exit 1))
  (%dllist-element node))

(define (dllist . elements)
  ;; Make a doubly-linked list from the given elements.
  (list->dllist elements))

(define (make-dllist)
  ;; Return a node marked as being a root, and which points to itself.
  (let ((root (%dllist #t #f #f #f)))
    (%dllist-set-prev! root root)
    (%dllist-set-next! root root)
    root))

(define (dllist-root node)
  ;; Given a reference to any node of a <dllist>, return a reference
  ;; to the list's root node.
  (if (dllist-root? node)
      node
      (dllist-root (dllist-prev node))))

(define (dllist-insert-after! node element)
  ;; Insert an element after the given node, which may be either the
  ;; root or some other node.
  (let* ((next-node (dllist-next node))
         (new-node (%dllist #f node next-node element)))
    (%dllist-set-next! node new-node)
    (%dllist-set-prev! next-node new-node)))

(define (dllist-insert-before! node element)
  ;; Insert an element before the given node, which may be either the
  ;; root or some other node.
  (let* ((prev-node (dllist-prev node))
         (new-node (%dllist #f prev-node node element)))
    (%dllist-set-next! prev-node new-node)
    (%dllist-set-prev! node new-node)))

(define (dllist-remove! node)
  ;; Remove a node from a <dllist>. It is an error if the node is the
  ;; root.
  (when (dllist-root? node)
    (display "dllist-remove! of a root node\n" (current-error-port))
    (exit 1))
  (let ((prev (dllist-prev node))
        (next (dllist-next node)))
    (%dllist-set-next! prev next)
    (%dllist-set-prev! next prev)))

(define dllist-make-generator
  ;; Make a thunk that returns the elements of the list, starting at
  ;; the root and going in either direction.
  (case-lambda
    ((node) (dllist-make-generator node 1))
    ((node direction)
     (if (negative? direction)
         (let ((p (dllist-prev (dllist-root node))))
           (lambda ()
             (and (not (dllist-root? p))
                  (let ((element (dllist-element p)))
                    (set! p (dllist-prev p))
                    element))))
         (let ((p (dllist-next (dllist-root node))))
           (lambda ()
             (and (not (dllist-root? p))
                  (let ((element (dllist-element p)))
                    (set! p (dllist-next p))
                    element))))))))

(define (list->dllist lst)
  ;; Make a doubly-linked list from the elements of an ordinary list.
  (let loop ((node (make-dllist))
             (lst lst))
    (if (null? lst)
        (dllist-next node)
        (begin
          (dllist-insert-after! node (car lst))
          (loop (dllist-next node) (cdr lst))))))

(define (dllist->list node)
  ;; Make an ordinary list from the elements of a doubly-linked list.
  (let loop ((lst '())
             (node (dllist-prev (dllist-root node))))
    (if (dllist-root? node)
        lst
        (loop (cons (dllist-element node) lst) (dllist-prev node)))))

;;;
;;; Some demonstration.
;;;

(define (print-it node)
  (let ((gen (dllist-make-generator node)))
    (do ((x (gen) (gen)))
        ((not x))
      (display " ")
      (write x))
    (newline)))

(define dl (dllist 10 20 30 40 50))

(let ((gen (dllist-make-generator dl)))
  (display "forwards generator: ")
  (do ((x (gen) (gen)))
      ((not x))
    (display " ")
    (write x))
  (newline))

(let ((gen (dllist-make-generator dl -1)))
  (display "backwards generator:")
  (do ((x (gen) (gen)))
      ((not x))
    (display " ")
    (write x))
  (newline))

(display "insertion after the root: ")
(dllist-insert-after! dl 5)
(print-it dl)

(display "insertion before the root:")
(dllist-insert-before! dl 55)
(print-it dl)

(display "insertion after the second element:")
(dllist-insert-after! (dllist-next (dllist-next dl)) 15)
(print-it dl)

(display "insertion before the second from last element:")
(dllist-insert-before! (dllist-prev (dllist-prev dl)) 45)
(print-it dl)

(display "removal of the element 30:")
(let ((node (let loop ((node (dllist-next dl)))
              (if (= (dllist-element node) 30)
                  node
                  (loop (dllist-next node))))))
  (dllist-remove! node))
(print-it dl)

(display "any node can be used for the generator:")
(print-it (dllist-next (dllist-next (dllist-next dl))))

(display "conversion to a list: ")
(display (dllist->list dl))
(newline)

(display "conversion from a list:")
(print-it (list->dllist (list "a" "b" "c")))


#lang racket

(require net/dns)
(dns-get-address "8.8.8.8" "www.kame.net")


use Net::DNS;

my $resolver = Net::DNS.new('8.8.8.8');

my $ip4 = $resolver.lookup('A',    'orange.kame.net');
my $ip6 = $resolver.lookup('AAAA', 'orange.kame.net');

say $ip4[0].octets.join: '.';
say $ip6[0].octets.».fmt("%.2X").join.comb(4).join: ':';


/*REXX program displays  IPV4 and IPV6  addresses for a supplied  domain name.*/
parse arg tar .                        /*obtain optional domain name from C.L.*/
if tar==''  then tar= 'www.kame.net'   /*Not specified?  Then use the default.*/
tFID    = '\TEMP\DNSQUERY.$$$'         /*define temp file to store IPV4 output*/
pingOpts= '-l 0    -n 1    -w 0'   tar /*define options for the PING command. */
trace off                              /*don't show PING none─zero return code*/
                                       /* [↓]  perform 2 versions of PING cmd.*/
  do j=4  to 6  by 2                   /*handle  IPV4  and  IPV6  addresses.  */
  'PING'  (-j)  pingOpts  ">"   tFID   /*restrict PING's output to a minimum. */
  q=charin(tFID, 1, 999)               /*read the output file from  PING  cmd.*/
  parse var  q   '['   ipaddr    "]"   /*parse  IP  address from the output.  */
  say 'IPV'j "for domain name  "  tar  '  is  '  ipaddr        /*IPVx address.*/
  call lineout tFID                    /* ◄──┬─◄  needed by some REXXes to    */
  end   /*j*/                          /*    └─◄  force (TEMP) file integrity.*/
                                       /*stick a fork in it,  we're all done. */
'ERASE'  tFID                          /*clean up (delete) the temporary file.*/


irb(main):001:0> require 'socket'
=> true
irb(main):002:0> Addrinfo.getaddrinfo("www.kame.net", nil, nil, :DGRAM) \
irb(main):003:0*   .map! { |ai| ai.ip_address }
=> ["203.178.141.194", "2001:200:dff:fff1:216:3eff:feb1:44d7"]


(task (port 12321)                     # Background server task
   (let? Sock (accept @)
      (unless (fork)                   # Handle request in child process
         (in Sock
            (while (rd)                # Handle requests
               (out Sock
                  (pr (eval @)) ) ) )  # Evaluate and send reply
         (bye) )                       # Exit child process
      (close Sock) ) )                 # Close socket in parent process


#!/usr/bin/env python
# -*- coding: utf-8 -*-

import SimpleXMLRPCServer

class MyHandlerInstance:
    def echo(self, data):
        '''Method for returning data got from client'''
        return 'Server responded: %s' % data

    def div(self, num1, num2):
        '''Method for divide 2 numbers'''
        return num1/num2

def foo_function():
    '''A function (not an instance method)'''
    return True

HOST = "localhost"
PORT = 8000

server = SimpleXMLRPCServer.SimpleXMLRPCServer((HOST, PORT))

# register built-in system.* functions.
server.register_introspection_functions()

# register our instance
server.register_instance(MyHandlerInstance())

# register our function as well
server.register_function(foo_function)

try:
    # serve forever
    server.serve_forever()
except KeyboardInterrupt:
    print 'Exiting...'
    server.server_close()


#lang racket/base
(require racket/place/distributed racket/place)

(define (fib n)
  (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2)))))

(provide work)
(define (work)
  (place ch
    (place-channel-put ch (fib (place-channel-get ch)))))

(module+ main
  (define places
    (for/list ([host '("localhost" "localhost" "localhost" "localhost")]
               [port (in-naturals 12345)])
      (define-values [node place]
        (spawn-node-supervise-place-at host #:listen-port port #:thunk #t
                                       (quote-module-path "..") 'work))
      place))
  (message-router
   (after-seconds 1
     (for ([p places]) (*channel-put p 42))
     (printf "Results: ~s\n" (map *channel-get places))
     (exit))))


./server.raku --usage
Usage:
  server.p6 [--server=<Any>] [--port=<Any>]


require 'drb/drb'

# The URI for the server to connect to
URI="druby://localhost:8787"

class TimeServer

  def get_current_time
    return Time.now
  end

end

# The object that handles requests on the server
FRONT_OBJECT = TimeServer.new

$SAFE = 1   # disable eval() and friends

DRb.start_service(URI, FRONT_OBJECT)
# Wait for the drb server thread to finish before exiting.
DRb.thread.join


use utf8;                # interpret source code as UTF8
binmode STDOUT, ':utf8'; # allow printing wide chars without warning
$|++;                    # disable output buffering

my ($rows, $cols) = split /\s+/, `stty size`;
my $x = int($rows / 2 - 1);
my $y = int($cols / 2 - 16);

my @chars = map {[ /(...)/g ]}
            ("┌─┐  ╷╶─┐╶─┐╷ ╷┌─╴┌─╴╶─┐┌─┐┌─┐   ",
             "│ │  │┌─┘╶─┤└─┤└─┐├─┐  │├─┤└─┤ : ",
             "└─┘  ╵└─╴╶─┘  ╵╶─┘└─┘  ╵└─┘╶─┘   ");

while (1) {
    my @indices = map { ord($_) - ord('0') } split //,
                  sprintf("%02d:%02d:%02d", (localtime(time))[2,1,0]);

    clear();
    for (0 .. $#chars) {
      position($x + $_, $y);
      print "@{$chars[$_]}[@indices]";
    }
    position(1, 1);

    sleep 1;
}

sub clear { print "\e[H\e[J" }
sub position { printf "\e[%d;%dH", shift, shift }


# syntax: GAWK -f DOT_PRODUCT.AWK
BEGIN {
    v1 = "1,3,-5"
    v2 = "4,-2,-1"
    if (split(v1,v1arr,",") != split(v2,v2arr,",")) {
      print("error: vectors are of unequal lengths")
      exit(1)
    }
    printf("%g\n",dot_product(v1arr,v2arr))
    exit(0)
}
function dot_product(v1,v2,  i,sum) {
    for (i in v1) {
      sum += v1[i] * v2[i]
    }
    return(sum)
}


 100 :
 110  REM  DOT PRODUCT
 120 :
 130  REM  INITIALIZE VECTORS OF LENGTH N
 140  N = 3
 150  DIM V1(N): DIM V2(N)
 160  FOR I = 1 TO N
 170  V1(I) =  INT ( RND (1) * 20 - 9.5)
 180  V2(I) =  INT ( RND (1) * 20 - 9.5)
 190  NEXT I
 300 :
 310  REM  CALCULATE THE DOT PRODUCT
 320 :
 330  FOR I = 1 TO N:DP = DP + V1(I) * V2(I): NEXT I
 400 :
 410  REM  DISPLAY RESULT
 420 :
 430  PRINT "[";: FOR I = 1 TO N: PRINT " ";V1(I);: NEXT I
 440  PRINT "] . [";: FOR I = 1 TO N: PRINT " ";V2(I);: NEXT I
 450  PRINT "] = ";DP


`Draw Dragon [ from .x1. .y1. to .x2. .y2. [level .level.] ]'
Draw a dragon curve going from .x1. .y1. to .x2. .y2. with recursion
depth .level.

The total number of line segments for the recursion is 2^level.
level=0 is a straight line from x1,y1 to x2,y2.

The default for x1,y1 and x2,y2 is to draw horizontally from 0,0
to 1,0.
{
    new .x1. .y1. .x2. .y2. .level.
    .x1. = \.word3.
    .y1. = \.word4.
    .x2. = \.word6.
    .y2. = \.word7.
    .level. = \.word9.

    if {rpn \.words. 5 >=}
        .x2. = 1
        .y2. = 0
    end if
    if {rpn \.words. 7 >=}
        .level. = 6
    end if

    if {rpn 0 .level. <=}
        draw line from .x1. .y1. to .x2. .y2.
    else
        .level. = {rpn .level. 1 -}

        # xmid,ymid is half way between x1,y1 and x2,y2 and up at
        # right angles away.
        #
        #            xmid,ymid             xmid = (x1+x2 + y2-y1)/2
        #            ^       ^             ymid = (x1-x2 + y1+y2)/2
        #           /    .    \
        #          /     .     \
        #     x1,y1 ........... x2,y2
        #
        new .xmid. .ymid.
        .xmid. = {rpn .x1. .x2. + .y2. .y1. - + 2 /}
        .ymid. = {rpn .x1. .x2. - .y1. .y2. + + 2 /}

        # The recursion is a level-1 dragon from x1,y1 to the midpoint
        # and the same from x2,y2 to the midpoint (the latter
        # effectively being a revered dragon.)
        #
        Draw Dragon from .x1. .y1. to .xmid. .ymid. level .level.
        Draw Dragon from .x2. .y2. to .xmid. .ymid. level .level.

        delete .xmid. .ymid.
    end if

    delete .x1. .y1. .x2. .y2. .level.
}

# Dragon curve from 0,0 to 1,0 extends out by 1/3 at the ends, so
# extents -0.5 to +1.5 for a bit of margin.  The Y extent is the same
# size 2 to make the graph square.
set x axis -0.5 1.5   .25
set y axis -1 1 .25

Draw Dragon


import Data.List
import Graphics.Gnuplot.Simple

-- diamonds
-- pl = [[0,1],[1,0]]

pl = [[0,0],[0,1]]
r_90 = [[0,1],[-1,0]]

ip :: [Int] -> [Int] -> Int
ip xs = sum . zipWith (*) xs
matmul xss yss = map (\xs -> map (ip xs ). transpose $ yss) xss

vmoot xs = (xs++).map (zipWith (+) lxs). flip matmul r_90.
          map (flip (zipWith (-)) lxs) .reverse . init $ xs
   where lxs = last xs

dragoncurve = iterate vmoot pl


/* REXX */
Numeric Digits 20
Call diversityTheorem 49,'48 47 51'
Say '--------------------------------------'
Call diversityTheorem 49,'48 47 51 42'
Exit

diversityTheorem:
  Parse Arg truth,list
  average=average(list)
  Say 'average-error='averageSquareDiff(truth,list)
  Say 'crowd-error='||(truth-average)**2
  Say 'diversity='averageSquareDiff(average,list)
  Return

average: Procedure
  Parse Arg list
  res=0
  Do i=1 To words(list)
    res=res+word(list,i)  /* accumulate list elements */
    End
  Return res/words(list)  /* return the average */

averageSquareDiff: Procedure
  Parse Arg a,list
  res=0
  Do i=1 To words(list)
    x=word(list,i)
    res=res+(x-a)**2      /* accumulate square of differences */
    End
  Return res/words(list)  /* return the average */


def mean(a) = a.sum(0.0) / a.size
def mean_square_diff(a, predictions) = mean(predictions.map { |x| square(x - a)**2 })

def diversity_theorem(truth, predictions)
    average = mean(predictions)
    puts "truth: #{truth}, predictions #{predictions}",
         "average-error: #{mean_square_diff(truth, predictions)}",
         "crowd-error: #{(truth - average)**2}",
         "diversity: #{mean_square_diff(average, predictions)}",""
end

diversity_theorem(49.0, [48.0, 47.0, 51.0])
diversity_theorem(49.0, [48.0, 47.0, 51.0, 42.0])


object DiversityPredictionTheorem {
  def square(d: Double): Double
  = d * d

  def average(a: Array[Double]): Double
  = a.sum / a.length

  def averageSquareDiff(d: Double, predictions: Array[Double]): Double
  = average(predictions.map(it => square(it - d)))

  def diversityTheorem(truth: Double, predictions: Array[Double]): String = {
    val avg = average(predictions)
    f"average-error : ${averageSquareDiff(truth, predictions)}%6.3f\n" +
    f"crowd-error   : ${square(truth - avg)}%6.3f\n"+
    f"diversity     : ${averageSquareDiff(avg, predictions)}%6.3f\n"
  }

  def main(args: Array[String]): Unit = {
    println(diversityTheorem(49.0, Array(48.0, 47.0, 51.0)))
    println(diversityTheorem(49.0, Array(48.0, 47.0, 51.0, 42.0)))
  }
}


package main

import (
    "fmt"
    "strings"
)

type nNode struct {
    name     string
    children []nNode
}

type iNode struct {
    level int
    name  string
}

func toNest(iNodes []iNode, start, level int, n *nNode) {
    if level == 0 {
        n.name = iNodes[0].name
    }
    for i := start + 1; i < len(iNodes); i++ {
        if iNodes[i].level == level+1 {
            c := nNode{iNodes[i].name, nil}
            toNest(iNodes, i, level+1, &c)
            n.children = append(n.children, c)
        } else if iNodes[i].level <= level {
            return
        }
    }
}

func makeIndent(outline string, tab int) []iNode {
    lines := strings.Split(outline, "\n")
    iNodes := make([]iNode, len(lines))
    for i, line := range lines {
        line2 := strings.TrimLeft(line, " ")
        le, le2 := len(line), len(line2)
        level := (le - le2) / tab
        iNodes[i] = iNode{level, line2}
    }
    return iNodes
}

func toMarkup(n nNode, cols []string, depth int) string {
    var span int

    var colSpan func(nn nNode)
    colSpan = func(nn nNode) {
        for i, c := range nn.children {
            if i > 0 {
                span++
            }
            colSpan(c)
        }
    }

    for _, c := range n.children {
        span = 1
        colSpan(c)
    }
    var lines []string
    lines = append(lines, `{| class="wikitable" style="text-align: center;"`)
    const l1, l2 = "|-", "|  |"
    lines = append(lines, l1)
    span = 1
    colSpan(n)
    s := fmt.Sprintf(`| style="background: %s " colSpan=%d | %s`, cols[0], span, n.name)
    lines = append(lines, s, l1)

    var nestedFor func(nn nNode, level, maxLevel, col int)
    nestedFor = func(nn nNode, level, maxLevel, col int) {
        if level == 1 && maxLevel > level {
            for i, c := range nn.children {
                nestedFor(c, 2, maxLevel, i)
            }
        } else if level < maxLevel {
            for _, c := range nn.children {
                nestedFor(c, level+1, maxLevel, col)
            }
        } else {
            if len(nn.children) > 0 {
                for i, c := range nn.children {
                    span = 1
                    colSpan(c)
                    cn := col + 1
                    if maxLevel == 1 {
                        cn = i + 1
                    }
                    s := fmt.Sprintf(`| style="background: %s " colspan=%d | %s`, cols[cn], span, c.name)
                    lines = append(lines, s)
                }
            } else {
                lines = append(lines, l2)
            }
        }
    }
    for maxLevel := 1; maxLevel < depth; maxLevel++ {
        nestedFor(n, 1, maxLevel, 0)
        if maxLevel < depth-1 {
            lines = append(lines, l1)
        }
    }
    lines = append(lines, "|}")
    return strings.Join(lines, "\n")
}

func main() {
    const outline = `Display an outline as a nested table.
    Parse the outline to a tree,
        measuring the indent of each line,
        translating the indentation to a nested structure,
        and padding the tree to even depth.
    count the leaves descending from each node,
        defining the width of a leaf as 1,
        and the width of a parent node as a sum.
            (The sum of the widths of its children)
    and write out a table with 'colspan' values
        either as a wiki table,
        or as HTML.`
    const (
        yellow = "#ffffe6;"
        orange = "#ffebd2;"
        green  = "#f0fff0;"
        blue   = "#e6ffff;"
        pink   = "#ffeeff;"
    )
    cols := []string{yellow, orange, green, blue, pink}
    iNodes := makeIndent(outline, 4)
    var n nNode
    toNest(iNodes, 0, 0, &n)
    fmt.Println(toMarkup(n, cols, 4))

    fmt.Println("\n")
    const outline2 = `Display an outline as a nested table.
    Parse the outline to a tree,
        measuring the indent of each line,
        translating the indentation to a nested structure,
        and padding the tree to even depth.
    count the leaves descending from each node,
        defining the width of a leaf as 1,
        and the width of a parent node as a sum.
            (The sum of the widths of its children)
            Propagating the sums upward as necessary.
    and write out a table with 'colspan' values
        either as a wiki table,
        or as HTML.
    Optionally add color to the nodes.`
    cols2 := []string{blue, yellow, orange, green, pink}
    var n2 nNode
    iNodes2 := makeIndent(outline2, 4)
    toNest(iNodes2, 0, 0, &n2)
    fmt.Println(toMarkup(n2, cols2, 4))
}


USING: io kernel lists lists.lazy math.ranges math.text.utils
math.vectors prettyprint sequences ;

: disarium? ( n -- ? )
    dup 1 digit-groups dup length 1 [a,b] v^ sum = ;

: disarium ( -- list ) 0 lfrom [ disarium? ] lfilter ;

19 disarium ltake [ pprint bl ] leach nl


package main

import (
    "fmt"
    "strconv"
)

const DMAX = 20  // maximum digits
const LIMIT = 20 // maximum number of disariums to find

func main() {
    // Pre-calculated exponential and power serials
    EXP := make([][]uint64, 1+DMAX)
    POW := make([][]uint64, 1+DMAX)

    EXP[0] = make([]uint64, 11)
    EXP[1] = make([]uint64, 11)
    POW[0] = make([]uint64, 11)
    POW[1] = make([]uint64, 11)
    for i := uint64(1); i <= 10; i++ {
        EXP[1][i] = i
    }
    for i := uint64(1); i <= 9; i++ {
        POW[1][i] = i
    }
    POW[1][10] = 9

    for i := 2; i <= DMAX; i++ {
        EXP[i] = make([]uint64, 11)
        POW[i] = make([]uint64, 11)
    }
    for i := 1; i < DMAX; i++ {
        for j := 0; j <= 9; j++ {
            EXP[i+1][j] = EXP[i][j] * 10
            POW[i+1][j] = POW[i][j] * uint64(j)
        }
        EXP[i+1][10] = EXP[i][10] * 10
        POW[i+1][10] = POW[i][10] + POW[i+1][9]
    }

    // Digits of candidate and values of known low bits
    DIGITS := make([]int, 1+DMAX) // Digits form
    Exp := make([]uint64, 1+DMAX) // Number form
    Pow := make([]uint64, 1+DMAX) // Powers form

    var exp, pow, min, max uint64
    start := 1
    final := DMAX
    count := 0
    for digit := start; digit <= final; digit++ {
        fmt.Println("# of digits:", digit)
        level := 1
        DIGITS[0] = 0
        for {
            // Check limits derived from already known low bit values
            // to find the most possible candidates
            for 0 < level && level < digit {
                // Reset path to try next if checking in level is done
                if DIGITS[level] > 9 {
                    DIGITS[level] = 0
                    level--
                    DIGITS[level]++
                    continue
                }

                // Update known low bit values
                Exp[level] = Exp[level-1] + EXP[level][DIGITS[level]]
                Pow[level] = Pow[level-1] + POW[digit+1-level][DIGITS[level]]

                // Max possible value
                pow = Pow[level] + POW[digit-level][10]

                if pow < EXP[digit][1] { // Try next since upper limit is invalidly low
                    DIGITS[level]++
                    continue
                }

                max = pow % EXP[level][10]
                pow -= max
                if max < Exp[level] {
                    pow -= EXP[level][10]
                }
                max = pow + Exp[level]

                if max < EXP[digit][1] { // Try next since upper limit is invalidly low
                    DIGITS[level]++
                    continue
                }

                // Min possible value
                exp = Exp[level] + EXP[digit][1]
                pow = Pow[level] + 1

                if exp > max || max < pow { // Try next since upper limit is invalidly low
                    DIGITS[level]++
                    continue
                }

                if pow > exp {
                    min = pow % EXP[level][10]
                    pow -= min
                    if min > Exp[level] {
                        pow += EXP[level][10]
                    }
                    min = pow + Exp[level]
                } else {
                    min = exp
                }

                // Check limits existence
                if max < min {
                    DIGITS[level]++ // Try next number since current limits invalid
                } else {
                    level++ // Go for further level checking since limits available
                }
            }

            // All checking is done, escape from the main check loop
            if level < 1 {
                break
            }

            // Finally check last bit of the most possible candidates
            // Update known low bit values
            Exp[level] = Exp[level-1] + EXP[level][DIGITS[level]]
            Pow[level] = Pow[level-1] + POW[digit+1-level][DIGITS[level]]

            // Loop to check all last bits of candidates
            for DIGITS[level] < 10 {
                // Print out new Disarium number
                if Exp[level] == Pow[level] {
                    s := ""
                    for i := DMAX; i > 0; i-- {
                        s += fmt.Sprintf("%d", DIGITS[i])
                    }
                    n, _ := strconv.ParseUint(s, 10, 64)
                    fmt.Println(n)
                    count++
                    if count == LIMIT {
                        fmt.Println("\nFound the first", LIMIT, "Disarium numbers.")
                        return
                    }
                }

                // Go to followed last bit candidate
                DIGITS[level]++
                Exp[level] += EXP[level][1]
                Pow[level]++
            }

            // Reset to try next path
            DIGITS[level] = 0
            level--
            DIGITS[level]++
        }
        fmt.Println()
    }
}


(cond-expand
  (r7rs)
  (chicken (import r7rs)))

(import (scheme base))
(import (scheme write))
(import (scheme case-lambda))
(import (scheme process-context))

;; A doubly-linked list will be represented by a reference to any of
;; its nodes. This is possible because the "root node" is marked as
;; such.
(define-record-type <dllist>
  (%dllist root? prev next element)
  dllist?
  (root? dllist-root?)
  (prev dllist-prev %dllist-set-prev!)
  (next dllist-next %dllist-set-next!)
  (element %dllist-element))

(define (dllist-element node)
  ;; Get the element in a node. It is an error if the node is the
  ;; root.
  (when (dllist-root? node)
    (display "dllist-element of a root node\n" (current-error-port))
    (exit 1))
  (%dllist-element node))

(define (dllist . elements)
  ;; Make a doubly-linked list from the given elements.
  (list->dllist elements))

(define (make-dllist)
  ;; Return a node marked as being a root, and which points to itself.
  (let ((root (%dllist #t #f #f #f)))
    (%dllist-set-prev! root root)
    (%dllist-set-next! root root)
    root))

(define (dllist-root node)
  ;; Given a reference to any node of a <dllist>, return a reference
  ;; to the list's root node.
  (if (dllist-root? node)
      node
      (dllist-root (dllist-prev node))))

(define (dllist-insert-after! node element)
  ;; Insert an element after the given node, which may be either the
  ;; root or some other node.
  (let* ((next-node (dllist-next node))
         (new-node (%dllist #f node next-node element)))
    (%dllist-set-next! node new-node)
    (%dllist-set-prev! next-node new-node)))

(define (dllist-insert-before! node element)
  ;; Insert an element before the given node, which may be either the
  ;; root or some other node.
  (let* ((prev-node (dllist-prev node))
         (new-node (%dllist #f prev-node node element)))
    (%dllist-set-next! prev-node new-node)
    (%dllist-set-prev! node new-node)))

(define (dllist-remove! node)
  ;; Remove a node from a <dllist>. It is an error if the node is the
  ;; root.
  (when (dllist-root? node)
    (display "dllist-remove! of a root node\n" (current-error-port))
    (exit 1))
  (let ((prev (dllist-prev node))
        (next (dllist-next node)))
    (%dllist-set-next! prev next)
    (%dllist-set-prev! next prev)))

(define dllist-make-generator
  ;; Make a thunk that returns the elements of the list, starting at
  ;; the root and going in either direction.
  (case-lambda
    ((node) (dllist-make-generator node 1))
    ((node direction)
     (if (negative? direction)
         (let ((p (dllist-prev (dllist-root node))))
           (lambda ()
             (and (not (dllist-root? p))
                  (let ((element (dllist-element p)))
                    (set! p (dllist-prev p))
                    element))))
         (let ((p (dllist-next (dllist-root node))))
           (lambda ()
             (and (not (dllist-root? p))
                  (let ((element (dllist-element p)))
                    (set! p (dllist-next p))
                    element))))))))

(define (list->dllist lst)
  ;; Make a doubly-linked list from the elements of an ordinary list.
  (let loop ((node (make-dllist))
             (lst lst))
    (if (null? lst)
        (dllist-next node)
        (begin
          (dllist-insert-after! node (car lst))
          (loop (dllist-next node) (cdr lst))))))

(define (dllist->list node)
  ;; Make an ordinary list from the elements of a doubly-linked list.
  (let loop ((lst '())
             (node (dllist-prev (dllist-root node))))
    (if (dllist-root? node)
        lst
        (loop (cons (dllist-element node) lst) (dllist-prev node)))))

;;;
;;; Some demonstration.
;;;

(define (print-it node)
  (let ((gen (dllist-make-generator node)))
    (do ((x (gen) (gen)))
        ((not x))
      (display " ")
      (write x))
    (newline)))

(define dl (dllist 10 20 30 40 50))

(let ((gen (dllist-make-generator dl)))
  (display "forwards generator: ")
  (do ((x (gen) (gen)))
      ((not x))
    (display " ")
    (write x))
  (newline))

(let ((gen (dllist-make-generator dl -1)))
  (display "backwards generator:")
  (do ((x (gen) (gen)))
      ((not x))
    (display " ")
    (write x))
  (newline))

(display "insertion after the root: ")
(dllist-insert-after! dl 5)
(print-it dl)

(display "insertion before the root:")
(dllist-insert-before! dl 55)
(print-it dl)

(display "insertion after the second element:")
(dllist-insert-after! (dllist-next (dllist-next dl)) 15)
(print-it dl)

(display "insertion before the second from last element:")
(dllist-insert-before! (dllist-prev (dllist-prev dl)) 45)
(print-it dl)

(display "removal of the element 30:")
(let ((node (let loop ((node (dllist-next dl)))
              (if (= (dllist-element node) 30)
                  node
                  (loop (dllist-next node))))))
  (dllist-remove! node))
(print-it dl)

(display "any node can be used for the generator:")
(print-it (dllist-next (dllist-next (dllist-next dl))))

(display "conversion to a list: ")
(display (dllist->list dl))
(newline)

(display "conversion from a list:")
(print-it (list->dllist (list "a" "b" "c")))