package require sha256

# Generate a large and boring piece of code to do the decoding of
# base58-encoded data.
apply {{} {
    set chars "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
    set i -1
    foreach c [split $chars ""] {
	lappend map $c "return -level 0 [incr i]"
    }
    lappend map default {return -code error "bad character \"$c\""}
    proc base58decode str [string map [list @[email protected] [list $map]] {
	set num 0
	set count [expr {ceil(log(58**[string length $str])/log(256))}]
	foreach c [split $str {}] {
	    set num [expr {$num*58+[switch $c @[email protected]]}]
	}
	for {set i 0} {$i < $count} {incr i} {
	    append result [binary format c [expr {$num & 255}]]
	    set num [expr {$num >> 8}]
	}
	return [string reverse $result]
    }]
}}

# How to check bitcoin address validity
proc bitcoin_addressValid {address} {
    set a [base58decode $address]
    set ck [sha2::sha256 -bin [sha2::sha256 -bin [string range $a 0 end-4]]]
    if {[string range $a end-3 end] ne [string range $ck 0 3]} {
	return -code error "signature does not match"
    }
    return "$address is ok"
}


base58=({1..9} {A..H} {J..N} {P..Z} {a..k} {m..z})
bitcoinregex="^[$(printf "%s" "${base58[@]}")]{34}$"

decodeBase58() {
    local s=$1
    for i in {0..57}
    do s="${s//${base58[i]}/ $i}"
    done
    dc <<< "16o0d${s// /+58*}+f"
}

checksum() {
    xxd -p -r <<<"$1" |
    openssl dgst -sha256 -binary |
    openssl dgst -sha256 -binary |
    xxd -p -c 80 |
    head -c 8
}

checkBitcoinAddress() {
    if [[ "$1" =~ $bitcoinregex ]]
    then
        h=$(decodeBase58 "$1")
        checksum "00${h::${#h}-8}" |
        grep -qi "^${h: -8}$"
    else return 2
    fi
}


import "/crypto" for Sha256
import "/str" for Str
import "/fmt" for Conv, Fmt

class Bitcoin {
    static alphabet_ { "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" }

    static contentEquals_(ba1, ba2) {
        if (ba1.count != ba2.count) return false
        return !(0...ba1.count).any { |i| ba1[i] != ba2[i] }
    }

    static decodeBase58_(input) {
        var output = List.filled(25, 0)
        for (c in input) {
            var p = alphabet_.indexOf(c)
            if (p == -1) return null
            for (j in 24..1) {
                p = p +  58 * output[j]
                output[j] = p % 256
                p = p >> 8
            }
            if (p != 0) return null
        }
        return output
    }

    static sha256_(data, start, len, recursion) {
        if (recursion == 0) return data
        var md = Sha256.digest(data[start...start+len])
        md = Str.chunks(md, 2).map { |x| Conv.atoi(x, 16) }.toList
        return sha256_(md, 0, 32, recursion-1)
    }

    static validateAddress(address) {
        var len = address.count
        if (len < 26 || len > 35) return false
        var decoded = decodeBase58_(address)
        if (!decoded) return false
        var hash = sha256_(decoded, 0, 21, 2)
        return contentEquals_(hash[0..3], decoded[21..24])
    }
}

var addresses = [
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i",
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62j",
    "1Q1pE5vPGEEMqRcVRMbtBK842Y6Pzo6nK9",
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62X",
    "1ANNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i",
    "1A Na15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i",
    "BZbvjr",
    "i55j",
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62!",
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62iz",
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62izz",
    "1Q1pE5vPGEEMqRcVRMbtBK842Y6Pzo6nJ9",
    "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62I"
]
for (address in addresses) {
    Fmt.print("$-36s -> $s", address, Bitcoin.validateAddress(address) ? "valid" : "invalid")
}


var [const] MsgHash=Import("zklMsgHash"); // SHA-256, etc
const symbols="123456789"  // 58 characters: no cap i,o; ell, zero
	      "ABCDEFGHJKLMNPQRSTUVWXYZ"
	      "abcdefghijkmnopqrstuvwxyz";

fcn unbase58(str){  // --> Data (byte bucket)
   out:=Data().fill(0,25);
   str.pump(Void,symbols.index,'wrap(n){  // throws on out of range
      [24..0,-1].reduce('wrap(c,idx){
         c+=58*out[idx];  // throws if not enough data
         out[idx]=c;
         c/256;		  // should be zero when done
      },n) : if(_) throw(Exception.ValueError("address too long"));
   });
   out;
}

fcn coinValide(addr){
   reg dec,chkSum;
   try{ dec=unbase58(addr) }catch{ return(False) }
   chkSum=dec[-4,*]; dec.del(21,*);
   // hash then hash the hash --> binary hash (instead of hex string)
   (2).reduce(MsgHash.SHA256.fp1(1,dec),dec);  // dec is i/o buffer
   dec[0,4]==chkSum;
}


#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <openssl/sha.h>
#include <openssl/ripemd.h>

#define COIN_VER 0
const char *coin_err;

typedef unsigned char byte;

int is_hex(const char *s) {
	int i;
	for (i = 0; i < 64; i++)
		if (!isxdigit(s[i])) return 0;
	return 1;
}

void str_to_byte(const char *src, byte *dst, int n) {
	while (n--) sscanf(src + n * 2, "%2hhx", dst + n);
}

char* base58(byte *s, char *out) {
	static const char *tmpl = "123456789"
		"ABCDEFGHJKLMNPQRSTUVWXYZ"
		"abcdefghijkmnopqrstuvwxyz";
	static char buf[40];

	int c, i, n;
	if (!out) out = buf;

	out[n = 34] = 0;
	while (n--) {
		for (c = i = 0; i < 25; i++) {
			c = c * 256 + s[i];
			s[i] = c / 58;
			c %= 58;
		}
		out[n] = tmpl[c];
	}

	for (n = 0; out[n] == '1'; n++);
	memmove(out, out + n, 34 - n);

	return out;
}

char *coin_encode(const char *x, const char *y, char *out) {
	byte s[65];
	byte rmd[5 + RIPEMD160_DIGEST_LENGTH];

	if (!is_hex(x) || !(is_hex(y))) {
		coin_err = "bad public point string";
		return 0;
	}

	s[0] = 4;
	str_to_byte(x, s + 1, 32);
	str_to_byte(y, s + 33, 32);

	rmd[0] = COIN_VER;
	RIPEMD160(SHA256(s, 65, 0), SHA256_DIGEST_LENGTH, rmd + 1);

	memcpy(rmd + 21, SHA256(SHA256(rmd, 21, 0), SHA256_DIGEST_LENGTH, 0), 4);

	return base58(rmd, out);
}

int main(void) {
	puts(coin_encode(
		"50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
		"2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6",
		0));
	return 0;
}


;;;; This is a revised version, inspired by a throwaway script originally
;;;; published at http://deedbot.org/bundle-381528.txt by the same Adlai.

;;; package definition
(cl:defpackage :bitcoin-address-encoder
  (:use :cl . #.(ql:quickload :ironclad))
  (:shadowing-import-from :ironclad #:null)
  (:import-from :ironclad #:simple-octet-vector))
(cl:in-package :bitcoin-address-encoder)

;;; secp256k1, as shown concisely in https://en.bitcoin.it/wiki/Secp256k1
;;; and officially defined by the SECG at http://www.secg.org/sec2-v2.pdf
(macrolet ((define-constants (&rest constants)
             `(progn ,@(loop for (name value) on constants by #'cddr
                          collect `(defconstant ,name ,value)))))
  (define-constants
    ;; these constants are only necessary for computing public keys
    xg #x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798
    yg #x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8
    ng #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141

    ;; this constant is necessary both for computation and validation
    p  #.`(- ,@(mapcar (lambda (n) (ash 1 n)) '(256 32 9 8 7 6 4 0)))
    ))

;;; operations within the field of positive integers modulo the prime p
(macrolet ((define-operations (&rest pairs)
             `(progn ,@(loop for (op name) on pairs by #'cddr collect
                            `(defun ,name (x y) (mod (,op x y) p))))))
  (define-operations + add - sub * mul))

;;; modular exponentiation by squaring, still in the same field
;;; THIS IS A VARIABLE-TIME ALGORITHM, BLIND REUSE IS INSECURE!
(defun pow (x n &optional (x^n 1))      ; (declare (notinline pow))
  (do ((x x (mul x x)) (n n (ash n -1))) ((zerop n) x^n)
    (when (oddp n) (setf x^n (mul x^n x)))))

;;; extended euclidean algorithm, still in the same field
;;; THIS IS A VARIABLE-TIME ALGORITHM, BLIND REUSE IS INSECURE!
(defun eea (a b &optional (x 0) (prevx 1) (y 1) (prevy 0))
  (if (zerop b) (values prevx prevy)
      (multiple-value-bind (q r) (floor a b)
        (eea b r (sub prevx (mul q x)) x (sub prevy (mul q y)) y))))

;;; multiplicative inverse in the field of integers modulo the prime p
(defun inv (x) (nth-value 1 (eea p (mod x p))))

;;; operation, in the group of rational points over elliptic curve "SECP256K1"
;;; THIS IS A VARIABLE-TIME ALGORITHM, BLIND REUSE IS INSECURE!
(defun addp (xp yp xq yq) ; https://hyperelliptic.org/EFD/g1p/auto-shortw.html
  (if (and xp yp xq yq) ; base case: avoid The Pothole At The End Of The Algebra
      (macrolet ((ua (s r) `(let* ((s ,s) (x (sub (mul s s) ,r)))
                              (values x (sub 0 (add yp (mul s (sub x xp))))))))
        (if (/= xp xq) (ua (mul (sub yp yq) (inv (- xp xq))) (add xp xq)) ; p+q
            (if (zerop (add yp yq)) (values nil nil) ; p = -q, so p+q = infinity
                (ua (mul (inv (* 2 yp)) (mul 3 (pow xp 2))) (mul 2 xp))))) ; 2*p
      (if (and xp yp) (values xp yp) (values xq yq)))) ; pick the [in]finite one

;;; Scalar multiplication (by doubling)
;;; THIS IS A VARIABLE-TIME ALGORITHM, BLIND REUSE IS INSECURE!
(defun smulp (k xp yp)
  (if (zerop k) (values nil nil)
      (multiple-value-bind (xq yq) (addp xp yp xp yp)
        (multiple-value-bind (xr yr) (smulp (ash k -1) xq yq)
          (if (evenp k) (values xr yr) (addp xp yp xr yr))))))

;;; Tests if a point is on the curve
;;; THIS IS A VARIABLE-TIME ALGORITHM, BLIND REUSE IS INSECURE!
(defun e (x y) (= (mul y y) (add (pow x #o3) #o7)))

;;; "A horseshoe brings good luck even to those of little faith." - S. Nakamoto
(macrolet ((check-sanity (&rest checks)
             `(progn ,@(loop for (test text) on checks by #'cddr
                          collect `(assert ,test () ,text)))))
  (check-sanity (= 977 (sub (pow 2 256) (pow 2 32))) "mathematics has broken"
                (e xg yg) "the generator isn't a rational point on the curve"
                (not (smulp ng xg yg)) "the generator's order is incorrect"))

;;; dyslexia-friendly encoding, placed in public domain by Satoshi Nakamoto
(defun base58enc (bytes)
  (loop with code = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
     for x = (octets-to-integer bytes) then (floor x #10R58) until (zerop x)
     collect (char code (mod x #10R58)) into out finally
       (return (coerce (nreverse (append out (loop for b across bytes
                                                while (zerop b) collect #\1)))
                       'string))))

;;; encodes arbitrary coordinates into a Pay-To-Pubkey-Hash address
(defun pubkey-to-p2pkh (x y)
  ;; ... ok, the previous comment was a lie; the following line verifies that
  ;; the coordinates correspond to a rational point on the curve, and gives a
  ;; few chances to correct typos in either of the coordinates interactively.
  (assert (e x y) (x y) "The point (~D, ~D) is off the curve secp256k1." x y)
  (labels ((digest (hashes bytes)
             (reduce 'digest-sequence hashes :from-end t :initial-value bytes))
           (sovcat (&rest things)
             (apply 'concatenate 'simple-octet-vector things))
           (checksum (octets)
             (sovcat octets (subseq (digest '(sha256 sha256) octets) 0 4))))
    (let ((point (sovcat '(4) (integer-to-octets x) (integer-to-octets y))))
      (base58enc (checksum (sovcat '(0) (digest '(ripemd-160 sha256) point)))))))


import std.stdio, std.algorithm, std.digest.ripemd, sha_256_2;

// A Bitcoin public point.
struct PPoint { ubyte[32] x, y; }

private enum bitcoinVersion = 0;
private enum RIPEMD160_digest_len = typeof("".ripemd160Of).length;
private alias sha = SHA256.digest;
alias Address = ubyte[1 + 4 + RIPEMD160_digest_len];

/// Returns a base 58 encoded bitcoin address corresponding to the receiver.
char[] toBase58(ref Address a) pure nothrow @safe {
    static immutable symbols = "123456789" ~
                               "ABCDEFGHJKLMNPQRSTUVWXYZ" ~
                               "abcdefghijkmnopqrstuvwxyz";
    static assert(symbols.length == 58);

    auto result = new typeof(return)(34);
    foreach_reverse (ref ri; result) {
        uint c = 0;
        foreach (ref ai; a) {
            immutable d = (c % symbols.length) * 256 + ai;
            ai = d / symbols.length;
            c = d;
        }
        ri = symbols[c % symbols.length];
    }

    size_t i = 1;
    for (; i < result.length && result[i] == '1'; i++) {}
    return result[i - 1 .. $];
}

char[] bitcoinEncode(in ref PPoint p) pure nothrow {
    ubyte[typeof(PPoint.x).length + typeof(PPoint.y).length + 1] s;
    s[0] = 4;
    s[1 .. 1 + p.x.length] = p.x[];
    s[1 + p.x.length .. $] = p.y[];

    Address rmd;
    rmd[0] = bitcoinVersion;
    rmd[1 .. RIPEMD160_digest_len + 1] = s.sha.ripemd160Of;
    rmd[$-4 .. $] = rmd[0 .. RIPEMD160_digest_len + 1].sha.sha[0 .. 4];
    return rmd.toBase58;
}

void main() {
    PPoint p = {
cast(typeof(PPoint.x))
x"50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
cast(typeof(PPoint.y))
x"2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6"};

    p.bitcoinEncode.writeln;
}


program Public_point_to_address;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  Winapi.Windows,
  DCPsha256,
  DCPripemd160;

const
  bitcoinVersion = 0;

type
  TByteArray = array of Byte;

  TA25 = TByteArray;

  TPPoint = record
    x, y: TByteArray;
    constructor SetHex(xi, yi: ansistring);
  end;

  TA25Helper = record helper for TA25
  public
    constructor Create(p: TPPoint);
    function DoubleSHA256(): TByteArray;
    procedure UpdateChecksum();
    procedure SetPoint(p: TPPoint);
    function ToBase58: Ansistring;
  end;

function HashSHA256(const Input: TByteArray): TByteArray;
var
  Hasher: TDCP_sha256;
begin
  Hasher := TDCP_sha256.Create(nil);
  try
    Hasher.Init;
    Hasher.Update(Input[0], Length(Input));
    SetLength(Result, Hasher.HashSize div 8);
    Hasher.final(Result[0]);
  finally
    Hasher.Free;
  end;
end;

function HashRipemd160(const Input: TByteArray): TByteArray;
var
  Hasher: TDCP_ripemd160;
begin
  Hasher := TDCP_ripemd160.Create(nil);
  try
    Hasher.Init;
    Hasher.Update(Input[0], Length(Input));
    SetLength(Result, Hasher.HashSize div 8);
    Hasher.final(Result[0]);
  finally
    Hasher.Free;
  end;
end;

{ TPPoint }

constructor TPPoint.SetHex(xi, yi: ansistring);

  function StrToHexArray(value: Ansistring): TByteArray;
  var
    b: ansistring;
    h, i: integer;
  begin
    SetLength(Result, 32);

    for i := 0 to 31 do
    begin
      b := '$' + copy(value, i * 2 + 1, 2);
      if not TryStrToInt(b, h) then
        raise Exception.CreateFmt('Error in TPPoint.SetHex.StrToHexArray: Invalid hex string in position %d of "x"',
          [i * 2]);
      Result[i] := h;
    end;
  end;

begin
  if (Length(xi) <> 64) or (Length(yi) <> 64) then
    raise Exception.Create('Error in TPPoint.SetHex: Invalid hex string length');

  x := StrToHexArray(xi);
  y := StrToHexArray(yi);
end;

{ TA25Helper }

constructor TA25Helper.Create(p: TPPoint);
begin
  SetLength(self, 25);
  SetPoint(p);
end;

function TA25Helper.DoubleSHA256: TByteArray;
begin
  Result := HashSHA256(HashSHA256(copy(self, 0, 21)));
end;

procedure TA25Helper.SetPoint(p: TPPoint);
var
  c, s: TByteArray;
begin
  c := concat([4], p.x, p.y);
  s := HashSHA256(c);

  self := concat([self[0]], HashRipemd160(s));
  SetLength(self, 25);
  UpdateChecksum;
end;

function TA25Helper.ToBase58: Ansistring;
var
  c, i, n: Integer;
const
  Size = 34;
  Alphabet: Ansistring = '123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
begin
  SetLength(Result, Size);
  for n := Size - 1 downto 0 do
  begin
    c := 0;
    for i := 0 to 24 do
    begin
      c := c * 256 + Self[i];
      Self[i] := byte(c div 58);
      c := c mod 58;
    end;
    Result[n + 1] := Alphabet[c + 1];
  end;

  i := 2;
  while (i < Size) and (result[i] = '1') do
    inc(i);

  Result := copy(Result, i - 1, Size);
end;

procedure TA25Helper.UpdateChecksum;
begin
  CopyMemory(@self[21], @self.DoubleSHA256[0], 4);
end;

var
  p: TPPoint;
  a: TA25;

const
  x: Ansistring = '50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352';
  y: Ansistring = '2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6';

begin
  p.SetHex(x, y);

  a := TA25.Create(p);
  writeln(a.ToBase58);
  readln;
end.


USING: checksums checksums.ripemd checksums.sha io.binary kernel
math sequences ;
IN: rosetta-code.bitcoin.point-address

CONSTANT: ALPHABET "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"

: btc-checksum ( bytes -- checksum-bytes )
    2 [ sha-256 checksum-bytes ] times 4 head ;

: bigint>base58 ( n -- str )
    33 [ 58 /mod ALPHABET nth ] "" replicate-as reverse nip ;

: >base58 ( bytes -- str )
    be> bigint>base58 ;

: point>address ( X Y -- address )
    [ 32 >be ] [email protected] append
    0x4 prefix
    sha-256 checksum-bytes
    ripemd-160 checksum-bytes
    dup 0 prefix btc-checksum
    append 0 prefix >base58 ;


package main

import (
    "crypto/sha256"
    "encoding/hex"
    "errors"
    "fmt"

    "golang.org/x/crypto/ripemd160"
)

// Point is a type for a bitcoin public point.
type Point struct {
    x, y [32]byte
}

// SetHex takes two hexidecimal strings and decodes them into the receiver.
func (p *Point) SetHex(x, y string) error {
    if len(x) != 64 || len(y) != 64 {
        return errors.New("invalid hex string length")
    }
    if _, err := hex.Decode(p.x[:], []byte(x)); err != nil {
        return err
    }
    _, err := hex.Decode(p.y[:], []byte(y))
    return err
}

// A25 type in common with Bitcoin/address validation task.
type A25 [25]byte

// doubleSHA256 method in common with Bitcoin/address validation task.
func (a *A25) doubleSHA256() []byte {
    h := sha256.New()
    h.Write(a[:21])
    d := h.Sum([]byte{})
    h = sha256.New()
    h.Write(d)
    return h.Sum(d[:0])
}

// UpdateChecksum computes the address checksum on the first 21 bytes and
// stores the result in the last 4 bytes.
func (a *A25) UpdateChecksum() {
    copy(a[21:], a.doubleSHA256())
}

// SetPoint takes a public point and generates the corresponding address
// into the receiver, complete with valid checksum.
func (a *A25) SetPoint(p *Point) {
    c := [65]byte{4}
    copy(c[1:], p.x[:])
    copy(c[33:], p.y[:])
    h := sha256.New()
    h.Write(c[:])
    s := h.Sum([]byte{})
    h = ripemd160.New()
    h.Write(s)
    h.Sum(a[1:1])
    a.UpdateChecksum()
}

// Tmpl in common with Bitcoin/address validation task.
var tmpl = []byte("123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz")

// A58 returns a base58 encoded bitcoin address corresponding to the receiver.
// Code adapted from the C solution to this task.
func (a *A25) A58() []byte {
    var out [34]byte
    for n := 33; n >= 0; n-- {
        c := 0
        for i := 0; i < 25; i++ {
            c = c*256 + int(a[i])
            a[i] = byte(c / 58)
            c %= 58
        }
        out[n] = tmpl[c]
    }
    i := 1
    for i < 34 && out[i] == '1' {
        i++
    }
    return out[i-1:]
}

func main() {
    // parse hex into point object
    var p Point
    err := p.SetHex(
        "50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
        "2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6")
    if err != nil {
        fmt.Println(err)
        return
    }
    // generate address object from point
    var a A25
    a.SetPoint(&p)
    // show base58 representation
    fmt.Println(string(a.A58()))
}


import Numeric (showIntAtBase)
import Data.List (unfoldr)
import Data.Binary (Word8)
import Crypto.Hash.SHA256 as S (hash)
import Crypto.Hash.RIPEMD160 as R (hash)
import Data.ByteString (unpack, pack)

publicPointToAddress :: Integer -> Integer -> String
publicPointToAddress x y =
  let toBytes x = reverse $ unfoldr (\b -> if b == 0 then Nothing else Just (fromIntegral $ b `mod` 256, b `div` 256)) x
      ripe = 0 : unpack (R.hash $ S.hash $ pack $ 4 : toBytes x ++ toBytes y)
      ripe_checksum = take 4 $ unpack $ S.hash $ S.hash $ pack ripe
      addressAsList = ripe ++ ripe_checksum
      address = foldl (\v b -> v * 256 + fromIntegral b) 0 addressAsList
      base58Digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
  in showIntAtBase 58 (base58Digits !!) address ""

main = print $ publicPointToAddress
  0x50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352
  0x2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6


const digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
function encodebase58(b::Vector{<:Integer})
    out = Vector{Char}(34)
    for j in endof(out):-1:1
        local c::Int = 0
        for i in eachindex(b)
            c = c * 256 + b[i]
            b[i] = c ÷ 58
            c %= 58
        end
        out[j] = digits[c + 1]
    end
    local i = 1
    while i < endof(out) && out[i] == '1'
        i += 1
    end
    return join(out[i:end])
end

const COINVER = 0x00
function pubpoint2address(x::Vector{UInt8}, y::Vector{UInt8})
    c = vcat(0x04, x, y)
    c = vcat(COINVER, digest("ripemd160", sha256(c)))
    d = sha256(sha256(c))
    return encodebase58(vcat(c, d[1:4]))
end
pubpoint2address(x::AbstractString, y::AbstractString) =
    pubpoint2address(hex2bytes(x), hex2bytes(y))


BlockchainKeyEncode[
  PublicKey[
    <|
      "Type"->"EllipticCurve",
      "PublicCurvePoint"-> {
        16^^50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352,
        16^^2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6
      }
    |>
  ],
  "Address",
  BlockchainBase-> "Bitcoin"
]


import parseutils
import nimcrypto
import bignum

func base58Encode(data: seq[byte]): string =
  ## Encode data to base58 with at most one starting '1'.

  var data = data
  const Base = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
  result.setlen(34)

  # Convert to base 58.
  for j in countdown(result.high, 0):
    var c = 0
    for i, b in data:
      c = c * 256 + b.int
      data[i] = (c div 58).byte
      c = c mod 58
    result[j] = Base[c]

  # Keep one starting '1' at most.
  if result[0] == '1':
    for idx in 1..result.high:
      if result[idx] != '1':
        result = result[(idx - 1)..^1]
        break

func hexToByteSeq(s: string): seq[byte] =
  ## Convert a hexadecimal string to a sequence of bytes.

  var pos = 0
  while pos < s.len:
    var tmp = 0
    let parsed = parseHex(s, tmp, pos, 2)
    if parsed > 0:
      inc pos, parsed
      result.add byte tmp
    else:
      raise newException(ValueError, "Invalid hex string")

func validCoordinates(x, y: string): bool =
  ## Return true if the coordinates are those of a point in the secp256k1 elliptic curve.

  let p = newInt("FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F", 16)
  let x = newInt(x, 16)
  let y = newInt(y, 16)
  result = y^2 mod p == (x^3 + 7) mod p

func addrEncode(x, y: string): string =
  ## Encode x and y coordinates to an address.

  if not validCoordinates(x, y):
    raise newException(ValueError, "Invalid coordinates")

  let pubPoint = 4u8 & x.hexToByteSeq & y.hexToByteSeq
  if pubPoint.len != 65:
    raise newException(ValueError, "Invalid pubpoint string")

  var rmd = @(ripemd160.digest(sha256.digest(pubPoint).data).data)
  rmd.insert 0u8
  rmd.add sha256.digest(sha256.digest(rmd).data).data[0..3]
  result = base58Encode(rmd)

when isMainModule:
  let address = addrEncode("50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
                           "2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6")
  echo "Coordinates are valid."
  echo "Address is: ", address


use Crypt::RIPEMD160;
use Digest::SHA qw(sha256);
use Encode::Base58::GMP;

sub public_point_to_address {
    my $ec   = join '', '04', @_;                    # EC: concat x and y to one string and prepend '04' magic value

    my $octets   = pack 'C*', map { hex } unpack('(a2)65', $ec);      # transform the hex values string to octets
    my $hash     = chr(0) . Crypt::RIPEMD160->hash(sha256 $octets);   # perform RIPEMD160(SHA256(octets)
    my $checksum = substr sha256(sha256 $hash), 0, 4;                 # build the checksum
    my $hex      = join '', '0x',                                     # build hex value of hash and checksum
                   map { sprintf "%02X", $_ }
                   unpack 'C*', $hash.$checksum;
    return '1' . sprintf "%32s", encode_base58($hex, 'bitcoin');      # Do the Base58 encoding, prepend "1"
}

say public_point_to_address
    '50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352',
    '2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6'
    ;


without javascript_semantics -- no ripemd160.js as yet
include builtins\sha256.e
include builtins\ripemd160.e

constant b58 = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"

function base58(string s)
string out = ""
    if length(s)!=25 then ?9/0 end if
    for n=1 to 34 do
        integer c = 0
        for i=1 to 25 do
            c = c*256+s[i]
            s[i] = floor(c/58)
            c = mod(c,58)
        end for
        out &= b58[c+1]
    end for
    if out[$]='1' then
        for i=length(out)-1 to 1 by -1 do
            if out[i]!='1' then
                out = out[1..i+1]
                exit
            end if
        end for
    end if
    return reverse(out)
end function

function coin_encode(string x, y)
    if length(x)!=32
    or length(y)!=32 then
        return "bad public point string"
    end if
    string s = "\x04" & x & y
    string rmd = '\0'&ripemd160(sha256(s),false)
    rmd &= sha256(sha256(rmd))[1..4]
    string res = base58(rmd)
    return res
end function

?coin_encode(x"50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
             x"2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6")


(load "ripemd160.l")
(load "sha256.l")

(setq *B58Alpha
   (chop "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz") )
(de hex2L (H)
   (make
      (for (L (chop H) L (cddr L))
         (link (hex (pack (car L) (cadr L)))) ) ) )
(de b58enc (Lst)
   (let
      (P 1
         Z 0
         A
         (sum
            '((X)
               (* X (swap 'P (>> -8 P))) )
            (reverse Lst) ) )
   (for L Lst
      (T (n0 L))
      (inc 'Z) )
   (pack
      (need Z "1")
      (make
         (while (gt0 A)
            (yoke
               (prog1
                  (get *B58Alpha (inc (% A 58)))
                  (setq A (/ A 58)) ) ) ) ) ) ) )
(de point2address (X Y)
   (let L (conc (cons 4) (hex2L X) (hex2L Y))
      (b58enc
         (and
            (conc (cons 0) (ripemd160 (sha256 L)))
            (conc @ (head 4 (sha256 (sha256 @)))) ) ) ) )
(println
   (point2address
      "50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352"
      "2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6" ) )


#!/usr/bin/env python3

import binascii
import functools
import hashlib

digits58 = b'123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz'

def b58(n):
    return b58(n//58) + digits58[n%58:n%58+1] if n else b''

def public_point_to_address(x, y):
    c = b'\x04' + binascii.unhexlify(x) + binascii.unhexlify(y)
    r = hashlib.new('ripemd160')
    r.update(hashlib.sha256(c).digest())
    c = b'\x00' + r.digest()
    d = hashlib.sha256(hashlib.sha256(c).digest()).digest()
    return b58(functools.reduce(lambda n, b: n<<8|b, c + d[:4]))

if __name__ == '__main__':
    print(public_point_to_address(
        b'50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352',
        b'2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6'))


#lang racket/base
(module sha256 racket/base
  ;; define a quick SH256 FFI interface, similar to the Racket's default
  ;; SHA1 interface (from [[SHA-256#Racket]])
  (provide sha256)
  (require ffi/unsafe ffi/unsafe/define openssl/libcrypto)
  (define-ffi-definer defcrypto libcrypto)
  (defcrypto SHA256_Init   (_fun _pointer -> _int))
  (defcrypto SHA256_Update (_fun _pointer _pointer _long -> _int))
  (defcrypto SHA256_Final  (_fun _pointer _pointer -> _int))
  (define (sha256 bytes)
    (define ctx (malloc 128))
    (define result (make-bytes 32))
    (SHA256_Init ctx)
    (SHA256_Update ctx bytes (bytes-length bytes))
    (SHA256_Final result ctx)
    ;; (bytes->hex-string result) -- not needed, we want bytes
    result))

(require
  ;; On windows I needed to "raco planet install soegaard digetst.plt 1 2"
  (only-in (planet soegaard/digest:1:2/digest) ripemd160-bytes)
  (submod "." sha256))

;; Quick utility
(define << arithmetic-shift) ; a bit shorter

;; From: https://en.bitcoin.it/wiki/Technical_background_of_version_1_Bitcoin_addresses
;; Using Bitcoin's stage numbers:

;; 1 - Take the corresponding public key generated with it
;; (65 bytes, 1 byte 0x04, 32 bytes corresponding to X coordinate,
;;  32 bytes corresponding to Y coordinate)
(define (stage-1 X Y)
  (define (integer->bytes! i B)
    (define l (bytes-length B))
    (for ((b (in-range 0 l))) (bytes-set! B (- l b 1) (bitwise-bit-field i (* b 8) (* (+ b 1) 8)))) B)
  (integer->bytes! (+ (<< 4 (* 32 8 2)) (<< X (* 32 8)) Y) (make-bytes 65)))

;; 2 - Perform SHA-256 hashing on the public key
(define stage-2 sha256)

;; 3 - Perform RIPEMD-160 hashing on the result of SHA-256
(define stage-3 ripemd160-bytes)

;; 4 - Add version byte in front of RIPEMD-160 hash (0x00 for Main Network)
(define (stage-4 s3)
  (bytes-append #"\0" s3))

;; 5 - Perform SHA-256 hash on the extended RIPEMD-160 result
;; 6 - Perform SHA-256 hash on the result of the previous SHA-256 hash
(define (stage-5+6 s4)
  (values s4 (sha256 (sha256 s4))))

;; 7 - Take the first 4 bytes of the second SHA-256 hash. This is the address checksum
(define (stage-7 s4 s6)
  (values s4 (subbytes s6 0 4)))

;; 8 - Add the 4 checksum bytes from stage 7 at the end of extended RIPEMD-160 hash from stage 4.
;;     This is the 25-byte binary Bitcoin Address.
(define (stage-8 s4 s7)
  (bytes-append s4 s7))

;; 9 - Convert the result from a byte string into a base58 string using Base58Check encoding.
;;     This is the most commonly used Bitcoin Address format
(define stage-9 (base58-encode 33))

(define ((base58-encode l) B)
  (define b58 #"123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz")
  (define rv (make-bytes l (char->integer #\1))) ; already padded out with 1's
  (define b-int (for/fold ((i 0)) ((b (in-bytes B))) (+ (<< i 8) b)))
  (let loop ((b b-int) (l l))
    (if (zero? b) rv
        (let-values (((q r) (quotient/remainder b 58)))
          (define l- (- l 1))
          (bytes-set! rv l- (bytes-ref b58 r))
          (loop q l-)))))

;; Takes two (rather large) ints for X and Y, returns base-58 PAP.
(define public-address-point
  (compose stage-9 stage-8 stage-7 stage-5+6 stage-4 stage-3 stage-2 stage-1))

(public-address-point
 #x50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352
 #x2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module+ test
  (require tests/eli-tester (only-in openssl/sha1 bytes->hex-string))
  (define bytes->HEX-STRING (compose string-upcase bytes->hex-string))
  (test
   ((base58-encode 33)
    (bytes-append #"\x00\x01\x09\x66\x77\x60\x06\x95\x3D\x55\x67\x43"
                  #"\x9E\x5E\x39\xF8\x6A\x0D\x27\x3B\xEE\xD6\x19\x67\xF6"))
   =>
   #"16UwLL9Risc3QfPqBUvKofHmBQ7wMtjvM")

  (define-values (test-X test-Y)
    (values #x50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352
            #x2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6))
  (define s1 (stage-1 test-X test-Y))
  (define s2 (stage-2 s1))
  (define s3 (stage-3 s2))
  (define s4 (stage-4 s3))
  (define-values (s4_1 s6) (stage-5+6 s4))
  (define-values (s4_2 s7) (stage-7 s4 s6))
  (define s8 (stage-8 s4 s7))
  (define s9 (stage-9 s8))

  (test
   (bytes->HEX-STRING s1)
   => (string-append "0450863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B23522CD470243453"
                     "A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6")
   (bytes->HEX-STRING s2) => "600FFE422B4E00731A59557A5CCA46CC183944191006324A447BDB2D98D4B408"
   (bytes->HEX-STRING s3) => "010966776006953D5567439E5E39F86A0D273BEE"
   (bytes->HEX-STRING s4) => "00010966776006953D5567439E5E39F86A0D273BEE"
   (bytes->HEX-STRING s6) => "D61967F63C7DD183914A4AE452C9F6AD5D462CE3D277798075B107615C1A8A30"
   (bytes->HEX-STRING s7) => "D61967F6"
   (bytes->HEX-STRING s8) => "00010966776006953D5567439E5E39F86A0D273BEED61967F6"
   s9 => #"16UwLL9Risc3QfPqBUvKofHmBQ7wMtjvM"))


sub dgst(blob8 $b, Str :$dgst) returns blob8 {
  given run «openssl dgst "-$dgst" -binary», :in, :out, :bin {
    .in.write: $b;
    .in.close;
    return .out.slurp;
  }
}
sub sha256($b) { dgst $b, :dgst<sha256> }
sub rmd160($b) { dgst $b, :dgst<rmd160> }

sub public_point_to_address( UInt $x, UInt $y ) {
    my @bytes = flat ($y,$x).map: *.polymod( 256 xx * )[^32];
    my $hash = rmd160 sha256 blob8.new: 4, @bytes.reverse;
    my $checksum = sha256(sha256 blob8.new: 0, $hash.list).subbuf: 0, 4;
    [R~] <
        1 2 3 4 5 6 7 8 9
      A B C D E F G H   J K L M N   P Q R S T U V W X Y Z
      a b c d e f g h i j k   m n o p q r s t u v w x y z
    >[ .polymod: 58 xx * ] given
    reduce * * 256 + * , flat 0, ($hash, $checksum)».list
}

say public_point_to_address
  0x50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352,
  0x2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6;


#  Translate public point to Bitcoin address
#
#  Nigel_Galloway
#  October 12th., 2014
require 'digest/sha2'
def convert g
  i,e = '',[]
  (0...g.length/2).each{|n| e[n] = g[n+=n]+g[n+1]; i+='H2'}
  e.pack(i)
end
X = '50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352'
Y = '2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6'
n = '00'+Digest::RMD160.hexdigest(Digest::SHA256.digest(convert('04'+X+Y)))
n+= Digest::SHA256.hexdigest(Digest::SHA256.digest(convert(n)))[0,8]
G = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
n,res = n.hex,''
while n > 0 do
  n,ng = n.divmod(58)
  res << G[ng]
end
puts res.reverse


use ring::digest::{digest, SHA256};
use ripemd160::{Digest, Ripemd160};

use hex::FromHex;

static X: &str = "50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352";
static Y: &str = "2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6";
static ALPHABET: [char; 58] = [
    '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'J', 'K',
    'L', 'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e',
    'f', 'g', 'h', 'i', 'j', 'k', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y',
    'z',
];

fn base58_encode(bytes: &mut [u8]) -> String {
    let base = ALPHABET.len();
    if bytes.is_empty() {
        return String::from("");
    }
    let mut output: Vec<u8> = Vec::new();
    let mut num: usize;
    for _ in 0..33 {
        num = 0;
        for byte in bytes.iter_mut() {
            num = num * 256 + *byte as usize;
            *byte = (num / base) as u8;
            num %= base;
        }
        output.push(num as u8);
    }
    let mut string = String::new();
    for b in output.iter().rev() {
        string.push(ALPHABET[*b as usize]);
    }
    string
}

// stolen from address-validation/src/main.rs
/// Hashes the input with the SHA-256 algorithm twice, and returns the output.
fn double_sha256(bytes: &[u8]) -> Vec<u8> {
    let digest_1 = digest(&SHA256, bytes);

    let digest_2 = digest(&SHA256, digest_1.as_ref());
    digest_2.as_ref().to_vec()
}

fn point_to_address(x: &str, y: &str) -> String {
    let mut addrv: Vec<u8> = Vec::with_capacity(65);
    addrv.push(4u8);
    addrv.append(&mut <Vec<u8>>::from_hex(x).unwrap());
    addrv.append(&mut <Vec<u8>>::from_hex(y).unwrap());
    // hash the addresses first using SHA256
    let sha_digest = digest(&SHA256, &addrv);
    let mut ripemd_digest = Ripemd160::digest(&sha_digest.as_ref()).as_slice().to_vec();
    // prepend a 0 to the vector
    ripemd_digest.insert(0, 0);
    // calculate checksum of extended ripemd digest
    let checksum = double_sha256(&ripemd_digest);
    ripemd_digest.extend_from_slice(&checksum[..4]);
    base58_encode(&mut ripemd_digest)
}

fn main() {
    println!("{}", point_to_address(X, Y));
}


$ include "seed7_05.s7i";
  include "bytedata.s7i";
  include "msgdigest.s7i";
  include "encoding.s7i";

const func string: publicPointToAddress (in string: x, in string: y) is func
  result
    var string: address is "";
  begin
    address := "\4;" & hex2Bytes(x) & hex2Bytes(y);
    address := "\0;" & ripemd160(sha256(address));
    address &:= sha256(sha256(address))[.. 4];
    address := toBase58(address);
  end func;

const proc: main is func
  begin
    writeln(publicPointToAddress("50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
                                 "2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6"));
  end func;


package require ripemd160
package require sha256

# Exactly the algorithm from https://en.bitcoin.it/wiki/Base58Check_encoding
proc base58encode data {
    set digits "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
    for {set zeroes 0} {[string index $data 0] eq "\x00"} {incr zeroes} {
	set data [string range $data 1 end]
    }
    binary scan $data "H*" hex
    scan $hex "%llx" num
    for {set out ""} {$num > 0} {set num [expr {$num / 58}]} {
	append out [string index $digits [expr {$num % 58}]]
    }
    append out [string repeat [string index $digits 0] $zeroes]
    return [string reverse $out]
}

# Encode a Bitcoin address
proc bitcoin_mkaddr {A B} {
    set A [expr {$A & ((1<<256)-1)}]
    set B [expr {$B & ((1<<256)-1)}]
    set bin [binary format "cH*" 4 [format "%064llx%064llx" $A $B]]
    set md [ripemd::ripemd160 [sha2::sha256 -bin $bin]]
    set addr [binary format "ca*" 0 $md]
    set hash [sha2::sha256 -bin [sha2::sha256 -bin $addr]]
    append addr [binary format "a4" [string range $hash 0 3]]
    return [base58encode $addr]
}


import "/crypto" for Sha256, Ripemd160
import "/str" for Str
import "/fmt" for Conv

// converts an hexadecimal string to a byte list.
var HexToBytes = Fn.new { |s| Str.chunks(s, 2).map { |c| Conv.atoi(c, 16) }.toList }

// Point is a class for a bitcoin public point
class Point {
    construct new() {
        _x = List.filled(32, 0)
        _y = List.filled(32, 0)
    }

    x { _x }
    y { _y }

    // setHex takes two hexadecimal strings and decodes them into the receiver.
    setHex(s, t) {
        if (s.count != 64 || t.count != 64) Fiber.abort("Invalid hex string length.")
        _x = HexToBytes.call(s)
        _y = HexToBytes.call(t)
    }
}

// Represents a bitcoin address.
class Address {
    static tmpl_ { "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz".bytes }

    construct new() {
        _a = List.filled(25, 0)
    }

    a { _a }

    // returns a base58 encoded bitcoin address corresponding to the receiver.
    a58 {
        var out = List.filled(34, 0)
        for (n in 33..0) {
            var c = 0
            for (i in 0..24) {
                c = c * 256 + _a[i]
                _a[i] = (c/58).floor
                c = c % 58
            }
            out[n] = Address.tmpl_[c]
        }
        var i = 1
        while (i < 34 && out[i] == 49) i = i + 1
        return out[i-1..-1]
    }

    // doubleSHA256 computes a double sha256 hash of the first 21 bytes of the
    // address, returning the full 32 byte sha256 hash.
    doubleSHA256() {
        var d = Sha256.digest(_a[0..20])
        d = HexToBytes.call(d)
        d = Sha256.digest(d)
        return HexToBytes.call(d)
    }

    // updateChecksum computes the address checksum on the first 21 bytes and
    // stores the result in the last 4 bytes.
    updateCheckSum() {
        var d = doubleSHA256()
        for (i in 21..24) _a[i] = d[i-21]
    }

    // setPoint takes a public point and generates the corresponding address
    // into the receiver, complete with valid checksum.
    setPoint(p) {
        var c = List.filled(65, 0)
        c[0] = 4
        for (i in 1..32)  c[i] = p.x[i - 1]
        for (i in 33..64) c[i] = p.y[i - 33]
        var s = Sha256.digest(c)
        s = HexToBytes.call(s)
        var h = Ripemd160.digest(s)
        h = HexToBytes.call(h)
        for (i in 0...h.count) _a[i+1] = h[i]
        updateCheckSum()
    }
}

// parse hex into Point object
var p = Point.new()
p.setHex(
    "50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352",
    "2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6"
)
// generate Address object from Point
var a = Address.new()
a.setPoint(p)
// show base58 representation
System.print(a.a58.map { |b| String.fromByte(b) }.join())


var [const] MsgHash=Import.lib("zklMsgHash"); // SHA-256, etc

const symbols = "123456789"  // 58 characters: no cap i,o; ell, zero
		"ABCDEFGHJKLMNPQRSTUVWXYZ"
		"abcdefghijkmnopqrstuvwxyz";

fcn base58Encode(bytes){ //Data-->String
   bytes=bytes.copy(); sink:=Sink(String);
   do(33){
      bytes.len().reduce('wrap(n,idx){
         n=n*256 + bytes[idx];
         bytes[idx]=(n/58);
         n%58;
      },0) : symbols[_] : sink.write(_)
   }
   sink.close().reverse();
}

const COIN_VER=0;

fcn coinEncode(x,y){ // throws if x or y not hex or (x+y) not even length
   bytes:=(x+y).pump(Data,Void.Read,fcn(a,b){ (a+b).toInt(16) }).insert(0,4);
   (MsgHash.SHA256(bytes,1,bytes) : MsgHash.RIPEMD160(_,1,bytes))
	 .insert(0,COIN_VER);  // we are using bytes for in and out
   d,chkSum := Data(), MsgHash.SHA256(bytes,1,d) : MsgHash.SHA256(_,1,d);
   base58Encode(bytes.append(chkSum.del(4,*))); // first 4 bytes of hashed hash
}


F biorhythms(birthdate_str, targetdate_str)
   ‘
    Print out biorhythm data for targetdate assuming you were
    born on birthdate.

    birthdate and targetdata are strings in this format:

    YYYY-MM-DD e.g. 1964-12-26
   ’

   print(‘Born: ’birthdate_str‘ Target: ’targetdate_str)

   V birthdate = time:strptime(birthdate_str, ‘%Y-%m-%d’)
   V targetdate = time:strptime(targetdate_str, ‘%Y-%m-%d’)

   V days = (targetdate - birthdate).days()

   print(‘Day: ’days)

   V cycle_labels = [‘Physical’, ‘Emotional’, ‘Mental’]
   V cycle_lengths = [23, 28, 33]
   V quadrants = [(‘up and rising’, ‘peak’), (‘up but falling’, ‘transition’), (‘down and falling’, ‘valley’), (‘down but rising’, ‘transition’)]

   L(i) 3
      V label = cycle_labels[i]
      V length = cycle_lengths[i]
      V position = days % length
      V quadrant = Int(floor((4 * position) / length))
      V percentage = Int(round(100 * sin(2 * math:pi * position / length), 0))
      V transition_date = (targetdate + TimeDelta(days' floor((quadrant + 1) / 4 * length) - position)).strftime(‘%Y-%m-%d’)
      V (trend, next) = quadrants[quadrant]

      String description
      I percentage > 95
         description = ‘peak’
      E I percentage < -95
         description = ‘valley’
      E I abs(percentage) < 5
         description = ‘critical transition’
      E
         description = percentage‘% (’trend‘, next ’next‘ ’transition_date‘)’
      print(label‘ day ’position‘: ’description)

biorhythms(‘2043-03-09’, ‘2072-07-11’)


#include <stdio.h>
#include <stdlib.h>
#include <math.h>

int day(int y, int m, int d) {
    return 367 * y - 7 * (y + (m + 9) / 12) / 4 + 275 * m / 9 + d - 730530;
}

void cycle(int diff, int l, char *t) {
    int p = round(100 * sin(2 * M_PI * diff / l));
    printf("%12s cycle: %3i%%", t, p);
    if (abs(p) < 15)
        printf(" (critical day)");
    printf("\n");
}

int main(int argc, char *argv[]) {
    int diff;

    if (argc < 7) {
        printf("Usage:\n");
        printf("cbio y1 m1 d1 y2 m2 d2\n");
        exit(1);
    }
    diff = abs(day(atoi(argv[1]), atoi(argv[2]), atoi(argv[3]))
             - day(atoi(argv[4]), atoi(argv[5]), atoi(argv[6])));
    printf("Age: %u days\n", diff);
    cycle(diff, 23, "Physical");
    cycle(diff, 28, "Emotional");
    cycle(diff, 33, "Intellectual");
}


;;;; Common Lisp biorhythms

;;; Get the days to J2000
;;; FNday only works between 1901 to 2099 - see Meeus chapter 7

(defun day (y m d)
    (+ (truncate (* -7 (+ y (truncate (+ m 9) 12))) 4)
       (truncate (* 275 m) 9) d -730530 (* 367 y)))

;;; Get the difference in days between two dates

(defun diffday (y1 m1 d1 y2 m2 d2)
    (abs (- (day y2 m2 d2) (day y1 m1 d1))))

;;; Print state of a single cycle

(defun print-cycle (diff len nm)
    (let ((perc (round (* 100 (sin (* 2 pi diff (/ 1 len)))))))
          (format t "~A cycle: ~D% " nm perc)
          (if (< (abs perc) 15)
              (format t "(critical)~%")
              (format t "~%"))))

;;; Print all cycles

(defun print-bio (y1 m1 d1 y2 m2 d2)
    (let ((diff (diffday y1 m1 d1 y2 m2 d2)))
          (format t "Age in days: ~D ~%" diff)
          (print-cycle diff 23 "physical")
          (print-cycle diff 28 "emotional")
          (print-cycle diff 33 "intellectual")))


UInt32 seed = 0
F nonrandom(n)
   :seed = 1664525 * :seed + 1013904223
   R Int(:seed >> 16) % n
F nonrandom_choice(lst)
   R lst[nonrandom(lst.len)]

F basecount(dna)
   DefaultDict[Char, Int] d
   L(c) dna
      d[c]++
   R sorted(d.items())

F seq_split(dna, n = 50)
   R (0 .< dna.len).step(n).map(i -> @dna[i .< i + @n])

F seq_pp(dna, n = 50)
   L(part) seq_split(dna, n)
      print(‘#5: #.’.format(L.index * n, part))
   print("\n  BASECOUNT:")
   V tot = 0
   L(base, count) basecount(dna)
      print(‘    #3: #.’.format(base, count))
      tot += count
   V (base, count) = (‘TOT’, tot)
   print(‘    #3= #.’.format(base, count))

F seq_mutate(String =dna; count = 1, kinds = ‘IDSSSS’, choice = ‘ATCG’)
   [(String, Int)] mutation
   V k2txt = [‘I’ = ‘Insert’, ‘D’ = ‘Delete’, ‘S’ = ‘Substitute’]
   L 0 .< count
      V kind = nonrandom_choice(kinds)
      V index = nonrandom(dna.len + 1)
      I kind == ‘I’
         dna = dna[0 .< index]‘’nonrandom_choice(choice)‘’dna[index..]
      E I kind == ‘D’ & !dna.empty
         dna = dna[0 .< index]‘’dna[index+1..]
      E I kind == ‘S’ & !dna.empty
         dna = dna[0 .< index]‘’nonrandom_choice(choice)‘’dna[index+1..]
      mutation.append((k2txt[kind], index))
   R (dna, mutation)

print(‘SEQUENCE:’)
V sequence = ‘TCAATCATTAATCGATTAATACATTCAATTTGAACATCTCCAGGAGAAGGCAGGGTAATCTCGTGTAGCCGTGCTTGGGGCCTCCGATATGGCCGGGGAATTTCAAAGTATAGTGTGCATCCCCTCATAATACATAGATCTATAGGTAAGTATATGGGTTGACGTTGTTAGATGCGATACACGTGCACACTTTATGAATTTTACGTTCCTCTGCCTAGAGTGCCAAGTTTCAATTTGCTACGGTTCCTCA’
seq_pp(sequence)
print("\n\nMUTATIONS:")
V (mseq, m) = seq_mutate(sequence, 10)
L(kind, index) m
   print(‘ #10 @#.’.format(kind, index))
print()
seq_pp(mseq)


program Biorhythms;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Math;

var
  cycles: array[0..2] of string = ('Physical day ', 'Emotional day', 'Mental day   ');
  lengths: array[0..2] of Integer = (23, 28, 33);
  quadrants: array[0..3] of array[0..1] of string = (('up and rising', 'peak'),
    ('up but falling', 'transition'), ('down and falling', 'valley'), ('down but rising',
    'transition'));
  datePairs: array[0..2] of array[0..1] of string = (('1943-03-09', '1972-07-11'),
    ('1809-01-12', '1863-11-19'), ('1809-02-12', '1863-11-19') // correct DOB for Abraham Lincoln
    );

procedure Check(err: string);
begin
  if not err.IsEmpty then
    raise Exception.Create(err);
end;

function ParseDate(sDate: string; var Date: TDateTime): string;
var
  dtFormat: TFormatSettings;
begin
  Result := '';
  with dtFormat do
  begin
    DateSeparator := '-';
    ShortDateFormat := 'yyyy-mm-dd';
  end;

  try
    Date := StrtoDateTime(sDate, dtFormat);
  except
    on E: Exception do
      Result := E.Message;
  end;
end;

function DateToStr(dt: TDateTime): string;
var
  dtFormat: TFormatSettings;
begin
  Result := '';
  with dtFormat do
  begin
    DateSeparator := '-';
    ShortDateFormat := 'yyyy-mm-dd';
  end;
  Result := DateTimeToStr(dt, dtFormat);
end;

// Parameters assumed to be in YYYY-MM-DD format.
procedure CalcBiorhythms(birthDate, targetDate: string);
var
  bd, td: TDateTime;
  days: Integer;
begin
  Check(ParseDate(birthDate, bd));
  Check(ParseDate(targetDate, td));
  days := Trunc(td - bd);
  writeln('Born ', birthDate, ', Target ', targetDate);
  Writeln('Days ', days);
  for var i := 0 to 2 do
  begin
    var len := lengths[i];
    var cycle := cycles[i];
    var position := days mod len;
    var quadrant: Integer := trunc(position * 4 / len);
    var percent := sin(2.0 * PI * position / len);

    percent := floor(percent * 1000) / 10;
    var descript := '';
    if percent > 95 then
      descript := ' peak'
    else if percent < -95 then
      descript := ' valley'
    else if abs(percent) < 5 then
      descript := ' critical transition'
    else
    begin
      var daysToAdd := trunc((quadrant + 1) * len / 4 - position);
      var transition := td + daysToAdd;
      var trend := quadrants[quadrant, 0];
      var next := quadrants[quadrant, 1];
      var transStr := DateToStr(transition);
      var percentRounded := percent;
      descript := format('%5.3f%% (%s, next %s %s)', [percentRounded, trend,
        next, transStr]);
    end;
    writeln(format('%s %2d : %s', [cycle, position, descript]));
  end;
  writeln;
end;

begin
  for var i := 0 to High(datePairs) do
    CalcBiorhythms(datePairs[i, 0], datePairs[i, 1]);
  readln;
end.


with Ada.Containers.Vectors;
with Ada.Numerics.Discrete_Random;
with Ada.Text_Io;

procedure Mutations is

   Width : constant := 60;

   type Nucleotide_Type is (A, C, G, T);
   type Operation_Type is (Delete, Insert, Swap);
   type Position_Type is new Natural;

   package Position_Io   is new Ada.Text_Io.Integer_Io (Position_Type);
   package Nucleotide_Io is new Ada.Text_Io.Enumeration_Io (Nucleotide_Type);
   package Operation_Io  is new Ada.Text_Io.Enumeration_Io (Operation_Type);

   use Ada.Text_Io, Position_Io, Nucleotide_Io, Operation_Io;

   package Sequence_Vectors is new Ada.Containers.Vectors (Index_Type   => Position_Type,
                                                           Element_Type => Nucleotide_Type);
   package Nucleotide_Generators is new Ada.Numerics.Discrete_Random (Result_Subtype => Nucleotide_Type);
   package Operation_Generators  is new Ada.Numerics.Discrete_Random (Result_Subtype => Operation_Type);

   procedure Pretty_Print (Sequence : Sequence_Vectors.Vector) is
      First : Position_Type := Sequence.First_Index;
      Last  : Position_Type;
      Count : array (Nucleotide_Type) of Natural := (others  => 0);
   begin
      Last := Position_Type'Min (First + Width - 1,
                                 Sequence.Last_Index);
      loop
         Position_Io.Put (First, Width => 4);
         Put (": ");
         for N in First .. Last loop
            declare
               Nucleotide : Nucleotide_Type renames Sequence (N);
            begin
               Put (Nucleotide);
               Count (Nucleotide) := Count (Nucleotide) + 1;
            end;
         end loop;
         New_Line;
         exit when Last = Sequence.Last_Index;
         First := Last + 1;
         Last  := Position_Type'Min (First + Width - 1,
                                     Sequence.Last_Index);
      end loop;

      for N in Count'Range loop
         Put ("Count of "); Put (N); Put (" is "); Put (Natural'Image (Count (N))); New_Line;
      end loop;

   end Pretty_Print;

   function Random_Position (First, Last : Position_Type) return Position_Type is
      subtype Position_Range is Position_Type range First .. Last;
      package Position_Generators is new Ada.Numerics.Discrete_Random (Result_Subtype => Position_Range);
      Generator : Position_Generators.Generator;
   begin
      Position_Generators.Reset (Generator);
      return Position_Generators.Random (Generator);
   end Random_Position;

   Nucleotide_Generator : Nucleotide_Generators.Generator;
   Operation_Generator  : Operation_Generators.Generator;

   Sequence   : Sequence_Vectors.Vector;
   Position   : Position_Type;
   Nucleotide : Nucleotide_Type;
   Operation  : Operation_Type;
begin
   Nucleotide_Generators.Reset (Nucleotide_Generator);
   Operation_Generators.Reset (Operation_Generator);

   for A in 1 .. 200 loop
      Sequence.Append (Nucleotide_Generators.Random (Nucleotide_Generator));
   end loop;

   Put_Line ("Initial sequence:");
   Pretty_Print (Sequence);
   New_Line;

   Put_Line ("Mutations:");
   for Mutate in 1 .. 10 loop

      Operation := Operation_Generators.Random (Operation_Generator);
      case Operation is

         when Delete =>
            Position := Random_Position (Sequence.First_Index, Sequence.Last_Index);
            Sequence.Delete (Index => Position);
            Put (Operation); Put (" at position "); Put (Position, Width => 0); New_Line;

         when Insert =>
            Position   := Random_Position (Sequence.First_Index, Sequence.Last_Index + 1);
            Nucleotide := Nucleotide_Generators.Random (Nucleotide_Generator);
            Sequence.Insert (Before   => Position,
                             New_Item => Nucleotide);
            Put (Operation); Put (" "); Put (Nucleotide); Put (" at position ");
            Put (Position, Width => 0); New_Line;

         when Swap =>
            Position   := Random_Position (Sequence.First_Index, Sequence.Last_Index);
            Nucleotide := Nucleotide_Generators.Random (Nucleotide_Generator);
            Sequence.Replace_Element (Index    => Position,
                                      New_Item => Nucleotide);
            Put (Operation); Put (" at position "); Put (Position, Width => 0);
            Put (" to "); Put (Nucleotide); New_Line;

      end case;
   end loop;

   New_Line;
   Put_Line ("Mutated sequence:");
   Pretty_Print (Sequence);

end Mutations;


(require 'calendar)

(setq biorhythm-birthdate '(3 16 1953))

(defun biorhythm ()
  "Show today's biorhythm."
  (interactive)
  (let* ((diff (abs (- (string-to-number (calendar-astro-date-string
               biorhythm-birthdate)) (string-to-number
               (calendar-astro-date-string)))))
         (rhyt '(23 28 33))
         (perc (mapcar (lambda (x) (round (* 100 (sin
               (* 2 pi diff (/ 1.0 x)))))) rhyt)))
    (message "age: %i  physical: %i%%  emotional: %i%%  intellectual: %i%%"
             diff (car perc) (cadr perc) (caddr perc))))


USING: calendar calendar.parser formatting io kernel math
math.constants math.functions ;

: days-between ( ymd-str ymd-str -- n )
    [ ymd>timestamp ] [email protected] time- duration>days abs ;

: trend ( pos len -- str ) / 4 * floor 3 divisor? "↑" "↓" ? ;

: percent ( pos len -- x ) [ 2pi * ] [ / sin 100 * ] bi* ;

: .day ( days cycle-length day-type -- )
    write [ mod ] keep [ drop ] [ percent ] [ trend ] 2tri
    " day %d: %.1f%%%s\n" printf ;

: .biorhythm ( ymd-str ymd-str -- )
    2dup "Born %s, Target %s\n" printf days-between dup
    "Day %d\n" printf
    [ 23 "Physical" .day ]
    [ 28 "Emotional" .day ]
    [ 33 "Mental" .day ] tri ;

"1809-02-12" "1863-11-19" .biorhythm


C     ------------------------------------------------------------------
      PROGRAM BIORHYTHM
C     ------------------------------------------------------------------
      DOUBLE PRECISION GETJD
      CHARACTER*3 DOW

      DOUBLE PRECISION JD0, JD1, JD2, PI2, DIF

      INTEGER BYEAR, BMON, BDAY, TYEAR, TMON, TDAY
      INTEGER I, J, PHY, EMO, MEN, NDAY, DNUM, YR, DOY
      CHARACTER*3 DNAME
      CHARACTER*1 GRID, ROW(65)
C     ------------------------------------------------------------------

      PI2 = ACOS(-1.0D0)*2.0D0

      WRITE(*,*) 'ENTER YOUR BIRTHDAY YYYY MM DD'
      READ(*,*) BYEAR, BMON, BDAY

      WRITE(*,*) 'ENTER START DATE YYYY MM DD'
      READ(*,*) TYEAR, TMON, TDAY

      WRITE(*,*) 'ENTER NUMBER OF DAYS TO PLOT'
      READ(*,*) NDAY

      JD0 = GETJD( TYEAR, 1,  1 )
      JD1 = GETJD( BYEAR, BMON, BDAY )
      JD2 = GETJD( TYEAR, TMON, TDAY )

      WRITE(*,1010)
      WRITE(*,1000) DOW(JD1), INT( JD2-JD1 )
      WRITE(*,1010)
      WRITE(*,1020)
      DO I=1,NDAY
         DIF = JD2 - JD1
         PHY = INT(3.3D1+3.2D1*SIN( PI2 * DIF / 2.3D1 ))
         EMO = INT(3.3D1+3.2D1*SIN( PI2 * DIF / 2.8D1 ))
         MEN = INT(3.3D1+3.2D1*SIN( PI2 * DIF / 3.3D1 ))

         IF ( PHY.LT.1  ) PHY = 1
         IF ( EMO.LT.1  ) EMO = 1
         IF ( MEN.LT.1  ) MEN = 1
         IF ( PHY.GT.65 ) PHY = 65
         IF ( EMO.GT.65 ) EMO = 65
         IF ( MEN.GT.65 ) MEN = 65

         DNAME = DOW(JD2)
         DOY = INT(JD2-JD0)+1
         IF ( DNAME.EQ.'SUN' ) THEN
            GRID = '.'
         ELSE
            GRID = ' '
         END IF
         DO J=1,65
            ROW(J) = GRID
         END DO
         ROW(1)  = '|'
         ROW(17) = ':'
         ROW(33) = '|'
         ROW(49) = ':'
         ROW(65) = '|'
         ROW(PHY) = 'P'
         ROW(EMO) = 'E'
         ROW(MEN) = 'M'
         IF ( PHY.EQ.EMO ) ROW(PHY) = '*'
         IF ( PHY.EQ.MEN ) ROW(PHY) = '*'
         IF ( EMO.EQ.MEN ) ROW(EMO) = '*'
         WRITE(*,1030) ROW,DNAME,DOY
         JD2 = JD2 + 1.0D0
      END DO
      WRITE(*,1010)

C     ------------------------------------------------------------------

 1000 FORMAT( 'YOU WERE BORN ON A (', A3, ') YOU WERE ',I0,
     $        ' DAYS OLD AT THE START.' )
 1010 FORMAT( 75('=') )
 1020 FORMAT( '-1',31X,'0',30X,'+1     DOY' )
 1030 FORMAT( 1X,65A1, 1X, A3, 1X, I3 )

      STOP
      END

C     ------------------------------------------------------------------
      FUNCTION DOW( JD )
C     ------------------------------------------------------------------
C     RETURN THE ABBREVIATION FOR THE DAY OF THE WEEK
C     JD  JULIAN DATE - GREATER THAN 1721423.5 (JAN 1, 0001 SATURDAY)
C     ------------------------------------------------------------------
      DOUBLE PRECISION JD
      INTEGER IDX
      CHARACTER*3 DOW, NAMES(7)
      DATA NAMES/'SAT','SUN','MON','TUE','WED','THR','FRI'/

      IDX = INT(MODULO(JD-1.721423500D6,7.0D0)+1)

      DOW = NAMES(IDX)
      RETURN
      END

C     ------------------------------------------------------------------
      FUNCTION ISGREG( Y, M, D )
C     ------------------------------------------------------------------
C     IS THIS DATE ON IN THE GREGORIAN CALENDAR
C     DATES BEFORE OCT  5 1582 ARE JULIAN
C     DATES AFTER  OCT 14 1582 ARE GREGORIAN
C     DATES OCT 5-14 1582 INCLUSIVE DO NOT EXIST
C     ------------------------------------------------------------------
C     YEAR    1-ANYTHING
C     MONTH   1-12
C     DAY     1-31
C     ------------------------------------------------------------------
      LOGICAL ISGREG
      INTEGER Y, M, D
C     ------------------------------------------------------------------
      ISGREG=.TRUE.
      IF ( Y.LT.1582 ) GOTO 888
      IF ( Y.GT.1582 ) GOTO 999
      IF ( M.LT.10 )   GOTO 888
      IF ( M.GT.10 )   GOTO 999
      IF ( D.LT.5 )    GOTO 888
      IF ( D.GT.14 )   GOTO 999

      WRITE(*,*) Y,M,D,' DOES NOT EXIST'
      GOTO 999

 888  CONTINUE
      ISGREG=.FALSE.
 999  CONTINUE
      RETURN
      END

C     ------------------------------------------------------------------
      FUNCTION GETJD( YEAR, MONTH, DAY )
C     ------------------------------------------------------------------
C     RETURN THE JULIAN DATE
C     YEAR    1-ANYTHING
C     MONTH   1-12
C     DAY     1-31
C     ------------------------------------------------------------------
      DOUBLE PRECISION GETJD
      INTEGER YEAR, MONTH, DAY
      INTEGER Y, M, D, A, B, P1, P2
C     ------------------------------------------------------------------
      DOUBLE PRECISION TEMP
      LOGICAL ISGREG, IG

      IG = ISGREG( YEAR, MONTH, DAY )
      Y  = YEAR
      M  = MONTH
      D  = DAY

      IF (M.LT.3) THEN
         Y = Y - 1
         M = M + 12
      ENDIF

      IF (IG) THEN
         A =         FLOOR( DBLE(Y) * 1.0D-2 )
         B = 2 - A + FLOOR( DBLE(A) * 2.5D-1 )
      ELSE
         A = 0
         B = 0
      ENDIF

      P1 = FLOOR( 3.65250D2 * DBLE(Y + 4716) )
      P2 = FLOOR( 3.06001D1 * DBLE(M + 1) )

      GETJD = DBLE(P1 + P2 + D + B) - 1.5245D3

      RETURN
      END


bases: ["A" "T" "G" "C"]
dna: map 1..200 => [sample bases]

prettyPrint: function [in][
    count: #[ A: 0, T: 0, G: 0, C: 0 ]

    loop.with:'i split.every:50 in 'line [
        prints [pad to :string i*50 3 ":"]
        print map split.every:10 line => join

        loop split line 'ch [
            case [ch=]
                when? -> "A" -> count\A: count\A + 1
                when? -> "T" -> count\T: count\T + 1
                when? -> "G" -> count\G: count\G + 1
                when? -> "C" -> count\C: count\C + 1
                else []
        ]
    ]
    print ["Total count => A:" count\A, "T:" count\T "G:" count\G "C:" count\C]
]

performRandomModifications: function [seq,times][
    result: new seq

    loop times [x][
        what: random 1 3
        case [what=]
            when? -> 1 [
                ind: random 0 (size result)
                previous: get result ind
                next: sample bases
                set result ind next
                print ["changing base at position" ind "from" previous "to" next]
            ]
            when? -> 2 [
                ind: random 0 (size result)
                next: sample bases
                result: insert result ind next
                print ["inserting base" next "at position" ind]
            ]
            else [
                ind: random 0 (size result)
                previous: get result ind
                result: remove result .index ind
                print ["deleting base" previous "at position" ind]
            ]
    ]
    return result
]

print "------------------------------"
print " Initial sequence"
print "------------------------------"
prettyPrint dna
print ""

print "------------------------------"
print " Modifying sequence"
print "------------------------------"
dna: performRandomModifications dna 10
print ""

print "------------------------------"
print " Final sequence"
print "------------------------------"
prettyPrint dna
print ""


#include<stdlib.h>
#include<stdio.h>
#include<time.h>

typedef struct genome{
    char base;
    struct genome *next;
}genome;

typedef struct{
    char mutation;
    int position;
}genomeChange;

typedef struct{
    int adenineCount,thymineCount,cytosineCount,guanineCount;
}baseCounts;

genome *strand;
baseCounts baseData;
int genomeLength = 100, lineLength = 50;

int numDigits(int num){
    int len = 1;

    while(num>10){
        num /= 10;
        len++;
    }
    return len;
}

void generateStrand(){

    int baseChoice = rand()%4, i;
    genome *strandIterator, *newStrand;

    baseData.adenineCount = 0;
    baseData.thymineCount = 0;
    baseData.cytosineCount = 0;
    baseData.guanineCount = 0;

    strand = (genome*)malloc(sizeof(genome));
    strand->base = baseChoice==0?'A':(baseChoice==1?'T':(baseChoice==2?'C':'G'));
    baseChoice==0?baseData.adenineCount++:(baseChoice==1?baseData.thymineCount++:(baseChoice==2?baseData.cytosineCount++:baseData.guanineCount++));
    strand->next = NULL;

    strandIterator = strand;

    for(i=1;i<genomeLength;i++){
        baseChoice = rand()%4;

        newStrand = (genome*)malloc(sizeof(genome));
        newStrand->base = baseChoice==0?'A':(baseChoice==1?'T':(baseChoice==2?'C':'G'));
        baseChoice==0?baseData.adenineCount++:(baseChoice==1?baseData.thymineCount++:(baseChoice==2?baseData.cytosineCount++:baseData.guanineCount++));
        newStrand->next = NULL;

        strandIterator->next = newStrand;
        strandIterator = newStrand;
    }
}

genomeChange generateMutation(int swapWeight, int insertionWeight, int deletionWeight){
    int mutationChoice = rand()%(swapWeight + insertionWeight + deletionWeight);

    genomeChange mutationCommand;

    mutationCommand.mutation = mutationChoice<swapWeight?'S':((mutationChoice>=swapWeight && mutationChoice<swapWeight+insertionWeight)?'I':'D');
    mutationCommand.position = rand()%genomeLength;

    return mutationCommand;
}

void printGenome(){
    int rows, width = numDigits(genomeLength), len = 0,i,j;
	lineLength = (genomeLength<lineLength)?genomeLength:lineLength;

	rows = genomeLength/lineLength + (genomeLength%lineLength!=0);

    genome* strandIterator = strand;

    printf("\n\nGenome : \n--------\n");

    for(i=0;i<rows;i++){
        printf("\n%*d%3s",width,len,":");

        for(j=0;j<lineLength && strandIterator!=NULL;j++){
                printf("%c",strandIterator->base);
                strandIterator = strandIterator->next;
        }
        len += lineLength;
    }

    while(strandIterator!=NULL){
            printf("%c",strandIterator->base);
            strandIterator = strandIterator->next;
    }

    printf("\n\nBase Counts\n-----------");

    printf("\n%*c%3s%*d",width,'A',":",width,baseData.adenineCount);
    printf("\n%*c%3s%*d",width,'T',":",width,baseData.thymineCount);
    printf("\n%*c%3s%*d",width,'C',":",width,baseData.cytosineCount);
    printf("\n%*c%3s%*d",width,'G',":",width,baseData.guanineCount);

	printf("\n\nTotal:%*d",width,baseData.adenineCount + baseData.thymineCount + baseData.cytosineCount + baseData.guanineCount);

    printf("\n");
}

void mutateStrand(int numMutations, int swapWeight, int insertionWeight, int deletionWeight){
    int i,j,width,baseChoice;
    genomeChange newMutation;
    genome *strandIterator, *strandFollower, *newStrand;

    for(i=0;i<numMutations;i++){
        strandIterator = strand;
        strandFollower = strand;
        newMutation = generateMutation(swapWeight,insertionWeight,deletionWeight);
        width = numDigits(genomeLength);

        for(j=0;j<newMutation.position;j++){
            strandFollower = strandIterator;
            strandIterator = strandIterator->next;
        }

        if(newMutation.mutation=='S'){
            if(strandIterator->base=='A'){
                strandIterator->base='T';
                printf("\nSwapping A at position : %*d with T",width,newMutation.position);
            }
            else if(strandIterator->base=='A'){
                strandIterator->base='T';
                printf("\nSwapping A at position : %*d with T",width,newMutation.position);
            }
            else if(strandIterator->base=='C'){
                strandIterator->base='G';
                printf("\nSwapping C at position : %*d with G",width,newMutation.position);
            }
            else{
                strandIterator->base='C';
                printf("\nSwapping G at position : %*d with C",width,newMutation.position);
            }
        }

        else if(newMutation.mutation=='I'){
            baseChoice = rand()%4;

            newStrand = (genome*)malloc(sizeof(genome));
            newStrand->base = baseChoice==0?'A':(baseChoice==1?'T':(baseChoice==2?'C':'G'));
            printf("\nInserting %c at position : %*d",newStrand->base,width,newMutation.position);
            baseChoice==0?baseData.adenineCount++:(baseChoice==1?baseData.thymineCount++:(baseChoice==2?baseData.cytosineCount++:baseData.guanineCount++));
            newStrand->next = strandIterator;
            strandFollower->next = newStrand;
            genomeLength++;
        }

        else{
            strandFollower->next = strandIterator->next;
            strandIterator->next = NULL;
            printf("\nDeleting %c at position : %*d",strandIterator->base,width,newMutation.position);
            free(strandIterator);
            genomeLength--;
        }
    }
}

int main(int argc,char* argv[])
{
    int numMutations = 10, swapWeight = 10, insertWeight = 10, deleteWeight = 10;

    if(argc==1||argc>6){
                printf("Usage : %s <Genome Length> <Optional number of mutations> <Optional Swapping weight> <Optional Insertion weight> <Optional Deletion weight>\n",argv[0]);
                return 0;
    }

    switch(argc){
        case 2: genomeLength = atoi(argv[1]);
                break;
        case 3: genomeLength = atoi(argv[1]);
                numMutations = atoi(argv[2]);
                break;
        case 4: genomeLength = atoi(argv[1]);
                numMutations = atoi(argv[2]);
                swapWeight   = atoi(argv[3]);
                break;
        case 5: genomeLength = atoi(argv[1]);
                numMutations = atoi(argv[2]);
                swapWeight   = atoi(argv[3]);
                insertWeight = atoi(argv[4]);
                break;
        case 6: genomeLength = atoi(argv[1]);
                numMutations = atoi(argv[2]);
                swapWeight   = atoi(argv[3]);
                insertWeight = atoi(argv[4]);
                deleteWeight = atoi(argv[5]);
                break;
    };

    srand(time(NULL));
    generateStrand();

	printf("\nOriginal:");
    printGenome();
    mutateStrand(numMutations,swapWeight,insertWeight,deleteWeight);

	printf("\n\nMutated:");
	printGenome();

    return 0;
}


#define floor(x) ((x*2.0-0.5) Shr 1)
#define pi (4 * Atn(1))

Function Gregorian(db As String) As Integer
    Dim As Integer M, Y, D
    Y = Valint(Left(db,4)) :  M = Valint(Mid(db,6,2)) : D = Valint(Right(db,2))
    Dim As Integer N = (M+9) - Int((M+9)/12) * 12
    Dim As Integer W = Y - Int(N/10)
    Dim As Integer G = 365 * W + Int(W/4) - Int(W/100) + Int(W/400)
    G += Int((N*306+5)/10)+(D-1)
    Return G
End Function

Function Biorhythm(Birthdate As String, Targetdate As String) As String
    'Jagged Array
    Dim As String TextArray(4,2) = {{"up and rising", "peak"}, {"up but falling", "transition"}, {"down and falling", "valley"}, {"down but rising", "transition"}}

    Dim As Integer DaysBetween = Gregorian(Targetdate) - Gregorian(Birthdate)

    Dim As Integer positionP = DaysBetween Mod 23
    Dim As Integer positionE = DaysBetween Mod 28
    Dim As Integer positionM = DaysBetween Mod 33

    'return the positions - just to return something
    Biorhythm = Str(positionP) & "/" & Str(positionE) & "/" & Str(positionM)

    Dim As Integer quadrantP = Int(4 * positionP / 23)
    Dim As Integer quadrantE = Int(4 * positionE / 28)
    Dim As Integer quadrantM = Int(4 * positionM / 33)

    Dim As Single percentageP = Fix(100 * Sin(2 * pi * (positionP / 23)))
    Dim As Single percentageE = Fix(100 * Sin(2 * pi * (positionE / 28)))
    Dim As Single percentageM = Fix(100 * Sin(2 * pi * (positionM / 33)))

    Dim As Single transitionP = Val(Targetdate) + floor((quadrantP + 1) / 4 * 23) - positionP
    Dim As Single transitionE = Val(Targetdate) + floor((quadrantE + 1) / 4 * 28) - positionE
    Dim As Single transitionM = Val(Targetdate) + floor((quadrantM + 1) / 4 * 33) - positionM

    Dim As String textP, textE, textM, Header1Text, Header2Text
    Select Case percentageP
    Case Is > 95
        textP = "Physical day  " & positionP & " : " & "peak"
    Case Is < -95
        textP = "Physical day  " & positionP & " : " & "valley"
    Case -5 To 5
        textP = "Physical day  " & positionP & " : " & "critical transition"
    Case Else
        textP = "Physical day  " & positionP & " : " & percentageP & "% (" & TextArray(quadrantP,0) & ", next " & TextArray(quadrantP,1) & " " & transitionP & ")"
    End Select

    Select Case percentageE
    Case Is > 95
        textE = "Emotional day " & positionE & " : " & "peak"
    Case Is < -95
        textE = "Emotional day " & positionE & " : " & "valley"
    Case -5 To 5
        textE = "Emotional day " & positionE & " : " & "critical transition"
    Case Else
        textE = "Emotional day " & positionE & " : " & percentageE & "% (" & TextArray(quadrantE,0) & ", next " & TextArray(quadrantE,1) & " " & transitionE & ")"
    End Select

    Select Case percentageM
    Case Is > 95
        textM = "Mental day " & positionM & "    : " & "peak"
    Case Is < -95
        textM = "Mental day " & positionM & "    : " & "valley"
    Case -5 To 5
        textM = "Mental day " & positionM & "    : " & "critical transition"
    Case Else
        textM = "Mental day " & positionM & "    : " & percentageM & "% (" & TextArray(quadrantM,0) & ", next " & TextArray(quadrantM,1) & " " & transitionM & ")"
    End Select

    Header1Text = "Born " & Birthdate & ", Target " & Targetdate
    Header2Text = "Day " & DaysBetween

    Print Header1Text
    Print Header2Text
    Print textP
    Print textE
    Print textM
    Print
End Function

Biorhythm("1943-03-09", "1972-07-11")
Biorhythm("1809-02-12", "1863-11-19")   'correct DOB for Abraham Lincoln
Biorhythm("1809-01-12", "1863-11-19")


#include <array>
#include <iomanip>
#include <iostream>
#include <random>
#include <string>

class sequence_generator {
public:
    sequence_generator();
    std::string generate_sequence(size_t length);
    void mutate_sequence(std::string&);
    static void print_sequence(std::ostream&, const std::string&);
    enum class operation { change, erase, insert };
    void set_weight(operation, unsigned int);
private:
    char get_random_base() {
        return bases_[base_dist_(engine_)];
    }
    operation get_random_operation();
    static const std::array<char, 4> bases_;
    std::mt19937 engine_;
    std::uniform_int_distribution<size_t> base_dist_;
    std::array<unsigned int, 3> operation_weight_;
    unsigned int total_weight_;
};

const std::array<char, 4> sequence_generator::bases_{ 'A', 'C', 'G', 'T' };

sequence_generator::sequence_generator() : engine_(std::random_device()()),
    base_dist_(0, bases_.size() - 1),
    total_weight_(operation_weight_.size()) {
    operation_weight_.fill(1);
}

sequence_generator::operation sequence_generator::get_random_operation() {
    std::uniform_int_distribution<unsigned int> op_dist(0, total_weight_ - 1);
    unsigned int n = op_dist(engine_), op = 0, weight = 0;
    for (; op < operation_weight_.size(); ++op) {
        weight += operation_weight_[op];
        if (n < weight)
            break;
    }
    return static_cast<operation>(op);
}

void sequence_generator::set_weight(operation op, unsigned int weight) {
    total_weight_ -= operation_weight_[static_cast<size_t>(op)];
    operation_weight_[static_cast<size_t>(op)] = weight;
    total_weight_ += weight;
}

std::string sequence_generator::generate_sequence(size_t length) {
    std::string sequence;
    sequence.reserve(length);
    for (size_t i = 0; i < length; ++i)
        sequence += get_random_base();
    return sequence;
}

void sequence_generator::mutate_sequence(std::string& sequence) {
    std::uniform_int_distribution<size_t> dist(0, sequence.length() - 1);
    size_t pos = dist(engine_);
    char b;
    switch (get_random_operation()) {
    case operation::change:
        b = get_random_base();
        std::cout << "Change base at position " << pos << " from "
            << sequence[pos] << " to " << b << '\n';
        sequence[pos] = b;
        break;
    case operation::erase:
        std::cout << "Erase base " << sequence[pos] << " at position "
            << pos << '\n';
        sequence.erase(pos, 1);
        break;
    case operation::insert:
        b = get_random_base();
        std::cout << "Insert base " << b << " at position "
            << pos << '\n';
        sequence.insert(pos, 1, b);
        break;
    }
}

void sequence_generator::print_sequence(std::ostream& out, const std::string& sequence) {
    constexpr size_t base_count = bases_.size();
    std::array<size_t, base_count> count = { 0 };
    for (size_t i = 0, n = sequence.length(); i < n; ++i) {
        if (i % 50 == 0) {
            if (i != 0)
                out << '\n';
            out << std::setw(3) << i << ": ";
        }
        out << sequence[i];
        for (size_t j = 0; j < base_count; ++j) {
            if (bases_[j] == sequence[i]) {
                ++count[j];
                break;
            }
        }
    }
    out << '\n';
    out << "Base counts:\n";
    size_t total = 0;
    for (size_t j = 0; j < base_count; ++j) {
        total += count[j];
        out << bases_[j] << ": " << count[j] << ", ";
    }
    out << "Total: " << total << '\n';
}

int main() {
    sequence_generator gen;
    gen.set_weight(sequence_generator::operation::change, 2);
    std::string sequence = gen.generate_sequence(250);
    std::cout << "Initial sequence:\n";
    sequence_generator::print_sequence(std::cout, sequence);
    constexpr int count = 10;
    for (int i = 0; i < count; ++i)
        gen.mutate_sequence(sequence);
    std::cout << "After " << count << " mutations:\n";
    sequence_generator::print_sequence(std::cout, sequence);
    return 0;
}


package main

import (
    "fmt"
    "log"
    "math"
    "time"
)

const layout = "2006-01-02" // template for time.Parse

var cycles = [3]string{"Physical day ", "Emotional day", "Mental day   "}
var lengths = [3]int{23, 28, 33}
var quadrants = [4][2]string{
    {"up and rising", "peak"},
    {"up but falling", "transition"},
    {"down and falling", "valley"},
    {"down but rising", "transition"},
}

func check(err error) {
    if err != nil {
        log.Fatal(err)
    }
}

// Parameters assumed to be in YYYY-MM-DD format.
func biorhythms(birthDate, targetDate string) {
    bd, err := time.Parse(layout, birthDate)
    check(err)
    td, err := time.Parse(layout, targetDate)
    check(err)
    days := int(td.Sub(bd).Hours() / 24)
    fmt.Printf("Born %s, Target %s\n", birthDate, targetDate)
    fmt.Println("Day", days)
    for i := 0; i < 3; i++ {
        length := lengths[i]
        cycle := cycles[i]
        position := days % length
        quadrant := position * 4 / length
        percent := math.Sin(2 * math.Pi * float64(position) / float64(length))
        percent = math.Floor(percent*1000) / 10
        descript := ""
        if percent > 95 {
            descript = " peak"
        } else if percent < -95 {
            descript = " valley"
        } else if math.Abs(percent) < 5 {
            descript = " critical transition"
        } else {
            daysToAdd := (quadrant+1)*length/4 - position
            transition := td.Add(time.Hour * 24 * time.Duration(daysToAdd))
            trend := quadrants[quadrant][0]
            next := quadrants[quadrant][1]
            transStr := transition.Format(layout)
            descript = fmt.Sprintf("%5.1f%% (%s, next %s %s)", percent, trend, next, transStr)
        }
        fmt.Printf("%s %2d : %s\n", cycle, position, descript)
    }
    fmt.Println()
}

func main() {
    datePairs := [][2]string{
        {"1943-03-09", "1972-07-11"},
        {"1809-01-12", "1863-11-19"},
        {"1809-02-12", "1863-11-19"}, // correct DOB for Abraham Lincoln
    }
    for _, datePair := range datePairs {
        biorhythms(datePair[0], datePair[1])
    }
}


(defun random_base ()
    (random 4))

(defun basechar (base)
    (char "ACTG" base))

(defun generate_genome (genome_length)
    (let (genome '())
        (loop for i below genome_length do
            (push (random_base) genome))
        (return-from generate_genome genome)))

(defun map_genome (genome)
    (let (seq '())
        (loop for n from (1- (length genome)) downto 0 do
            (push (position (char genome n) "ACTG") seq))
        seq))

(defun output_genome_info (genome &optional (genome_name "ORIGINAL"))
    (let ((ac 0) (tc 0) (cc 0) (gc 0))
        (format t "~%           ---- ~a ----" genome_name)
        (do ((n 0 (1+ n)))
            ((= n (length genome)))
            (when (= 0 (mod n 50)) (format t "~& ~4d: " (1+ n)))
            (case (nth n genome)
                (0 (incf ac))
                (1 (incf tc))
                (2 (incf cc))
                (3 (incf gc)))
            (format t "~c" (basechar (nth n genome))))
            (format t "~2%- Total : ~3d~%A : ~d   C : ~d~%T : ~d   G : ~d~2%" (length genome) ac tc cc gc)))

(defun insert_base (genome)
    (let ((place (random (length genome)))
        (base (random_base)))
        (format t "Insert      +  ~c   at   ~3d~%"
            (basechar base) (+ 1 place))
        (if (= 0 place)
            (push base genome)
            (push base (cdr (nthcdr (1- place) genome))))
        (return-from insert_base genome)))

(defun swap_base (genome)
    (let ((place (random (length genome)))
        (base (random_base)))
        (format t "Swap      ~c -> ~c   at   ~3d~%"
            (basechar (nth place genome)) (basechar base) (+ 1 place))
        (setf (nth place genome) base)
        (return-from swap_base genome)))

(defun delete_base (genome)
    (let ((place (random (length genome))))
        (format t "Delete      -  ~c   at   ~3d~%"
            (basechar (nth place genome)) (+ 1 place))
        (if (= 0 place) (pop genome)
        (pop (cdr (nthcdr (1- place) genome))))
        (return-from delete_base genome)))

(defun mutate (genome_length n_mutations
    &key (ins_w 10) (swp_w 10) (del_w 10)
        (genome (generate_genome genome_length) has_genome))
    (if has_genome (setf genome (map_genome genome)))
    (output_genome_info genome)
    (format t "      ---- MUTATION SEQUENCE ----~%")
    (do ((n 0 (1+ n)))
        ((= n n_mutations))
        (setf mutation_type (random (+ ins_w swp_w del_w)))
        (format t "~3d : " (1+ n))
        (setf genome
            (cond ((< mutation_type ins_w) (insert_base genome))
                ((< mutation_type (+ ins_w swp_w)) (swap_base genome))
                (t (delete_base genome)))))
    (output_genome_info genome "MUTATED"))


use=: 'Use: ', (;:inv 2 {. ARGV) , ' YYYY-MM-DD YYYY-MM-DD'

3 :0 ::echo use
 TAU=: 2p1  NB. tauday.com

 require'plot ~addons/types/datetime/datetime.ijs'

 span=: (i.7) + daysDiff&(1 0 0 0 1 0 1 0 ".;.1 -.&'-')~
 Length=: 23 5 p. i. 3
 arg=: Length *inv TAU * Length |/ span
 brtable=: 1 o. arg
 biorhythm=: 'title biorythms for the week ahead; key Physical Emotional Mental' plot (i.7) (j."1) brtable~
 biorhythm/ 2 3 {::"0 1 ARGV
 echo 'find new graph (plot.pdf) in directory ' , jpath '~temp/'

 brs=. brtable/ 2 3 {::"0 1 ARGV
 echo (a:,'values';'interpretation') ,: (4 10 $ 'days aheadPhysical  Emotional Mental     ') ; (1 3 # 6 6j1)&(":"0 1) L:0 (; |) brs ,~ i. 7
)

exit 0


using Dates

const cycles = ["Physical" => 23, "Emotional" => 28,"Mental" => 33]
const quadrants = [("up and rising", "peak"), ("up but falling", "transition"),
                   ("down and falling", "valley"), ("down but rising", "transition")]

function tellfortune(birthday::Date, date = today())
    days = (date - birthday).value
    target = (date - Date(0)).value
    println("Born $birthday, target date $date\nDay $days:")
    for (label, length) in cycles
        position = days % length
        quadrant = Int(floor((4 * position) / length)) + 1
        percentage = round(100 * sinpi(2 * position / length), digits=1)
        transition = target - position + (length * quadrant) ÷ 4
        trend, next = quadrants[quadrant]
        description = (percentage > 95) ? "peak" :
                      (percentage < -95) ? "valley" :
                      (abs(percentage) < 5) ? "critical transition" :
                      "$percentage% ($trend, next $next $(Date(0) + Dates.Day(transition)))"
        println("$label day $position: $description")
    end
    println()
end

tellfortune(Date("1943-03-09"), Date("1972-07-11"))
tellfortune(Date("1809-01-12"), Date("1863-11-19"))
tellfortune(Date("1809-02-12"), Date("1863-11-19"))


10 input "Birthday (y,m,d) ",y,m,d:gosub 3000
20 gosub 1000
30 bday = day
40 input "Today's date (y,m,d) ",y,m,d:gosub 3000
50 gosub 1000
60 diff = day - bday
70 print:print "Age in days:" tab(22) diff
80 t$ = "physical":l = 23:gosub 2000
90 t$ = "emotional":l = 28:gosub 2000
100 t$ = "intellectual":l = 33:gosub 2000
999 end
1000 ' Get the days to J2000
1010 ' FNday only works between 1901 to 2099 - see Meeus chapter 7
1020 day = 367 * y - 7 * (y + (m + 9) \ 12) \ 4 + 275 * m \ 9 + d - 730530
1030 return
2000 p = 100 * sin(2*pi*diff/l)
2010 print t$; " cycle: " tab(22)
2020 print using "+###"; int(p);
2030 print "%";
2040 if abs(p) < 15 then print " (critical)" else print
2050 return
3000 if y < 1901 or y > 2099 then print "Year must be between 1901 and 2099!":run
3010 return


USING: assocs combinators.random formatting grouping io kernel
macros math math.statistics namespaces prettyprint quotations
random sequences sorting ;
IN: sequence-mutation

SYMBOL: verbose?  ! Turn on to show mutation details.
                  ! Off by default.

! Return a random base as a character.
: rand-base ( -- n ) "ACGT" random ;

! Generate a random dna sequence of length n.
: <dna> ( n -- seq ) [ rand-base ] "" replicate-as ;

! Prettyprint a dna sequence in blocks of n.
: .dna ( seq n -- )
    "SEQUENCE:" print [ group ] keep
    [ * swap "  %3d: %s\n" printf ] curry each-index ;

! Show a histogram of bases in a dna sequence and their total.
: show-counts ( seq -- )
    "BASE COUNTS:" print histogram >alist [ first ] sort-with
    [ [ "    %c: %3d\n" printf ] assoc-each ]
    [ "TOTAL: " write [ second ] [ + ] map-reduce . ] bi ;

! Prettyprint the overall state of a dna sequence.
: show-dna ( seq -- ) [ 50 .dna nl ] [ show-counts nl ] bi ;

! Call a quotation only if verbose? is on.
: log ( quot -- ) verbose? get [ call ] [ drop ] if ; inline

! Set index n to a random base.
: bswap ( n seq -- seq' )
    [ rand-base ] 2dip 3dup [ nth ] keepd spin
    [ "  index %3d: swapping  %c with %c\n" printf ] 3curry log
    [ set-nth ] keep ;

! Remove the base at index n.
: bdelete ( n seq -- seq' )
    2dup dupd nth [ "  index %3d: deleting  %c\n" printf ]
    2curry log remove-nth ;

! Insert a random base at index n.
: binsert ( n seq -- seq' )
    [ rand-base ] 2dip over reach
    [ "  index %3d: inserting %c\n" printf ] 2curry log
    insert-nth ;

! Allow "passing" probabilities to casep. This is necessary
! because casep is a macro.
MACRO: build-casep-seq ( seq -- quot )
    { [ bswap ] [ bdelete ] [ binsert ] } zip 1quotation ;

! Mutate a dna sequence according to some weights.
! For example,
! "ACGT" { 0.1 0.3 0.6 } mutate
! means swap with 0.1 probability, delete with 0.3 probability,
! and insert with 0.6 probability.
: mutate ( dna-seq weights-seq -- dna-seq' )
    [ [ length random ] keep ] [ build-casep-seq ] bi* casep ;
    inline

! Prettyprint a sequence of weights.
: show-weights ( seq -- )
    "MUTATION PROBABILITIES:" print
    "  swap:   %.2f\n  delete: %.2f\n  insert: %.2f\n\n" vprintf
    ;

: main ( -- )
    verbose? on "ORIGINAL " write 200 <dna> dup show-dna 10
    { 0.2 0.2 0.6 } dup show-weights "MUTATION LOG:" print
    [ mutate ] curry times nl "MUTATED " write show-dna ;

MAIN: main


package main

import (
    "fmt"
    "math/rand"
    "sort"
    "time"
)

const bases = "ACGT"

// 'w' contains the weights out of 300 for each
// of swap, delete or insert in that order.
func mutate(dna string, w [3]int) string {
    le := len(dna)
    // get a random position in the dna to mutate
    p := rand.Intn(le)
    // get a random number between 0 and 299 inclusive
    r := rand.Intn(300)
    bytes := []byte(dna)
    switch {
    case r < w[0]: // swap
        base := bases[rand.Intn(4)]
        fmt.Printf("  Change @%3d %q to %q\n", p, bytes[p], base)
        bytes[p] = base
    case r < w[0]+w[1]: // delete
        fmt.Printf("  Delete @%3d %q\n", p, bytes[p])
        copy(bytes[p:], bytes[p+1:])
        bytes = bytes[0 : le-1]
    default: // insert
        base := bases[rand.Intn(4)]
        bytes = append(bytes, 0)
        copy(bytes[p+1:], bytes[p:])
        fmt.Printf("  Insert @%3d %q\n", p, base)
        bytes[p] = base
    }
    return string(bytes)
}

// Generate a random dna sequence of given length.
func generate(le int) string {
    bytes := make([]byte, le)
    for i := 0; i < le; i++ {
        bytes[i] = bases[rand.Intn(4)]
    }
    return string(bytes)
}

// Pretty print dna and stats.
func prettyPrint(dna string, rowLen int) {
    fmt.Println("SEQUENCE:")
    le := len(dna)
    for i := 0; i < le; i += rowLen {
        k := i + rowLen
        if k > le {
            k = le
        }
        fmt.Printf("%5d: %s\n", i, dna[i:k])
    }
    baseMap := make(map[byte]int) // allows for 'any' base
    for i := 0; i < le; i++ {
        baseMap[dna[i]]++
    }
    var bases []byte
    for k := range baseMap {
        bases = append(bases, k)
    }
    sort.Slice(bases, func(i, j int) bool { // get bases into alphabetic order
        return bases[i] < bases[j]
    })

    fmt.Println("\nBASE COUNT:")
    for _, base := range bases {
        fmt.Printf("    %c: %3d\n", base, baseMap[base])
    }
    fmt.Println("    ------")
    fmt.Println("    Σ:", le)
    fmt.Println("    ======\n")
}

// Express weights as a string.
func wstring(w [3]int) string {
    return fmt.Sprintf("  Change: %d\n  Delete: %d\n  Insert: %d\n", w[0], w[1], w[2])
}

func main() {
    rand.Seed(time.Now().UnixNano())
    dna := generate(250)
    prettyPrint(dna, 50)
    muts := 10
    w := [3]int{100, 100, 100} // use e.g. {0, 300, 0} to choose only deletions
    fmt.Printf("WEIGHTS (ex 300):\n%s\n", wstring(w))
    fmt.Printf("MUTATIONS (%d):\n", muts)
    for i := 0; i < muts; i++ {
        dna = mutate(dna, w)
    }
    fmt.Println()
    prettyPrint(dna, 50)
}


cycles = {"Physical day ", "Emotional day", "Mental day   "}
lengths = {23, 28, 33}
quadrants = {
	{"up and rising", "peak"},
	{"up but falling", "transition"},
	{"down and falling", "valley"},
	{"down but rising", "transition"},
}

function parse_date_string (birthDate)
	local year, month, day = birthDate:match("(%d+)-(%d+)-(%d+)")
	return {year=tonumber(year), month=tonumber(month), day=tonumber(day)}
end

function days_diffeternce (d1, d2)
	if d1.year >= 1970 and d2.year >= 1970 then
		return math.floor(os.difftime(os.time(d2), os.time(d1))/(60*60*24))
	else
		local t1 = math.max (1970-d1.year, 1970-d2.year)
		t1 = math.ceil(t1/4)*4
		d1.year = d1.year + t1
		d2.year = d2.year + t1
		return math.floor(os.difftime(os.time(d2), os.time(d1))/(60*60*24))
	end
end

function biorhythms (birthDate, targetDate)
	local bd = parse_date_string(birthDate)
	local td = parse_date_string(targetDate)
	local days = days_diffeternce (bd, td)

	print('Born: '.. birthDate .. ', Target: ' .. targetDate)
	print("Day: ", days)
	for i=1, #lengths do
		local len = lengths[i]
		local posn = days%len
		local quadrant = math.floor(posn/len*4)+1
		local percent  = math.floor(math.sin(2*math.pi*posn/len)*1000)/10
		local cycle = cycles[i]
		local desc = percent > 95 and "peak" or
			percent < -95 and "valley" or
			math.abs(percent) < 5 and "critical transition" or "other"
		if desc == "other" then
			local t = math.floor(quadrant/4*len)-posn
			local qtrend, qnext = quadrants[quadrant][1], quadrants[quadrant][2]
			desc = percent .. '% (' .. qtrend .. ', next transition in ' .. t ..' days)'
		end
		print(cycle, posn..'/'..len, ': '.. desc)
	end
	print(' ')
end

datePairs = {
	{"1943-03-09", "1972-07-11"},
	{"1809-01-12", "1863-11-19"},
	{"1809-02-12", "1863-11-19"},
	{"2021-02-25", "2022-04-18"},
}

for i=1, #datePairs do
	biorhythms(datePairs[i][1], datePairs[i][2])
end


import Data.List       (group, sort)
import Data.List.Split (chunksOf)
import System.Random   (Random, randomR, random, newStdGen, randoms, getStdRandom)
import Text.Printf     (PrintfArg(..), fmtChar, fmtPrecision, formatString, IsChar(..), printf)

data Mutation = Swap | Delete | Insert deriving (Show, Eq, Ord, Enum, Bounded)
data DNABase = A | C | G | T deriving (Show, Read, Eq, Ord, Enum, Bounded)
type DNASequence = [DNABase]

data Result = Swapped Mutation Int (DNABase, DNABase)
            | InsertDeleted Mutation Int DNABase

instance Random DNABase where
  randomR (a, b) g = case randomR (fromEnum a, fromEnum b) g of (x, y) -> (toEnum x, y)
  random = randomR (minBound, maxBound)

instance Random Mutation where
  randomR (a, b) g = case randomR (fromEnum a, fromEnum b) g of (x, y) -> (toEnum x, y)
  random = randomR (minBound, maxBound)

instance PrintfArg DNABase where
  formatArg x fmt = formatString (show x) (fmt { fmtChar = 's', fmtPrecision = Nothing })

instance PrintfArg Mutation where
  formatArg x fmt = formatString (show x) (fmt { fmtChar = 's', fmtPrecision = Nothing })

instance IsChar DNABase where
  toChar = head . show
  fromChar = read . pure

chunkedDNASequence :: DNASequence -> [(Int, [DNABase])]
chunkedDNASequence = zip [50,100..] . chunksOf 50

baseCounts :: DNASequence -> [(DNABase, Int)]
baseCounts = fmap ((,) . head <*> length) . group . sort

newSequence :: Int -> IO DNASequence
newSequence n = take n . randoms <$> newStdGen

mutateSequence :: DNASequence -> IO (Result, DNASequence)
mutateSequence [] = fail "empty dna sequence"
mutateSequence ds = randomMutation >>= mutate ds
  where
    randomMutation = head . randoms <$> newStdGen
    mutate xs m = do
      i <- randomIndex (length xs)
      case m of
        Swap   -> randomDNA >>= \d -> pure (Swapped Swap i (xs !! pred i, d), swapElement i d xs)
        Insert -> randomDNA >>= \d -> pure (InsertDeleted Insert i d, insertElement i d xs)
        Delete -> pure (InsertDeleted Delete i (xs !! pred i), dropElement i xs)
      where
        dropElement i xs = take (pred i) xs <> drop i xs
        insertElement i e xs = take i xs <> [e] <> drop i xs
        swapElement i a xs = take (pred i) xs <> [a] <> drop i xs
        randomIndex n = getStdRandom (randomR (1, n))
        randomDNA = head . randoms <$> newStdGen

mutate :: Int -> DNASequence -> IO DNASequence
mutate 0 s = pure s
mutate n s = do
  (r, ms) <- mutateSequence s
  case r of
    Swapped m i (a, b)  -> printf "%6s @ %-3d : %s -> %s \n" m i a b
    InsertDeleted m i a -> printf "%6s @ %-3d : %s\n" m i a
  mutate (pred n) ms

main :: IO ()
main = do
  ds <- newSequence 200
  putStrLn "\nInitial Sequence:" >> showSequence ds
  putStrLn "\nBase Counts:" >> showBaseCounts ds
  showSumBaseCounts ds
  ms <- mutate 10 ds
  putStrLn "\nMutated Sequence:" >> showSequence ms
  putStrLn "\nBase Counts:" >> showBaseCounts ms
  showSumBaseCounts ms
  where
    showSequence   = mapM_ (uncurry (printf "%3d: %s\n")) . chunkedDNASequence
    showBaseCounts = mapM_ (uncurry (printf "%s: %3d\n")) . baseCounts
    showSumBaseCounts xs = putStrLn (replicate 6 '-') >> printf "Σ: %d\n\n" (length xs)


targetdate = "1972-07-11";
birthdate = "1943-03-09";
targetdate //= DateObject;
birthdate //= DateObject;

cyclelabels = {"Physical", "Emotional", "Mental"};
cyclelengths = {23, 28, 33};
quadrants = {{"up and rising", "peak"}, {"up but falling",
    "transition"}, {"down and falling", "valley"}, {"down but rising",
     "transition"}};

d = QuantityMagnitude[DateDifference[birthdate, targetdate], "Days"];
Print["Day ", d, ":"];
Do[
 label = cyclelabels[[i]];
 length = cyclelengths[[i]];
 position = Mod[d, length];
 quadrant = Floor[4 (position + 1)/length];
 percentage = Round[100*Sin[2*Pi*position/length]];
 transitiondate =
  DatePlus[targetdate, Floor[(quadrant + 1)/4*length] - position];
 {trend, next} = quadrants[[quadrant]];
 If[percentage > 95,
  description = "peak"
  ,
  If[percentage < -95,
   description = "valley"
   ,
   If[Abs[percentage] < 5,
    description = "critical transition"
    ,
    description =
     ToString[percentage] <> "% (" <> trend <> ", next " <> next <>
      " " <> DateString[transitiondate, "ISODate"] <> ")"
    ]
   ]
  ];
 Print[label <> " day " <> ToString[position] <> ": " <>
   description];
 ,
 {i, 3}
 ]


import math
import strformat
import times

type Cycle {.pure.} = enum Physical, Emotional, Mental

const

  Lengths: array[Cycle, int] = [23, 28, 33]

  Quadrants = [("up and rising", "peak"),
               ("up but falling", "transition"),
               ("down and falling", "valley"),
               ("down but rising", "transition")]

  DateFormat = "YYYY-MM-dd"

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

proc biorythms(birthDate: DateTime; targetDate: DateTime = now()) =
  ## Display biorythms data. Arguments are DateTime values.

  echo fmt"Born {birthDate.format(DateFormat)}, target date {targetDate.format(DateFormat)}"
  let days = (targetDate - birthDate).inDays
  echo "Day ", days

  for cycle, length in Lengths:

    let position = int(days mod length)
    let quadrant = int(4 * position / length)
    let percentage = round(100 * sin(2 * PI * (position / length)), 1)

    var description: string
    if percentage > 95:
      description = "peak"
    elif percentage < -95:
      description = "valley"
    elif abs(percentage) < 5:
      description = "critical transition"
    else:
      let (trend, next) = Quadrants[quadrant]
      let transition = targetDate + initDuration(days = (quadrant + 1) * length div 4 - position)
      description = fmt"{percentage}% ({trend}, next {next} {transition.format(DateFormat)})"

    echo fmt"{cycle} day {position}: {description}"

  echo ""

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

proc biorythms(birthDate, targetDate = "") =
  ## Display biorythms data. Arguments are strings in ISO format year-month-day.
  let date = if targetDate.len == 0: now() else: targetDate.parse(DateFormat)
  biorythms(birthDate.parse(DateFormat), date)

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

when isMainModule:

  biorythms("1943-03-09", "1972-07-11")
  biorythms("1809-01-12", "1863-11-19")
  biorythms("1809-02-12", "1863-11-19")


use strict;
use warnings;
use DateTime;

use constant PI => 2 * atan2(1, 0);

my %cycles = ( 'Physical' => 23, 'Emotional' => 28, 'Mental' => 33 );
my @Q = ( ['up and rising',    'peak'],
          ['up but falling',   'transition'],
          ['down and falling', 'valley'],
          ['down but rising',  'transition']
        );

my $target = DateTime->new(year=>1863, month=>11, day=>19);
my $bday   = DateTime->new(year=>1809, month=> 2, day=>12);

my $days   = $bday->delta_days( $target )->in_units('days');

print "Day $days:\n";
for my $label (sort keys %cycles) {
    my($length) = $cycles{$label};
    my $position = $days % $length;
    my $quadrant = int $position / $length * 4;
    my $percentage = int(sin($position / $length * 2 * PI )*1000)/10;
    my $description;
    if    (    $percentage  >  95) { $description = 'peak' }
    elsif (    $percentage  < -95) { $description = 'valley' }
    elsif (abs($percentage) <   5) { $description = 'critical transition' }
    else {
        my $transition = $target->clone->add( days => (int(($quadrant + 1)/4 * $length) - $position))->ymd;
        my ($trend, $next) = @{$Q[$quadrant]};
        $description = sprintf "%5.1f%% ($trend, next $next $transition)", $percentage;
    }
    printf "%-13s %2d: %s", "$label day\n", $position, $description;
}