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

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

.equ LGHASH, 32                  // result length

/*******************************************/
/* Structures                               */
/********************************************/
/* example structure  variables  */
    .struct  0
var_a:                     // a
    .struct  var_a + 4
var_b:                     // b
    .struct  var_b + 4
var_c:                     // c
    .struct  var_c + 4
var_d:                     // d
    .struct  var_d + 4
var_e:                     // e
    .struct  var_e + 4
var_f:                     // f
    .struct  var_f + 4
var_g:                     // g
    .struct  var_g + 4
var_h:                     // h
    .struct  var_h + 4

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessRosetta:        .asciz "Rosetta code"
szMessTest1:           .asciz "abc"
szMessSup64:           .ascii "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                       .ascii "abcdefghijklmnopqrstuvwxyz"
                       .asciz "1234567890AZERTYUIOP"
szMessTest2:           .asciz "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
szMessFinPgm:          .asciz "Program End ok.\n"
szMessResult:          .asciz "Rosetta code => "
szCarriageReturn:   .asciz "\n"

/* array constantes Hi */
tbConstHi:           .int 0x6A09E667       @ H0
                     .int 0xBB67AE85       @ H1
                     .int 0x3C6EF372       @ H2
                     .int 0xA54FF53A       @ H3
                     .int 0x510E527F       @ H4
                     .int 0x9B05688C       @ H5
                     .int 0x1F83D9AB       @ H6
                     .int 0x5BE0CD19       @ H7
/* array  64 constantes Kt */
tbConstKt:
  .int 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5
  .int 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174
  .int 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da
  .int 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967
  .int 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85
  .int 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070
  .int 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3
  .int 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
iNbBlocs:                    .skip 4
sZoneConv:                   .skip 24
sZoneTrav:                   .skip 1000
.align 8
tbH:                         .skip 4 * 8         @ 8 variables H
tbabcdefgh:                  .skip 4 * 8
tbW:                         .skip 4 * 64        @ 64 words W
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                      @ entry of program

    ldr r0,iAdrszMessRosetta
    //ldr r0,iAdrszMessTest1
    //ldr r0,iAdrszMessTest2
    //ldr r0,iAdrszMessSup64
    bl computeSHA256                         @ call routine SHA1

    ldr r0,iAdrszMessResult
    bl affichageMess                       @ display message

    ldr r0, iAdrtbH
    bl displaySHA1

    ldr r0,iAdrszMessFinPgm
    bl affichageMess                       @ display message

100:                                       @ standard end of the program
    mov r0, #0                             @ return code
    mov r7, #EXIT                          @ request to exit program
    svc #0                                 @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrszMessResult:         .int szMessResult
iAdrszMessRosetta:        .int szMessRosetta
iAdrszMessTest1:          .int szMessTest1
iAdrszMessTest2:          .int szMessTest2
iAdrsZoneTrav:            .int sZoneTrav
iAdrsZoneConv:            .int sZoneConv
iAdrszMessFinPgm:         .int szMessFinPgm
iAdrszMessSup64:          .int szMessSup64
/******************************************************************/
/*     compute SHA1                         */
/******************************************************************/
/* r0 contains the address of the message */
computeSHA256:
    push {r1-r12,lr}         @ save  registres
    ldr r1,iAdrsZoneTrav
    mov r2,#0                @ counter length
debCopy:                     @ copy string in work area
    ldrb r3,[r0,r2]
    strb r3,[r1,r2]
    cmp r3,#0
    addne r2,r2,#1
    bne debCopy
    lsl r6,r2,#3             @ initial message length in bits
    mov r3,#0b10000000       @ add bit 1 at end of string
    strb r3,[r1,r2]
    add r2,r2,#1             @ length in bytes
    lsl r4,r2,#3             @ length in bits
    mov r3,#0
addZeroes:
    lsr r5,r2,#6
    lsl r5,r5,#6
    sub r5,r2,r5
    cmp r5,#56
    beq storeLength          @ yes -> end add
    strb r3,[r1,r2]          @ add zero at message end
    add r2,#1                @ increment lenght bytes
    add r4,#8                @ increment length in bits
    b addZeroes
storeLength:
    add r2,#4                @ add four bytes
    rev r6,r6                @ inversion bits initials message length
    str r6,[r1,r2]           @ and store at end

    ldr r7,iAdrtbConstHi     @ constantes H address
    ldr r4,iAdrtbH           @ start area H
    mov r5,#0
loopConst:                   @ init array H with start constantes
    ldr r6,[r7,r5,lsl #2]    @ load constante
    str r6,[r4,r5,lsl #2]    @ and store
    add r5,r5,#1
    cmp r5,#8
    blt loopConst
                             @ split into block of 64 bytes
    add r2,#4                @  TODO : à revoir
    lsr r4,r2,#6             @ blocks number
    ldr r0,iAdriNbBlocs
    str r4,[r0]              @ save block maxi
    mov r7,#0                @ n° de block et r1 contient l adresse zone de travail
loopBlock:                   @ begin loop of each block of 64 bytes
    mov r0,r7
    bl inversion             @ inversion each word because little indian
    ldr r3,iAdrtbW           @ working area W address
    mov r6,#0                @ indice t
                             /* r2  address begin each block */
    ldr r1,iAdrsZoneTrav
    add r2,r1,r7,lsl #6      @  compute block begin  indice * 4 * 16
    //vidregtit avantloop
    //mov r0,r2
    //vidmemtit  verifBloc r0 10
loopPrep:                    @ loop for expand 80 words
    cmp r6,#15               @
    bgt expand1
    ldr r0,[r2,r6,lsl #2]    @ load byte message
    str r0,[r3,r6,lsl #2]    @ store in first 16 block
    b expandEnd

expand1:
    sub r8,r6,#2
    ldr r9,[r3,r8,lsl #2]
    ror r10,r9,#17           @ fonction e1 (256)
    ror r11,r9,#19
    eor r10,r10,r11
    lsr r11,r9,#10
    eor r10,r10,r11
    sub r8,r6,#7
    ldr r9,[r3,r8,lsl #2]
    add r9,r9,r10            @ + w - 7
    sub r8,r6,#15
    ldr r10,[r3,r8,lsl #2]
    ror r11,r10,#7          @ fonction e0 (256)
    ror r12,r10,#18
    eor r11,r12
    lsr r12,r10,#3
    eor r10,r11,r12
    add r9,r9,r10
    sub r8,r6,#16
    ldr r11,[r3,r8,lsl #2]
    add r9,r9,r11

    str r9,[r3,r6,lsl #2]
expandEnd:
    add r6,r6,#1
    cmp r6,#64                 @ 64 words ?
    blt loopPrep               @ and loop

    /* COMPUTING THE MESSAGE DIGEST */
    /* r1  area H constantes address */
    /* r3  working area W address  */
    /* r5  address constantes K   */
    /* r6  counter t */
    /* r7  block counter */
    /* r8  addresse variables a b c d e f g h  */
    //ldr r0,iAdrtbW
    //vidmemtit  verifW80 r0 20
                               @ init variable a b c d e f g h
    ldr r0,iAdrtbH
    ldr r8,iAdrtbabcdefgh
    mov r1,#0
loopInita:
    ldr r9,[r0,r1,lsl #2]
    str r9,[r8,r1,lsl #2]
    add r1,r1,#1
    cmp r1,#8
    blt loopInita

    ldr r1,iAdrtbConstHi
    ldr r5,iAdrtbConstKt
    mov r6,#0
loop64T:                     @ begin loop 64 t
    ldr r9,[r8,#var_h]
    ldr r10,[r8,#var_e]      @ calcul T1
    ror r11,r10,#6           @ fonction sigma 1
    ror r12,r10,#11
    eor r11,r12
    ror r12,r10,#25
    eor r11,r12
    add r9,r9,r11             @ h + sigma1 (e)
    ldr r0,[r8,#var_f]        @  fonction ch  x and y xor (non x and z)
    ldr r4,[r8,#var_g]
    and r11,r10,r0
    mvn r12,r10
    and r12,r12,r4
    eor r11,r12
    add r9,r9,r11             @ h + sigma1 (e) + ch (e,f,g)
    ldr r0,[r5,r6,lsl #2]     @ load constantes k0
    add r9,r9,r0
    ldr r0,[r3,r6,lsl #2]     @ Wt
    add r9,r9,r0
                              @ calcul T2
    ldr r10,[r8,#var_a]       @ fonction sigma 0
    ror r11,r10,#2
    ror r12,r10,#13
    eor r11,r11,r12
    ror r12,r10,#22
    eor r11,r11,r12
    ldr r2,[r8,#var_b]
    ldr r4,[r8,#var_c]
                              @ fonction maj x and y xor x and z xor y and z
    and r12,r10,r2
    and r0,r10,r4
    eor r12,r12,r0
    and r0,r2,r4
    eor r12,r12,r0            @
    add r12,r12,r11           @ T2
                              @ compute variables
    ldr r4,[r8,#var_g]
    str r4,[r8,#var_h]
    ldr r4,[r8,#var_f]
    str r4,[r8,#var_g]
    ldr r4,[r8,#var_e]
    str r4,[r8,#var_f]
    ldr r4,[r8,#var_d]
    add r4,r4,r9              @ add T1
    str r4,[r8,#var_e]
    ldr r4,[r8,#var_c]
    str r4,[r8,#var_d]
    ldr r4,[r8,#var_b]
    str r4,[r8,#var_c]
    ldr r4,[r8,#var_a]
    str r4,[r8,#var_b]
    add r4,r9,r12             @ add T1 T2
    str r4,[r8,#var_a]
    mov r0,r8

    add r6,r6,#1              @ increment t
    cmp r6,#64
    blt loop64T
                              @ End block
    ldr r0,iAdrtbH            @ start area H
    mov r10,#0
loopStoreH:
    ldr r9,[r8,r10,lsl #2]
    ldr r3,[r0,r10,lsl #2]
    add r3,r9
    str r3,[r0,r10,lsl #2]    @ store variables in H0
    add r10,r10,#1
    cmp r10,#8
    blt loopStoreH
                              @ other bloc
    add r7,#1                 @ increment block
    ldr r0,iAdriNbBlocs
    ldr r4,[r0]               @ restaur maxi block
    cmp r7,r4                 @ maxi ?

    blt loopBlock             @  loop other block

    mov r0,#0                 @ routine OK
100:
    pop {r1-r12,lr}           @ restaur registers
    bx lr                     @ return
iAdrtbConstHi:            .int tbConstHi
iAdrtbConstKt:            .int tbConstKt
iAdrtbH:                  .int tbH
iAdrtbW:                  .int tbW
iAdrtbabcdefgh:           .int tbabcdefgh
iAdriNbBlocs:             .int iNbBlocs
/******************************************************************/
/*     inversion des mots de 32 bits d un bloc                    */
/******************************************************************/
/* r0 contains N° block   */
inversion:
    push {r1-r3,lr}                                 @ save registers
    ldr r1,iAdrsZoneTrav
    add r1,r0,lsl #6           @ debut du bloc
    mov r2,#0
1:                                                  @ start loop
    ldr r3,[r1,r2,lsl #2]
    rev r3,r3
    str r3,[r1,r2,lsl #2]
    add r2,r2,#1
    cmp r2,#16
    blt 1b
100:
    pop {r1-r3,lr}                                  @ restaur registres
    bx lr                                           @return
/******************************************************************/
/*     display hash  SHA1                         */
/******************************************************************/
/* r0 contains the address of hash  */
displaySHA1:
    push {r1-r3,lr}                @ save  registres
    mov r3,r0
    mov r2,#0
1:
    ldr r0,[r3,r2,lsl #2]          @ load 4 bytes
    //rev r0,r0                      @ reverse bytes
    ldr r1,iAdrsZoneConv
    bl conversion16                @ conversion hexa
    ldr r0,iAdrsZoneConv
    bl affichageMess
    add r2,r2,#1
    cmp r2,#LGHASH / 4
    blt 1b                         @ and loop
    ldr r0,iAdrszCarriageReturn
    bl affichageMess               @ display message
100:
    pop {r1-r3,lr}                 @ restaur registers
    bx lr                          @ return
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


str := "Rosetta code"
MsgBox, % "File:`n" (file) "`n`nSHA-256:`n" FileSHA256(file)

; SHA256 ============================================================================
SHA256(string, encoding = "utf-8")
{
    return CalcStringHash(string, 0x800c, encoding)
}

; CalcAddrHash ======================================================================
CalcAddrHash(addr, length, algid, byref hash = 0, byref hashlength = 0)
{
    static h := [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "A", "B", "C", "D", "E", "F"]
    static b := h.minIndex()
    o := ""
    if (DllCall("advapi32\CryptAcquireContext", "Ptr*", hProv, "Ptr", 0, "Ptr", 0, "UInt", 24, "UInt", 0xF0000000))
    {
        if (DllCall("advapi32\CryptCreateHash", "Ptr", hProv, "UInt", algid, "UInt", 0, "UInt", 0, "Ptr*", hHash))
        {
            if (DllCall("advapi32\CryptHashData", "Ptr", hHash, "Ptr", addr, "UInt", length, "UInt", 0))
            {
                if (DllCall("advapi32\CryptGetHashParam", "Ptr", hHash, "UInt", 2, "Ptr", 0, "UInt*", hashlength, "UInt", 0))
                {
                    VarSetCapacity(hash, hashlength, 0)
                    if (DllCall("advapi32\CryptGetHashParam", "Ptr", hHash, "UInt", 2, "Ptr", &hash, "UInt*", hashlength, "UInt", 0))
                    {
                        loop, % hashlength
                        {
                            v := NumGet(hash, A_Index - 1, "UChar")
                            o .= h[(v >> 4) + b] h[(v & 0xf) + b]
                        }
                    }
                }
            }
            DllCall("advapi32\CryptDestroyHash", "Ptr", hHash)
        }
        DllCall("advapi32\CryPtreleaseContext", "Ptr", hProv, "UInt", 0)
    }
    return o
}

; CalcStringHash ====================================================================
CalcStringHash(string, algid, encoding = "utf-8", byref hash = 0, byref hashlength = 0)
{
    chrlength := (encoding = "cp1200" || encoding = "utf-16") ? 2 : 1
    length := (StrPut(string, encoding) - 1) * chrlength
    VarSetCapacity(data, length, 0)
    StrPut(string, &data, floor(length / chrlength), encoding)
    return CalcAddrHash(&data, length, algid, hash, hashlength)
}


{
    ("echo -n " $0 " | sha256sum") | getline sha;
    gsub(/[^0-9a-zA-Z]/, "", sha);
    print sha;
}


PRAGMA INCLUDE <openssl/sha.h>
PRAGMA LDFLAGS -lcrypto

OPTION MEMTYPE unsigned char

DECLARE result TYPE unsigned char*

result = SHA256("Rosetta code", 12, 0)

FOR i = 0 TO SHA256_DIGEST_LENGTH-1
    PRINT PEEK(result+i) FORMAT "%02x"
NEXT

PRINT


      PRINT FNsha256("Rosetta code")
      END

      DEF FNsha256(message$)
      LOCAL buflen%, buffer%, hcont%, hprov%, hhash%, hash$, i%
      CALG_SHA_256 = &800C
      HP_HASHVAL = 2
      CRYPT_NEWKEYSET = 8
      PROV_RSA_AES = 24
      buflen% = 128
      DIM buffer% LOCAL buflen%-1
      SYS "CryptAcquireContext", ^hcont%, 0, \
      \   "Microsoft Enhanced RSA and AES Cryptographic Provider", \
      \   PROV_RSA_AES, CRYPT_NEWKEYSET
      SYS "CryptAcquireContext", ^hprov%, 0, 0, PROV_RSA_AES, 0
      SYS "CryptCreateHash", hprov%, CALG_SHA_256, 0, 0, ^hhash%
      SYS "CryptHashData", hhash%, message$, LEN(message$), 0
      SYS "CryptGetHashParam", hhash%, HP_HASHVAL, buffer%, ^buflen%, 0
      SYS "CryptDestroyHash", hhash%
      SYS "CryptReleaseContext", hprov%
      SYS "CryptReleaseContext", hcont%
      FOR i% = 0 TO buflen%-1
        hash$ += RIGHT$("0" + STR$~buffer%?i%, 2)
      NEXT
      = hash$


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

int main (void) {
	const char *s = "Rosetta code";
	unsigned char *d = SHA256(s, strlen(s), 0);

	int i;
	for (i = 0; i < SHA256_DIGEST_LENGTH; i++)
		printf("%02x", d[i]);
	putchar('\n');

	return 0;
}


using System;
using System.Security.Cryptography;
using System.Text;
using Microsoft.VisualStudio.TestTools.UnitTesting;

namespace RosettaCode.SHA256
{
    [TestClass]
    public class SHA256ManagedTest
    {
        [TestMethod]
        public void TestComputeHash()
        {
            var buffer = Encoding.UTF8.GetBytes("Rosetta code");
            var hashAlgorithm = new SHA256Managed();
            var hash = hashAlgorithm.ComputeHash(buffer);
            Assert.AreEqual(
                "76-4F-AF-5C-61-AC-31-5F-14-97-F9-DF-A5-42-71-39-65-B7-85-E5-CC-2F-70-7D-64-68-D7-D1-12-4C-DF-CF",
                BitConverter.ToString(hash));
        }
    }
}


#include <iostream>
#include <cryptopp/filters.h>
#include <cryptopp/hex.h>
#include <cryptopp/sha.h>

int main(int argc, char **argv){
	CryptoPP::SHA256 hash;
	std::string digest;
	std::string message = "Rosetta code";

	CryptoPP::StringSource s(message, true,
			new CryptoPP::HashFilter(hash,
				new CryptoPP::HexEncoder(
					new CryptoPP::StringSink(digest))));

	std::cout << digest << std::endl;

	return 0;
}


USER>set hash=$System.Encryption.SHAHash(256, "Rosetta code")
USER>zzdump hash
0000: 76 4F AF 5C 61 AC 31 5F 14 97 F9 DF A5 42 71 39
0010: 65 B7 85 E5 CC 2F 70 7D 64 68 D7 D1 12 4C DF CF


(use 'pandect.core)
(sha256 "Rosetta code")


(ql:quickload 'ironclad)
(defun sha-256 (str)
  (ironclad:byte-array-to-hex-string
    (ironclad:digest-sequence :sha256
                              (ironclad:ascii-string-to-byte-array str))))

(sha-256 "Rosetta code")


require "openssl"
puts OpenSSL::Digest.new("SHA256").update("Rosetta code")


void main() {
    import std.stdio, std.digest.sha;

    writefln("%-(%02x%)", "Rosetta code".sha256Of);
}


program SHA_256;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  DCPsha256;

function SHA256(const Str: string): string;
var
  HashDigest: array of byte;
  d: Byte;
begin
  Result := '';
  with TDCP_sha256.Create(nil) do
  begin
    Init;
    UpdateStr(Str);
    SetLength(HashDigest, GetHashSize div 8);
    final(HashDigest[0]);
    for d in HashDigest do
      Result := Result + d.ToHexString(2);
    Free;
  end;
end;

begin
  Writeln(SHA256('Rosetta code'));
  readln;

end.


PrintLn( HashSHA256.HashData('Rosetta code') );


(secure-hash 'sha256 "Rosetta code")  ;; as string of hex digits


10> Binary =  crypto:hash( sha256, "Rosetta code" ).
11> lists:append( [erlang:integer_to_list(X, 16) || <<X:8/integer>> <= Binary] ).
"764FAF5C61AC315F1497F9DFA542713965B785E5CC2F707D6468D7D1124CDFCF"


open System.Security.Cryptography
open System.Text

"Rosetta code"
|> Encoding.ASCII.GetBytes
|> (new SHA256Managed()).ComputeHash
|> System.BitConverter.ToString
|> printfn "%s"


USING: checksums checksums.sha io math.parser ;

"Rosetta code" sha-256 checksum-bytes bytes>hex-string print


c-library crypto

s" ssl" add-lib
s" crypto" add-lib

\c #include <openssl/sha.h>
c-function sha256 SHA256 a n a -- a

end-c-library

: 2h.  ( n1 -- )  base @ swap hex s>d <# # # #> type base ! ;

: .digest ( a -- )
    32 bounds do  i [email protected] 2h.  loop space ;

s" Rosetta code" 0 sha256 .digest cr
bye


program rosettaCodeSHA256;

uses
  SysUtils, DCPsha256;

var
  ros: String;
  sha256 : TDCP_sha256;
  digest : array[0..63] of byte;
  i: Integer;
  output: String;
begin
  ros := 'Rosetta code';

  sha256 := TDCP_sha256.Create(nil);
  sha256.init;
  sha256.UpdateStr(ros);
  sha256.Final(digest);

  output := '';

  for i := 0 to 31 do begin
    output := output + intToHex(digest[i], 2);
  end;

  writeln(lowerCase(output));

end.


' version 20-10-2016
' FIPS PUB 180-4
' compile with: fbc -s console

Function SHA_256(test_str As String) As String

  #Macro Ch (x, y, z)
    (((x) And (y)) Xor ((Not (x)) And z))
  #EndMacro

  #Macro Maj (x, y, z)
    (((x) And (y)) Xor ((x) And (z)) Xor ((y) And (z)))
  #EndMacro

  #Macro sigma0 (x)
    (((x) Shr 2 Or (x) Shl 30) Xor ((x) Shr 13 Or (x) Shl 19) Xor ((x) Shr 22 Or (x) Shl 10))
  #EndMacro

  #Macro sigma1 (x)
    (((x) Shr 6 Or (x) Shl 26) Xor ((x) Shr 11 Or (x) Shl 21) Xor ((x) Shr 25 Or (x) Shl 7))
  #EndMacro

  #Macro sigma2 (x)
    (((x) Shr 7 Or (x) Shl 25) Xor ((x) Shr 18 Or (x) Shl 14) Xor ((x) Shr 3))
  #EndMacro

  #Macro sigma3 (x)
    (((x) Shr 17 Or (x) Shl 15) Xor ((x) Shr 19 Or (x) Shl 13) Xor ((x) Shr 10))
  #EndMacro

  Dim As String message = test_str   ' strings are passed as ByRef's

  Dim As Long i, j
  Dim As UByte Ptr ww1
  Dim As UInteger<32> Ptr ww4

  Dim As ULongInt l = Len(message)
  ' set the first bit after the message to 1
  message = message + Chr(1 Shl 7)
  ' add one char to the length
  Dim As ULong padding = 64 - ((l +1) Mod (512 \ 8)) ' 512 \ 8 = 64 char.

  ' check if we have enough room for inserting the length
  If padding < 8 Then padding = padding + 64

  message = message + String(padding, Chr(0))   ' adjust length
  Dim As ULong l1 = Len(message)                ' new length

  l = l * 8    ' orignal length in bits
  ' create ubyte ptr to point to l ( = length in bits)
  Dim As UByte Ptr ub_ptr = Cast(UByte Ptr, @l)

  For i = 0 To 7  'copy length of message to the last 8 bytes
    message[l1 -1 - i] = ub_ptr[i]
  Next

  'table of constants
  Dim As UInteger<32> K(0 To ...) = _
  { &H428a2f98, &H71374491, &Hb5c0fbcf, &He9b5dba5, &H3956c25b, &H59f111f1, _
    &H923f82a4, &Hab1c5ed5, &Hd807aa98, &H12835b01, &H243185be, &H550c7dc3, _
    &H72be5d74, &H80deb1fe, &H9bdc06a7, &Hc19bf174, &He49b69c1, &Hefbe4786, _
    &H0fc19dc6, &H240ca1cc, &H2de92c6f, &H4a7484aa, &H5cb0a9dc, &H76f988da, _
    &H983e5152, &Ha831c66d, &Hb00327c8, &Hbf597fc7, &Hc6e00bf3, &Hd5a79147, _
    &H06ca6351, &H14292967, &H27b70a85, &H2e1b2138, &H4d2c6dfc, &H53380d13, _
    &H650a7354, &H766a0abb, &H81c2c92e, &H92722c85, &Ha2bfe8a1, &Ha81a664b, _
    &Hc24b8b70, &Hc76c51a3, &Hd192e819, &Hd6990624, &Hf40e3585, &H106aa070, _
    &H19a4c116, &H1e376c08, &H2748774c, &H34b0bcb5, &H391c0cb3, &H4ed8aa4a, _
    &H5b9cca4f, &H682e6ff3, &H748f82ee, &H78a5636f, &H84c87814, &H8cc70208, _
    &H90befffa, &Ha4506ceb, &Hbef9a3f7, &Hc67178f2 }

  Dim As UInteger<32> h0 = &H6a09e667
  Dim As UInteger<32> h1 = &Hbb67ae85
  Dim As UInteger<32> h2 = &H3c6ef372
  Dim As UInteger<32> h3 = &Ha54ff53a
  Dim As UInteger<32> h4 = &H510e527f
  Dim As UInteger<32> h5 = &H9b05688c
  Dim As UInteger<32> h6 = &H1f83d9ab
  Dim As UInteger<32> h7 = &H5be0cd19
  Dim As UInteger<32> a, b, c, d, e, f, g, h
  Dim As UInteger<32> t1, t2, w(0 To 63)

  For j = 0 To (l1 -1) \ 64 ' split into block of 64 bytes
    ww1 = Cast(UByte Ptr, @message[j * 64])
    ww4 = Cast(UInteger<32> Ptr, @message[j * 64])

    For i = 0 To 60 Step 4  'little endian -> big endian
      Swap ww1[i   ], ww1[i +3]
      Swap ww1[i +1], ww1[i +2]
    Next

    For i = 0 To 15    ' copy the 16 32bit block into the array
      W(i) = ww4[i]
    Next

    For i = 16 To 63   ' fill the rest of the array
      w(i) = sigma3(W(i -2)) + W(i -7) + sigma2(W(i -15)) + W(i -16)
    Next

    a = h0 : b = h1 : c = h2 : d = h3 : e = h4 : f = h5 : g = h6 : h = h7

    For i = 0 To 63
      t1 = h + sigma1(e) + Ch(e, f, g) + K(i) + W(i)
      t2 = sigma0(a) + Maj(a, b, c)
      h = g : g = f : f = e
      e = d + t1
      d = c : c = b : b = a
      a = t1 + t2
    Next

    h0 += a : h1 += b : h2 += c : h3 += d
    h4 += e : h5 += f : h6 += g : h7 += h

  Next j

  Dim As String answer  = Hex(h0, 8) + Hex(h1, 8) + Hex(h2, 8) + Hex(h3, 8)
                answer += Hex(h4, 8) + Hex(h5, 8) + Hex(h6, 8) + Hex(h7, 8)

  Return LCase(answer)

End Function

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

Dim As String test = "Rosetta code"
Print test; " => "; SHA_256(test)

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


native java.security.MessageDigest

def sha256Java( message ) = map( a -> format('%02x', a), list(MessageDigest.getInstance('SHA-256').digest(message.getBytes('UTF-8'))) ).mkString()


[indent=4]
/*
   SHA-256 in Genie

   valac SHA-256.gs
   ./SHA-256
*/

init
    var msg = "Rosetta code"
    var digest = Checksum.compute_for_string(ChecksumType.SHA256, msg, -1)
    print msg
    print digest

    assert(digest == "764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf")


package main

import (
    "crypto/sha256"
    "fmt"
    "log"
)

func main() {
    h := sha256.New()
    if _, err := h.Write([]byte("Rosetta code")); err != nil {
        log.Fatal(err)
    }
    fmt.Printf("%x\n", h.Sum(nil))
}


def sha256Hash = { text ->
    java.security.MessageDigest.getInstance("SHA-256").digest(text.bytes)
            .collect { String.format("%02x", it) }.join('')
}


$var = "Rosetta code";
echo sha2($var, 256);


import Data.Char (ord)
import Crypto.Hash.SHA256 (hash)
import Data.ByteString (unpack, pack)
import Text.Printf (printf)

main = putStrLn $                     -- output to terminal
       concatMap (printf "%02x") $    -- to hex string
       unpack $                       -- to array of Word8
       hash $                         -- SHA-256 hash to ByteString
       pack $                         -- to ByteString
       map (fromIntegral.ord)         -- to array of Word8
       "Rosetta code"


import haxe.crypto.Sha256;

class Main {
  static function main() {
    var sha256 = Sha256.encode("Rosetta code");
    Sys.println(sha256);
  }
}


require '~addons/ide/qt/qt.ijs'
getsha256=: 'sha256'&gethash_jqtide_


const crypto = require('crypto');

const msg = 'Rosetta code';
const hash = crypto.createHash('sha256').update(msg).digest('hex');

console.log(hash);


/* SHA-256 hash in Jsish */
var str = 'Rosetta code';
puts(Util.hash(str, {type:'sha256'}));

/*
=!EXPECTSTART!=
764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf
=!EXPECTEND!=
*/


msg = "Rosetta code"

using Nettle
digest = hexdigest("sha256", msg)

# native
using SHA
digest1 = join(num2hex.(sha256(msg)))

@assert digest == digest1


// version 1.0.6

import java.security.MessageDigest

fun main(args: Array<String>) {
    val text  = "Rosetta code"
    val bytes = text.toByteArray()
    val md = MessageDigest.getInstance("SHA-256")
    val digest = md.digest(bytes)
    for (byte in digest) print("%02x".format(byte))
    println()
}


// The following will return a list of all the cipher
// algorithms supported by the installation of Lasso
cipher_list

// With a -digest parameter the method will limit the returned list
// to all of the digest algorithms supported by the installation of Lasso
cipher_list(-digest)

// return the SHA-256 digest. Dependant on SHA-256 being an available digest method
cipher_digest('Rosetta Code', -digest='SHA-256',-hex=true)


#!/usr/bin/lua

require "sha2"

print(sha2.sha256hex("Rosetta code"))


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

import java.security.MessageDigest

SHA256('Rosetta code', '764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf')

return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method SHA256(messageText, verifyCheck) public static

  algorithm   = 'SHA-256'
  digestSum = getDigest(messageText, algorithm)

  say '<Message>'messageText'</Message>'
  say Rexx('<'algorithm'>').right(12) || digestSum'</'algorithm'>'
  say Rexx('<Verify>').right(12) || verifyCheck'</Verify>'
  if digestSum == verifyCheck then say algorithm 'Confirmed'
                              else say algorithm 'Failed'

  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method getDigest(messageText = Rexx, algorithm = Rexx 'MD5', encoding = Rexx 'UTF-8', lowercase = boolean 1) public static returns Rexx

  algorithm = algorithm.upper
  encoding  = encoding.upper

  message      = String(messageText)
  messageBytes = byte[]
  digestBytes  = byte[]
  digestSum    = Rexx ''

  do
    messageBytes = message.getBytes(encoding)
    md = MessageDigest.getInstance(algorithm)
    md.update(messageBytes)
    digestBytes = md.digest

    loop b_ = 0 to digestBytes.length - 1
      bb = Rexx(digestBytes[b_]).d2x(2)
      if lowercase then digestSum = digestSum || bb.lower
                   else digestSum = digestSum || bb.upper
      end b_
  catch ex = Exception
    ex.printStackTrace
  end

  return digestSum


;; using the crypto module from http://www.newlisp.org/code/modules/crypto.lsp.html
;; (import native functions from the crypto library, provided by OpenSSL)
(module "crypto.lsp")
(crypto:sha256 "Rosetta Code")


import nimcrypto

echo sha256.digest("Rosetta code")


MODULE SHA256;
IMPORT
  Crypto:SHA256,
  Crypto:Utils,
  Strings,
  Out;
VAR
  h: SHA256.Hash;
  str: ARRAY 128 OF CHAR;

BEGIN
  h := SHA256.NewHash();
  h.Initialize;
  str := "Rosetta code";
  h.Update(str,0,Strings.Length(str));
  h.GetHash(str,0);
  Out.String("SHA256: ");Utils.PrintHex(str,0,h.size);Out.Ln
END SHA256.


class ShaHash {
   function : Main(args : String[]) ~ Nil {
      hash:= Encryption.Hash->SHA256("Rosetta code"->ToByteArray());
      str := hash->ToHexString()->ToLower();
      str->PrintLine();
      str->Equals("764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf")->PrintLine();
   }
}


clang -o rosetta_sha256 rosetta_sha256.m /System/Library/Frameworks/Cocoa.framework/Cocoa


let () =
  let s = "Rosetta code" in
  let digest = Sha256.string s in
  print_endline (Sha256.to_hex digest)


sha256(s)=extern("echo \"Str(`echo -n '"Str(s)"'|sha256sum|cut -d' ' -f1`)\"")


#!/usr/bin/perl
use strict ;
use warnings ;
use Digest::SHA qw( sha256_hex ) ;

my $digest = sha256_hex my $phrase = "Rosetta code" ;
print "SHA-256('$phrase'): $digest\n" ;


include builtins\sha256.e

function asHex(string s)
string res = ""
    for i=1 to length(s) do
        res &= sprintf("%02X",s[i])
    end for
    return res
end function

?asHex(sha256("Rosetta code"))


<?php
echo hash('sha256', 'Rosetta code');


string input = "Rosetta code";
string out = Crypto.SHA256.hash(input);
write( String.string2hex(out) +"\n");


Set-Content -Value "Rosetta code" -Path C:\Colors\blue.txt -NoNewline -Force
Get-FileHash -Path C:\Colors\blue.txt -Algorithm SHA256


a$="Rosetta code"
bit.i= 256

UseSHA2Fingerprint() : b$=StringFingerprint(a$, #PB_Cipher_SHA2, bit)

OpenConsole()
Print("[SHA2 "+Str(bit)+" bit] Text: "+a$+" ==> "+b$)
Input()


>>> import hashlib
>>> hashlib.sha256( "Rosetta code".encode() ).hexdigest()
'764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf'
>>>


library(digest)

input <- "Rosetta code"
cat(digest(input, algo = "sha256", serialize = FALSE), "\n")


#lang racket/base

;; define a quick SH256 FFI interface, similar to the Racket's default
;; SHA1 interface
(require ffi/unsafe ffi/unsafe/define openssl/libcrypto
         (only-in openssl/sha1 bytes->hex-string))
(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))

;; use the defined wrapper to solve the task
(displayln (sha256 #"Rosetta code"))


# Project: SHA-256

load "stdlib.ring"
str = "Rosetta code"
see "String: " + str + nl
see "SHA-256: "
see sha256(str) + nl


require 'digest/sha2'
puts Digest::SHA256.hexdigest('Rosetta code')


use sha2::{Digest, Sha256};

fn hex_string(input: &[u8]) -> String {
    input.as_ref().iter().map(|b| format!("{:x}", b)).collect()
}

fn main() {
    // create a Sha256 object
    let mut hasher = Sha256::new();

    // write input message
    hasher.update(b"Rosetta code");

    // read hash digest and consume hasher
    let result = hasher.finalize();

    let hex = hex_string(&result);

    assert_eq!(
        hex,
        "764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf"
    );

    println!("{}", hex);
}


object RosettaSHA256 extends App {

  def MD5(s: String): String = {
    // Besides "MD5", "SHA-256", and other hashes are available
    val m = java.security.MessageDigest.getInstance("SHA-256").digest(s.getBytes("UTF-8"))
    m.map("%02x".format(_)).mkString
  }

  assert(MD5("Rosetta code") == "764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf")
  println("Successfully completed without errors.")
}


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

const proc: main is func
  begin
    writeln(hex(sha256("Rosetta code")));
  end func;


var sha = frequire('Digest::SHA');
say sha.sha256_hex('Rosetta code');


(SHA256 new hashStream: 'Rosetta code' readStream) hex.


package require sha256

puts [sha2::sha256 -hex "Rosetta code"]


import crypto.sha256

fn main() {
    println("${sha256.hexhash('Rosetta code')}")

    mut h := sha256.new()
    h.write('Rosetta code'.bytes()) ?
    println('${h.checksum().map(it.hex()).join('')}')
}


import "/crypto" for Sha256
import "/fmt" for Fmt

var strings = [
    "",
    "a",
    "abc",
    "message digest",
    "abcdefghijklmnopqrstuvwxyz",
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789",
    "12345678901234567890123456789012345678901234567890123456789012345678901234567890",
    "The quick brown fox jumps over the lazy dog",
    "The quick brown fox jumps over the lazy cog",
    "Rosetta code"
]

for (s in strings) {
    var hash = Sha256.digest(s)
    Fmt.print("$s <== '$0s'", hash, s)
}


with Ada.Text_IO;

procedure Set_Right_Bits is

   type Bit_Number is new Positive range 1 .. 10_000;
   type Bit        is new Boolean;
   type Bit_Collection is array (Bit_Number range <>) of Bit
     with Pack;

   function Right_Adjacent (B : Bit_Collection;
                            N : Natural) return Bit_Collection
   is
      Result : Bit_Collection := B;
      Mask   : Bit_Collection := B;
   begin
      for A in 1 .. N loop
         Mask   := False & Mask (Mask'First .. Mask'Last - 1);
         --  Shift Mask by appending False/0 in front of slice.

         Result := Result or Mask;
      end loop;
      return Result;
   end Right_Adjacent;

   procedure Put (Collection : Bit_Collection) is
      use Ada.Text_IO;
   begin
      for Bit of Collection loop
         Put ((if Bit then '1' else '0'));
      end loop;
   end Put;

   function Value (Item : String) return Bit_Collection
   is
      Length : constant Bit_Number := Item'Length;
      Result : Bit_Collection (1 .. Length);
      Index  : Natural := Item'First;
   begin
      for R of Result loop
         R := (case Item (Index) is
                  when '0' | 'F' | 'f' => False,
                  when '1' | 'T' | 't' => True,
                  when others =>
                     raise Constraint_Error with "invalid input");
         Index := Index + 1;
      end loop;
      return Result;
   end Value;

   procedure Show (Bit_String : String; N : Natural)
   is
      B      : constant Bit_Collection := Value (Bit_String);
      R      : constant Bit_Collection := Right_Adjacent (B, N);
      Prefix : constant String         := "        ";
      use Ada.Text_IO;
   begin
      Put ("n =");          Put (N'Image);
      Put ("; Width e =");  Put (Bit_String'Length'Image);
      Put (":");            New_Line;
      Put (Prefix);  Put ("Input B: ");  Put (B);  New_Line;
      Put (Prefix);  Put ("Result : ");  Put (R);  New_Line;
      New_Line;
   end Show;

begin
   Show ("1000", 2);
   Show ("0100", 2);
   Show ("0010", 2);
   Show ("0000", 2);

   Show ("010000000000100000000010000000010000000100000010000010000100010010", 0);
   Show ("010000000000100000000010000000010000000100000010000010000100010010", 1);
   Show ("010000000000100000000010000000010000000100000010000010000100010010", 2);
   Show ("010000000000100000000010000000010000000100000010000010000100010010", 3);
end Set_Right_Bits;


USING: formatting io kernel math math.parser math.ranges
sequences ;

: set-rab ( n b -- result )
    [0,b] [ neg shift ] with [ bitor ] map-reduce ;

:: show ( n b e -- )
    b e "n = %d; width = %d\n" printf
    n n b set-rab [ >bin e CHAR: 0 pad-head print ] [email protected] ;

{ 0b1000 0b0100 0b0010 0b0000 } [ 2 4 show nl ] each
0x10020080404082112 4 <iota> [ 66 show nl ] with each


package main

import (
    "fmt"
    "strings"
)

type test struct {
    bs string
    n  int
}

func setRightBits(bits []byte, e, n int) []byte {
    if e == 0 || n <= 0 {
        return bits
    }
    bits2 := make([]byte, len(bits))
    copy(bits2, bits)
    for i := 0; i < e-1; i++ {
        c := bits[i]
        if c == 1 {
            j := i + 1
            for j <= i+n && j < e {
                bits2[j] = 1
                j++
            }
        }
    }
    return bits2
}

func main() {
    b := "010000000000100000000010000000010000000100000010000010000100010010"
    tests := []test{
        test{"1000", 2}, test{"0100", 2}, test{"0010", 2}, test{"0000", 2},
        test{b, 0}, test{b, 1}, test{b, 2}, test{b, 3},
    }
    for _, test := range tests {
        bs := test.bs
        e := len(bs)
        n := test.n
        fmt.Println("n =", n, "\b; Width e =", e, "\b:")
        fmt.Println("    Input b:", bs)
        bits := []byte(bs)
        for i := 0; i < len(bits); i++ {
            bits[i] = bits[i] - '0'
        }
        bits = setRightBits(bits, e, n)
        var sb strings.Builder
        for i := 0; i < len(bits); i++ {
            sb.WriteByte(bits[i] + '0')
        }
        fmt.Println("    Result :", sb.String())
    }
}


with javascript_semantics
function str_srb(string input, integer n)
    string res = input
    integer l = length(input),
            m = min(n,l),
            count = sum(sq_eq(input[-m..-1],'1')),
            k = l-n
    for i=l to 1 by -1 do
        integer bit = odd(input[i])
        count += iff(k>0?odd(input[k]):0)-bit
        if count and not bit then res[i] = '1' end if
        k -= 1
    end for
    assert(count=0)
    return res
end function

constant tests = {{"1000",2,2},{"0100",2,2},{"0010",2,2},{"0000",2,2},
                  {"010000000000100000000010000000010000000100000010000010000100010010",0,3}}

for i=1 to length(tests) do
    {string input, integer l, integer m} = tests[i]
    printf(1,"input: %s (width %d)\n",{input,length(input)})
    for n=l to m do
        printf(1,"n = %d: %s\n",{n,str_srb(input,n)})
    end for
end for


from operator import or_
from functools import reduce

def set_right_adjacent_bits(n: int, b: int) -> int:
    return reduce(or_, (b >> x for x in range(n+1)), 0)

if __name__ == "__main__":
    print("SAME n & Width.\n")
    n = 2  # bits to the right of set bits, to also set
    bits = "1000 0100 0010 0000"
    first = True
    for b_str in bits.split():
        b = int(b_str, 2)
        e = len(b_str)
        if first:
            first = False
            print(f"n = {n}; Width e = {e}:\n")
        result = set_right_adjacent_bits(n, b)
        print(f"     Input b: {b:0{e}b}")
        print(f"      Result: {result:0{e}b}\n")

    print("SAME Input & Width.\n")
    #bits = "01000010001001010110"
    bits = '01' + '1'.join('0'*x for x in range(10, 0, -1))
    for n in range(4):
        first = True
        for b_str in bits.split():
            b = int(b_str, 2)
            e = len(b_str)
            if first:
                first = False
                print(f"n = {n}; Width e = {e}:\n")
            result = set_right_adjacent_bits(n, b)
            print(f"     Input b: {b:0{e}b}")
            print(f"      Result: {result:0{e}b}\n")


sub rab (Int $n, Int $b = 1) {
    my $m = $n;
    $m +|= ($n +> $_) for ^ $b+1;
    $m
}

sub lab (Int $n, Int $b = 1) {
    my $m = $n;
    $m +|= ($n +< $_) for ^ $b+1;
    $m
}

say "Powers of 2 ≤ 8, 0 - Right-adjacent-bits: 2";
.&rab(2).base(2).fmt('%04s').say for <8 4 2 1 0>;

# Test with a few integers.
for 8,4, 18455760086304825618,5, 5444684034376312377319904082902529876242,15 -> $integer, $bits {

    say "\nInteger: $integer - Right-adjacent-bits: up to $bits";

    .say for ^$bits .map: -> $b { $integer.&rab($b).base: 2 };

    say "\nInteger: $integer - Left-adjacent-bits: up to $bits";

    .say for ^$bits .map: -> $b { $integer.&lab($b).fmt("%{0~$bits+$integer.msb}b") };

}


var setRightBits = Fn.new { |bits, e, n|
    if (e == 0 || n <= 0) return bits
    var bits2 = bits.toList
    for (i in 0...e - 1) {
        var c = bits[i]
        if (c == 1) {
            var j = i + 1
            while (j <= i + n && j < e) {
                bits2[j] = 1
                j = j + 1
            }
        }
    }
    return bits2
}

var b = "010000000000100000000010000000010000000100000010000010000100010010"
var tests = [["1000", 2], ["0100", 2], ["0010", 2], ["0000", 2], [b, 0], [b, 1], [b, 2], [b, 3]]
for (test in tests) {
    var bits = test[0]
    var e = bits.count
    var n = test[1]
    System.print("n = %(n); Width e = %(e):")
    System.print("    Input b: %(bits)")
    bits = bits.map { |c| c.bytes[0] - 48 }.toList
    bits = setRightBits.call(bits, e, n)
    System.print("     Result: %(bits.join())\n")
}


F dice5()
   R random:(1..5)

F dice7() -> Int
   V r = dice5() + dice5() * 5 - 6
   R I r < 21 {(r % 7) + 1} E dice7()

F distcheck(func, repeats, delta)
   V bin = DefaultDict[Int, Int]()
   L 1..repeats
      bin[func()]++
   V target = repeats I/ bin.len
   V deltacount = Int(delta / 100.0 * target)
   assert(all(bin.values().map(count -> abs(@target - count) < @deltacount)), ‘Bin distribution skewed from #. +/- #.: #.’.format(target, deltacount, sorted(bin.items()).map((key, count) -> (key, @target - count))))
   print(bin)

distcheck(dice5, 1000000, 1)
distcheck(dice7, 1000000, 1)


package Random_57 is

   type Mod_7 is mod 7;

   function Random7 return Mod_7;
     -- a "fast" implementation, minimazing the calls to the Random5 generator
   function Simple_Random7 return Mod_7;
     -- a simple implementation

end Random_57;


PROC dice5 = INT:
  1 + ENTIER (5*random);

PROC mulby5 = (INT n)INT:
   ABS (BIN n SHL 2) + n;

PROC dice7 = INT: (
  INT d55 := 0;
  INT m := 1;
  WHILE
    m := ABS ((2r1 AND BIN m) SHL 2) + ABS (BIN m SHR 1);  # repeats 4 - 2 - 1 #
    d55 := mulby5(mulby5(d55)) + mulby5(dice5) + dice5 - 6;
# WHILE # d55 < m DO SKIP OD;

  m := 1;
  WHILE d55>0 DO
    d55 +:= m;
    m := ABS (BIN d55 AND 2r111); # modulas by 8 #
    d55 := ABS (BIN d55 SHR 3)    # divide by 8 #
  OD;
  m
);

PROC distcheck = (PROC INT dice, INT count, upb)VOID: (
  [upb]INT sum; FOR i TO UPB sum DO sum[i] := 0 OD;
  FOR i TO count DO sum[dice]+:=1 OD;
  FOR i TO UPB sum WHILE print(whole(sum[i],0)); i /= UPB sum DO print(", ") OD;
  print(new line)
);

main:
(
  distcheck(dice5, 1000000, 5);
  distcheck(dice7, 1000000, 7)
)


dice5()
{  Random, v, 1, 5
   Return, v
}

dice7()
{  Loop
   {  v := 5 * dice5() + dice5() - 6
      IfLess v, 21, Return, (v // 3) + 1
   }
}


      MAXRND = 7
      FOR r% = 2 TO 5
        check% = FNdistcheck(FNdice7, 10^r%, 0.1)
        PRINT "Over "; 10^r% " runs dice7 ";
        IF check% THEN
          PRINT "failed distribution check with "; check% " bin(s) out of range"
        ELSE
          PRINT "passed distribution check"
        ENDIF
      NEXT
      END

      DEF FNdice7
      LOCAL x% : x% = FNdice5 + 5*FNdice5
      IF x%>26 THEN = FNdice7 ELSE = (x%+1) MOD 7 + 1

      DEF FNdice5 = RND(5)

      DEF FNdistcheck(RETURN func%, repet%, delta)
      LOCAL i%, m%, r%, s%, bins%()
      DIM bins%(MAXRND)
      FOR i% = 1 TO repet%
        r% = FN(^func%)
        bins%(r%) += 1
        IF r%>m% m% = r%
      NEXT
      FOR i% = 1 TO m%
        IF bins%(i%)/(repet%/m%) > 1+delta s% += 1
        IF bins%(i%)/(repet%/m%) < 1-delta s% += 1
      NEXT
      = s%


int rand5()
{
	int r, rand_max = RAND_MAX - (RAND_MAX % 5);
	while ((r = rand()) >= rand_max);
	return r / (rand_max / 5) + 1;
}

int rand5_7()
{
	int r;
	while ((r = rand5() * 5 + rand5()) >= 27);
	return r / 3 - 1;
}

int main()
{
	printf(check(rand5, 5, 1000000, .05) ? "flat\n" : "not flat\n");
	printf(check(rand7, 7, 1000000, .05) ? "flat\n" : "not flat\n");
	return 0;
}


using System;

public class SevenSidedDice
{
    Random random = new Random();

        static void Main(string[] args)
		{
			SevenSidedDice sevenDice = new SevenSidedDice();
			Console.WriteLine("Random number from 1 to 7: "+ sevenDice.seven());
            Console.Read();
		}

		int seven()
		{
			int v=21;
			while(v>20)
				v=five()+five()*5-6;
			return 1+v%7;
		}

		int five()
		{
        return 1 + random.Next(5);
		}
}


template<typename F> class fivetoseven
{
public:
  fivetoseven(F f): d5(f), rem(0), max(1) {}
  int operator()();
private:
  F d5;
  int rem, max;
};

template<typename F>
 int fivetoseven<F>::operator()()
{
  while (rem/7 == max/7)
  {
    while (max < 7)
    {
      int rand5 = d5()-1;
      max *= 5;
      rem = 5*rem + rand5;
    }

    int groups = max / 7;
    if (rem >= 7*groups)
    {
      rem -= 7*groups;
      max -= 7*groups;
    }
  }

  int result = rem % 7;
  rem /= 7;
  max /= 7;
  return result+1;
}

int d5()
{
  return 5.0*std::rand()/(RAND_MAX + 1.0) + 1;
}

fivetoseven<int(*)()> d7(d5);

int main()
{
  srand(time(0));
  test_distribution(d5, 1000000, 0.001);
  test_distribution(d7, 1000000, 0.001);
}


(def dice5 #(rand-int 5))

(defn dice7 []
  (quot (->> dice5                     ; do the following to dice5
             (repeatedly 2)            ; call it twice
             (apply #(+ %1 (* 5 %2)))  ; d1 + 5*d2 => 0..24
             #()                       ; wrap that up in a function
             repeatedly                ; make infinite sequence of the above
             (drop-while #(> % 20))    ; throw away anything > 20
             first)                    ; grab first acceptable element
        3))                            ; divide by three rounding down

(doseq [n [100 1000 10000] [num count okay?] (verify dice7 n)]
  (println "Saw" num count "times:"
           (if okay? "that's" "   not") "acceptable"))


import std.random;
import verify_distribution_uniformity_naive: distCheck;

/// Generates a random number in [1, 5].
int dice5() /*pure nothrow*/ @safe {
    return uniform(1, 6);
}

/// Naive, generates a random number in [1, 7] using dice5.
int fiveToSevenNaive() /*pure nothrow*/ @safe {
    immutable int r = dice5() + dice5() * 5 - 6;
    return (r < 21) ? (r % 7) + 1 : fiveToSevenNaive();
}

/**
Generates a random number in [1, 7] using dice5,
minimizing calls to dice5.
*/
int fiveToSevenSmart() @safe {
    static int rem = 0, max = 1;

    while (rem / 7 == max / 7) {
        while (max < 7) {
            immutable int rand5 = dice5() - 1;
            max *= 5;
            rem = 5 * rem + rand5;
        }

        immutable int groups = max / 7;
        if (rem >= 7 * groups) {
            rem -= 7 * groups;
            max -= 7 * groups;
        }
    }

    immutable int result = rem % 7;
    rem /= 7;
    max /= 7;
    return result + 1;
}

void main() /*@safe*/ {
    enum int N = 400_000;
    distCheck(&dice5, N, 1);
    distCheck(&fiveToSevenNaive, N, 1);
    distCheck(&fiveToSevenSmart, N, 1);
}


def dice5() {
  return entropy.nextInt(5) + 1
}

def dice7() {
  var d55 := null
  while ((d55 := 5 * dice5() + dice5() - 6) >= 21) {}
  return d55 %% 7 + 1
}


defmodule Dice do
  def dice5, do: :rand.uniform( 5 )

  def dice7 do
    dice7_from_dice5
  end

  defp dice7_from_dice5 do
    d55 = 5*dice5 + dice5 - 6           # 0..24
    if d55 < 21, do: rem( d55, 7 ) + 1,
                 else: dice7_from_dice5
  end
end

fun5 = fn -> Dice.dice5 end
IO.inspect VerifyDistribution.naive( fun5, 1000000, 3 )
fun7 = fn -> Dice.dice7 end
IO.inspect VerifyDistribution.naive( fun7, 1000000, 3 )


-module( dice ).

-export( [dice5/0, dice7/0, task/0] ).

dice5() -> random:uniform( 5 ).

dice7() ->
	dice7_small_enough( dice5() * 5 + dice5() - 6 ). % 0 - 24

task() ->
       verify_distribution_uniformity:naive( fun dice7/0, 1000000, 1 ).

dice7_small_enough( N ) when N < 21 -> N div 3 + 1;
dice7_small_enough( _N ) -> dice7().


USING: kernel random sequences assocs locals sorting prettyprint
  math math.functions math.statistics math.vectors math.ranges ;
IN: rosetta-code.dice7

! Output a random integer 1..5.
: dice5 ( -- x )
   5 [1,b] random
;

! Output a random integer 1..7 using dice5 as randomness source.
: dice7 ( -- x )
   0 [ dup 21 < ] [ drop dice5 5 * dice5 + 6 - ] do until
   7 rem 1 +
;

! Roll the die by calling the quotation the given number of times and return
! an array with roll results.
! Sample call: 1000 [ dice7 ] roll
: roll ( times quot: ( -- x ) -- array )
   [ call( --  x ) ] curry replicate
;

! Input array contains outcomes of a number of die throws. Each die result is
! an integer in the range 1..X. Calculate and return the number of each
! of the results in the array so that in the first position of the result
! there is the number of ones in the input array, in the second position
! of the result there is the number of twos in the input array, etc.
: count-dice-outcomes ( X array -- array )
    histogram
    swap [1,b] [ over [ 0 or ] change-at ] each
    sort-keys values
;

! Verify distribution uniformity/Naive. Delta is the acceptable deviation
! from the ideal number of items in each bucket, expressed as a fraction of
! the total count. Sides is the number of die sides. Die-func is a word that
! produces a random number on stack in the range [1..sides], times is the
! number of times to call it.
! Sample call: 0.02 7 [ dice7 ] 100000 verify
:: verify ( delta sides die-func: ( -- random ) times -- )
   sides
   times die-func roll
   count-dice-outcomes
   dup .
   times sides / :> ideal-count
   ideal-count v-n vabs
   times v/n
   delta [ < ] curry all?
   [ "Random enough" . ] [ "Not random enough" . ] if
;

! Call verify with 1, 10, 100, ... 1000000 rolls of 7-sided die.
: verify-all ( -- )
   { 1 10 100 1000 10000 100000 1000000 }
   [| times | 0.02 7 [ dice7 ] times verify ] each
;


require random.fs

: d5 5 random 1+ ;
: discard? 5 = swap 1 > and ;
: d7
   begin d5 d5 2dup discard? while 2drop repeat
   1- 5 * + 1- 7 mod 1+ ;


module rand_mod
  implicit none

contains

function rand5()
  integer :: rand5
  real :: r

  call random_number(r)
  rand5 = 5*r + 1
end function

function rand7()
  integer :: rand7

  do
    rand7 = 5*rand5() + rand5() - 6
    if (rand7 < 21) then
      rand7 = rand7 / 3 + 1
      return
    end if
  end do
end function
end module

program Randtest
  use rand_mod
  implicit none

  integer, parameter :: samples = 1000000

  call distcheck(rand7, samples, 0.005)
  write(*,*)
  call distcheck(rand7, samples, 0.001)

end program


Function dice5() As Integer
    Return Int(Rnd * 5) + 1
End Function

Function dice7() As Integer
    Dim As Integer temp
    Do
        temp = dice5() * 5 + dice5() -6
    Loop Until temp < 21
    Return (temp Mod 7) +1
End Function

Dim Shared As Ulongint n = 1000000
Print "Testing "; n; " times"
If Not(distCheck(n, 0.05)) Then Print "Test failed" Else Print "Test passed"
Sleep


package main

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

// "given"
func dice5() int {
    return rand.Intn(5) + 1
}

// function specified by task "Seven-sided dice from five-sided dice"
func dice7() (i int) {
    for {
        i = 5*dice5() + dice5()
        if i < 27 {
            break
        }
    }
    return (i / 3) - 1
}

// function specified by task "Verify distribution uniformity/Naive"
//
// Parameter "f" is expected to return a random integer in the range 1..n.
// (Values out of range will cause an unceremonious crash.)
// "Max" is returned as an "indication of distribution achieved."
// It is the maximum delta observed from the count representing a perfectly
// uniform distribution.
// Also returned is a boolean, true if "max" is less than threshold
// parameter "delta."
func distCheck(f func() int, n int,
    repeats int, delta float64) (max float64, flatEnough bool) {
    count := make([]int, n)
    for i := 0; i < repeats; i++ {
        count[f()-1]++
    }
    expected := float64(repeats) / float64(n)
    for _, c := range count {
        max = math.Max(max, math.Abs(float64(c)-expected))
    }
    return max, max < delta
}

// Driver, produces output satisfying both tasks.
func main() {
    rand.Seed(time.Now().UnixNano())
    const calls = 1000000
    max, flatEnough := distCheck(dice7, 7, calls, 500)
    fmt.Println("Max delta:", max, "Flat enough:", flatEnough)
    max, flatEnough = distCheck(dice7, 7, calls, 500)
    fmt.Println("Max delta:", max, "Flat enough:", flatEnough)
}


random = new Random()

int rand5() {
    random.nextInt(5) + 1
}

int rand7From5() {
    def raw = 25
    while (raw > 21) {
        raw = 5*(rand5() - 1) + rand5()
    }
    (raw % 7) + 1
}


import System.Random
import Data.List

sevenFrom5Dice = do
  d51 <- randomRIO(1,5) :: IO Int
  d52 <- randomRIO(1,5) :: IO Int
  let d7 = 5*d51+d52-6
  if d7 > 20 then sevenFrom5Dice
       else return $ 1 + d7 `mod` 7


$include "distribution-checker.icn"

# return a uniformly distributed number from 1 to 7,
# but only using a random number in range 1 to 5.
procedure die_7 ()
  while rnd := 5*?5 + ?5 - 6 do {
    if rnd < 21 then suspend rnd % 7 + 1
  }
end

procedure main ()
  if verify_uniform (create (|die_7()), 1000000, 0.01)
    then write ("uniform")
    else write ("skewed")
end


rollD5=: [: >: ] [email protected]$ 5:      NB. makes a y shape array of 5s, "rolls" the array and increments.
roll2xD5=: [: rollD5 2 ,~ */ NB. rolls D5 twice for each desired D7 roll (y rows, 2 cols)
toBase10=: 5 #. <:           NB. decrements and converts rows from base 5 to 10
keepGood=: #~ 21&>           NB. compress out values not less than 21
groupin3s=: [: >. >: % 3:    NB. increments, divides by 3 and takes ceiling

getD7=: [email protected]@[email protected]


import java.util.Random;
public class SevenSidedDice
{
	private static final Random rnd = new Random();
	public static void main(String[] args)
	{
		SevenSidedDice now=new SevenSidedDice();
		System.out.println("Random number from 1 to 7: "+now.seven());
	}
	int seven()
	{
		int v=21;
		while(v>20)
			v=five()+five()*5-6;
		return 1+v%7;
	}
	int five()
	{
		return 1+rnd.nextInt(5);
	}
}


function dice5()
{
 return 1 + Math.floor(5 * Math.random());
}

function dice7()
{
 while (true)
 {
  var dice55 = 5 * dice5() + dice5() - 6;
  if (dice55 < 21)
   return dice55 % 7 + 1;
 }
}

distcheck(dice5, 1000000);
print();
distcheck(dice7, 1000000);


dice5() = rand(1:5)

function dice7()
    r = 5*dice5() + dice5() - 6
    r < 21 ? (r%7 + 1) : dice7()
end


// version 1.1.3

import java.util.Random

val r = Random()

fun dice5() = 1 + r.nextInt(5)

fun dice7(): Int {
    while (true) {
       val t = (dice5() - 1) * 5 + dice5() - 1
       if (t >= 21) continue
       return 1 + t / 3
    }
}

fun checkDist(gen: () -> Int, nRepeats: Int, tolerance: Double = 0.5) {
    val occurs = mutableMapOf<Int, Int>()
    for (i in 1..nRepeats) {
        val d = gen()
        if (occurs.containsKey(d))
            occurs[d] = occurs[d]!! + 1
        else
            occurs.put(d, 1)
    }
    val expected = (nRepeats.toDouble()/ occurs.size).toInt()
    val maxError = (expected * tolerance / 100.0).toInt()
    println("Repetitions = $nRepeats, Expected = $expected")
    println("Tolerance = $tolerance%, Max Error = $maxError\n")
    println("Integer   Occurrences   Error  Acceptable")
    val f = "  %d        %5d      %5d     %s"
    var allAcceptable = true
    for ((k,v) in occurs.toSortedMap()) {
        val error = Math.abs(v - expected)
        val acceptable = if (error <= maxError) "Yes" else "No"
        if (acceptable == "No") allAcceptable = false
        println(f.format(k, v, error, acceptable))
    }
    println("\nAcceptable overall: ${if (allAcceptable) "Yes" else "No"}")
}

fun main(args: Array<String>) {
    checkDist(::dice7, 1_400_000)
}


n=1000000    '1000000 would take several minutes
print "Testing ";n;" times"
if  not(check(n, 0.05)) then print "Test failed" else print "Test passed"
end

'function check(n, delta) is defined at
'http://rosettacode.org/wiki/Verify_distribution_uniformity/Naive#Liberty_BASIC

function GENERATOR()
    'GENERATOR = int(rnd(0)*10) '0..9
    'GENERATOR = 1+int(rnd(0)*5) '1..5: dice5

    'dice7()
    do
        temp =dice5() *5 +dice5() -6
    loop until temp <21
    GENERATOR =( temp mod 7) +1

end function

function dice5()
    dice5=1+int(rnd(0)*5) '1..5: dice5
end function


dice5 = function() return math.random(5) end

function dice7()
  x = dice5() * 5 + dice5() - 6
  if x > 20 then return dice7() end
  return x%7 + 1
end


Module CheckIt {
      Def long i, calls, max, min
      s=stack:=random(1,5),random(1,5), random(1,5), random(1,5), random(1,5), random(1,5), random(1,5)
      z=0: for i=1 to 7 { z+=stackitem(s, i)}
      dice7=lambda z, s -> {
            =((z-1) mod 7)+1 : stack s {z-=Number : data random(1,5): z+=Stackitem(7)}
      }
      Dim count(1 to 7)=0&  ' long type
      calls=700000
      p=0.05
      IsUniform=lambda max=calls/7*(1+p), min=calls/7*(1-p) (a)->{
            if len(a)=0 then =false : exit
            =false
            m=each(a)
            while m
                  if array(m)<min or array(m)>max then break
            end while
            =true
      }
      For i=1 to calls {count(dice7())++}
      max=count()#max()
      expected=calls div 7
      min=count()#min()
      for i=1 to 7
      document doc$=format$("{0}{1::-7}",i,count(i))+{
      }
      Next i
      doc$=format$("min={0} expected={1} max={2}", min, expected, max)+{
      }+format$("Verify Uniform:{0}", if$(IsUniform(count())->"uniform", "skewed"))+{
      }
      Print
      report doc$
      clipboard doc$
}
CheckIt


sevenFrom5Dice := (tmp$ = 5*RandomInteger[{1, 5}] + RandomInteger[{1, 5}] - 6;
  If [tmp$ < 21, 1 + Mod[tmp$ , 7], sevenFrom5Dice])


import random, tables

proc dice5(): int = rand(1..5)

proc dice7(): int =
  while true:
    let val = 5 * dice5() + dice5() - 6
    if val < 21:
      return val div 3 + 1

proc checkDist(f: proc(): int; repeat: Positive; tolerance: float) =

  var counts: CountTable[int]
  for _ in 1..repeat:
    counts.inc f()

  let expected = (repeat / counts.len).toInt    # Rounded to nearest.
  let allowedDelta = (expected.toFloat * tolerance / 100).toInt
  var maxDelta = 0
  for val, count in counts.pairs:
    let d = abs(count - expected)
    if d > maxDelta: maxDelta = d

  let status = if maxDelta <= allowedDelta: "passed" else: "failed"
  echo "Checking ", repeat, " values with a tolerance of ", tolerance, "%."
  echo "Random generator ", status, " the uniformity test."
  echo "Max delta encountered = ", maxDelta, "   Allowed delta = ", allowedDelta

when isMainModule:
  import random
  randomize()
  checkDist(dice7, 1_000_000, 0.5)


let dice5() = 1 + Random.int 5 ;;

let dice7 =
  let rolls2answer = Hashtbl.create 25 in
  let n = ref 0 in
  for roll1 = 1 to 5 do
    for roll2 = 1 to 5 do
      Hashtbl.add rolls2answer (roll1,roll2) (!n / 3 +1);
      incr n
    done;
  done;
  let rec aux() =
    let trial = Hashtbl.find rolls2answer (dice5(),dice5()) in
    if trial <= 7 then trial else aux()
  in
  aux
;;


unit UConverter;
(*
Defines a converter object to output uniformly distributed random integers 1..7,
  given a source of uniformly distributed random integers 1..5.
*)
interface

type
  TFace5 = 1..5;
  TFace7 = 1..7;
  TDice5 = function() : TFace5;

type TConverter = class( TObject)
private
  fDigitBuf: array [0..19] of integer; // holds digits in base 7
  fBufCount, fBufPtr : integer;
  fDice5 : TDice5;  // passed-in generator for integers 1..5
  fNrDice5 : int64; // diagnostics, counts calls to fDice5
public
  constructor Create( aDice5 : TDice5);
  procedure Reset();
  function Dice7() : TFace7;
  property NrDice5 : int64 read fNrDice5;
end;

implementation

constructor TConverter.Create( aDice5 : TDice5);
begin
  inherited Create();
  fDice5 := aDice5;
  self.Reset();
end;

procedure TConverter.Reset();
begin
  fBufCount := 0;
  fBufPtr := 0;
  fNrDice5 := 0;
end;

function TConverter.Dice7() : TFace7;
var
  digit_holder, temp : int64;
  j : integer;
begin
  if fBufPtr = fBufCount then begin // if no more in buffer
    fBufCount := 0;
    fBufPtr := 0;
    repeat // first time through will usually be enough
      // Use supplied fDice5 to generate random 23-digit integer in base 5.
      digit_holder := 0;
      for j := 0 to 22 do begin
        digit_holder := 5*digit_holder + fDice5() - 1;
        inc( fNrDice5);
      end;
      // Convert to 20-digit number in base 7. (A simultaneous DivMod
      // procedure would be neater, but isn't available for int64.)
      for j := 0 to 19 do begin
        temp := digit_holder div 7;
        fDigitBuf[j] := digit_holder - 7*temp;
        digit_holder := temp;
      end;
      // Maximum possible is 5^23 - 1, which is 10214646460315315132 in base 7.
      // If leading digit in base 7 is 0 then low 19 digits are random.
      // Else number begins with 100, 101, or 102; and if with
      //   100 or 101 then low 17 digits are random. And so on.
      if fDigitBuf[19] = 0 then fBufCount := 19
      else if fDigitBuf[17] < 2 then fBufCount := 17
      else if fDigitBuf[16] = 0 then fBufCount := 16;
      // We could go on but that will do.
    until fBufCount > 0;
  end; // if no more in buffer
  result := fDigitBuf[fBufPtr] + 1;
  inc( fBufPtr);
end;
end.

program Dice_SevenFromFive;
(*
Demonstrates use of the UConverter unit.
*)
{$mode objfpc}{$H+}
uses
  SysUtils, UConverter;

function Dice5() : UConverter.TFace5;
begin
  result := Random(5) + 1; // Random(5) returns 0..4
end;

// Percentage points of the chi-squared distribution, 6 degrees of freedom.
// From New Cambridge Statistical Tables, 2nd edn, pp. 40-41.
const
  CHI_SQ_6df_95pc = 1.635;
  CHI_SQ_6df_05pc = 12.59;

// Main routine
var
  nrThrows, j, k : integer;
  nrFaces : array [1..7] of integer;
  X2, expected, diff : double;
  conv : UConverter.TConverter;
begin
  conv := UConverter.TConverter.Create( @Dice5);
  WriteLn( 'Enter 0 throws to quit');
  repeat
    WriteLn(''); Write( 'Number of throws (0 to quit): ');
    ReadLn( nrThrows);
    if nrThrows = 0 then begin
      conv.Free();
      exit;
    end;
    conv.Reset(); // clears count of calls to Dice5
    for k := 1 to 7 do nrFaces[k] := 0;
    for j := 1 to nrThrows do begin
      k := conv.Dice7();
      inc( nrFaces[k]);
    end;
    WriteLn('');
    WriteLn( SysUtils.Format( 'Number of throws = %10d', [nrThrows]));
    WriteLn( SysUtils.Format( 'Calls to Dice5   = %10d', [conv.NrDice5]));
    for k := 1 to 7 do
      WriteLn( SysUtils.Format( '   Number of %d''s = %10d', [k, nrFaces[k]]));

    // Calculation of chi-squared
    expected := nrThrows/7.0;
    X2 := 0.0;
    for k := 1 to 7 do begin
      diff := nrFaces[k] - expected;
      X2 := X2 + diff*diff/expected;
    end;
    WriteLn( SysUtils.Format( 'X^2 = %0.3f on 6 degrees of freedom', [X2]));
    if X2 < CHI_SQ_6df_95pc then      WriteLn( 'Too regular at 5% level')
    else if X2 > CHI_SQ_6df_05pc then WriteLn( 'Too irregular at 5% level')
    else                              WriteLn( 'Satisfactory at 5% level')
  until false;
end.


function dice5()
    return rand(5)
end function

function dice7()
    while true do
        integer r = dice5()*5+dice5()-3         --  ( ie 3..27, but )
        if r<24 then return floor(r/3) end if   -- (only 3..23 useful)
    end while
end function


Procedure dice5()
  ProcedureReturn Random(4) + 1
EndProcedure

Procedure dice7()
  Protected x

  x = dice5() * 5 + dice5() - 6
  If x > 20
    ProcedureReturn dice7()
  EndIf

  ProcedureReturn x % 7 + 1
EndProcedure


from random import randint

def dice5():
    return randint(1, 5)

def dice7():
    r = dice5() + dice5() * 5 - 6
    return (r % 7) + 1 if r < 21 else dice7()


dice5 <- function(n=1) sample(5, n, replace=TRUE)


#lang racket
(define (dice5) (add1 (random 5)))

(define (dice7)
  (define res (+ (* 5 (dice5)) (dice5) -6))
  (if (< res 21) (+ 1 (modulo res 7)) (dice7)))


/*REXX program simulates a 7─sided die based on a 5─sided throw for a number of trials. */
parse arg trials sample seed .                   /*obtain optional arguments from the CL*/
if trials=='' | trials=","  then trials=       1 /*Not specified?  Then use the default.*/
if sample=='' | sample=","  then sample= 1000000 /* "      "         "   "   "     "    */
if datatype(seed, 'W')  then call random ,,seed  /*Integer?  Then use it as a RAND seed.*/
L= length(trials)                                /* [↑]  one million samples to be used.*/

   do #=1  for trials;            die.= 0        /*performs the number of desired trials*/
   k= 0
               do  until k==sample;           r= 5 * random(1, 5)  +  random(1, 5)  -  6
               if r>20  then iterate
               k= k + 1;                      r= r // 7  +  1;          die.r= die.r + 1
               end   /*until*/
   say
   expect= sample % 7
   say center('trial:' right(#, L)    "   "     sample  'samples, expect' expect, 80, "─")

               do j=1  for 7
               say '      side'      j       "had "       die.j           ' occurrences',
                   '      difference from expected:'right(die.j - expect, length(sample) )
               end   /*j*/
   end   /*#*/                                   /*stick a fork in it,  we're all done. */


# Project : Seven-sided dice from five-sided dice

for n = 1 to 20
         d = dice7()
         see "" + d + " "
next
see nl

func dice7()
         x = dice5() * 5 + dice5() - 6
         if x > 20
            return dice7()
         ok
         dc = x % 7 + 1
         return dc

func dice5()
        rnd = random(4) + 1
        return rnd


require './distcheck.rb'

def d5
  1 + rand(5)
end

def d7
  loop do
    d55 = 5*d5 + d5 - 6
    return (d55 % 7 + 1) if d55 < 21
  end
end

distcheck(1_000_000) {d5}
distcheck(1_000_000) {d7}


import scala.util.Random

object SevenSidedDice extends App {
  private val rnd = new Random

  private def seven = {
    var v = 21

    def five = 1 + rnd.nextInt(5)

    while (v > 20) v = five + five * 5 - 6
    1 + v % 7
  }

  println("Random number from 1 to 7: " + seven)

}


func dice5 { 1 + 5.rand.int }

func dice7 {
  loop {
    var d7 = ((5*dice5() + dice5() - 6) % 8);
    d7 && return d7;
  }
}

var count7 = Hash.new;

var n = 1e6;
n.times { count7{dice7()} := 0 ++ }
count7.keys.sort.each { |k|
    printf("%s: %5.2f%%\n", k, 100*(count7{k}/n * 7 - 1));
}


Private Function Test4DiscreteUniformDistribution(ObservationFrequencies() As Variant, Significance As Single) As Boolean
    'Returns true if the observed frequencies pass the Pearson Chi-squared test at the required significance level.
    Dim Total As Long, Ei As Long, i As Integer
    Dim ChiSquared As Double, DegreesOfFreedom As Integer, p_value As Double
    Debug.Print "[1] ""Data set:"" ";
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        Total = Total + ObservationFrequencies(i)
        Debug.Print ObservationFrequencies(i); " ";
    Next i
    DegreesOfFreedom = UBound(ObservationFrequencies) - LBound(ObservationFrequencies)
    'This is exactly the number of different categories minus 1
    Ei = Total / (DegreesOfFreedom + 1)
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        ChiSquared = ChiSquared + (ObservationFrequencies(i) - Ei) ^ 2 / Ei
    Next i
    p_value = 1 - WorksheetFunction.ChiSq_Dist(ChiSquared, DegreesOfFreedom, True)
    Debug.Print
    Debug.Print "Chi-squared test for given frequencies"
    Debug.Print "X-squared ="; Format(ChiSquared, "0.0000"); ", ";
    Debug.Print "df ="; DegreesOfFreedom; ", ";
    Debug.Print "p-value = "; Format(p_value, "0.0000")
    Test4DiscreteUniformDistribution = p_value > Significance
End Function
Private Function Dice5() As Integer
    Dice5 = Int(5 * Rnd + 1)
End Function
Private Function Dice7() As Integer
    Dim i As Integer
    Do
        i = 5 * (Dice5 - 1) + Dice5
    Loop While i > 21
    Dice7 = i Mod 7 + 1
End Function
Sub TestDice7()
    Dim i As Long, roll As Integer
    Dim Bins(1 To 7) As Variant
    For i = 1 To 1000000
        roll = Dice7
        Bins(roll) = Bins(roll) + 1
    Next i
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(Bins, 0.05); """"
End Sub


Option Explicit

function dice5
	dice5 = int(rnd*5) + 1
end function

function dice7
	dim j
	do
		j = 5 * dice5 + dice5 - 6
	loop until j < 21
	dice7 = j mod 7 + 1
end function


///////////////////////////////////////////////////////////////////////////////
/// seven_sided_dice_tb : (testbench)                                       ///
///      Check the distribution of the output of a seven sided dice circuit ///
///////////////////////////////////////////////////////////////////////////////
module seven_sided_dice_tb;
  reg [31:0] freq[0:6];
  reg        clk;
  wire [2:0] dice_face;
  reg        req;
  wire       valid_roll;
  integer    i;
  initial begin
    clk <= 0;
    forever begin
       #1;
       clk <= ~clk;
    end
  end
  initial begin
    req <= 1'b1;
    for(i = 0; i < 7; i = i + 1) begin
      freq[i] <= 32'b0;
    end
    repeat(10) @(posedge clk);
    repeat(7000000) begin
      @(posedge clk);
      while(~valid_roll) begin
        @(posedge clk);
      end
      freq[dice_face] <= freq[dice_face] + 32'b1;
    end
    $display("********************************************");
    $display("*** Seven sided dice distribution:          ");
    $display("    Theoretical distribution is an uniform  ");
    $display("    distribution with (1/7)-probability     ");
    $display("    for each possible outcome,              ");
    $display("  The experimental distribution is:          ");
    for(i = 0; i < 7; i = i + 1) begin
      if(freq[i] < 32'd1_000_000) begin
        $display("%d with probability 1/7 - (%d ppm)", i, (32'd1_000_000 - freq[i])/7);
      end
      else begin
        $display("%d with probability 1/7 + (%d ppm)", i, (freq[i] - 32'd1_000_000)/7);
      end
    end
    $finish;
  end

  seven_sided_dice DUT(
    .clk(clk),
    .req(req),
    .valid_roll(valid_roll),
    .dice_face(dice_face)
  );
endmodule
///////////////////////////////////////////////////////////////////////////////
/// seven_sided_dice :                                                      ///
///      Synthsizeable module that using a 5 sided dice as a black box      ///
///      is able to reproduce the outcomes if a 7-sided dice                ///
///////////////////////////////////////////////////////////////////////////////
module seven_sided_dice(
  input wire       clk,
  input wire       req,
  output reg       valid_roll,
  output reg [2:0] dice_face
);
  wire [2:0] face1;
  wire [2:0] face2;
  reg [4:0] combination;
  reg req_p1;
  reg req_p2;
  reg req_p3;
  always @(posedge clk) begin
    req_p1 <= req;
    req_p2 <= req_p1;
  end
  always @(posedge clk) begin
    if(req_p1) begin
      combination <= face1 + face2 + {face2, 2'b00};
    end
    if(req_p2) begin
      case(combination)
           5'd0,  5'd1,  5'd2: {valid_roll, dice_face} <= {1'b1, 3'd0};
           5'd3,  5'd4,  5'd5: {valid_roll, dice_face} <= {1'b1, 3'd1};
           5'd6,  5'd7,  5'd8: {valid_roll, dice_face} <= {1'b1, 3'd2};
           5'd9, 5'd10, 5'd11: {valid_roll, dice_face} <= {1'b1, 3'd3};
          5'd12, 5'd13, 5'd14: {valid_roll, dice_face} <= {1'b1, 3'd4};
          5'd15, 5'd16, 5'd17: {valid_roll, dice_face} <= {1'b1, 3'd5};
          5'd18, 5'd19, 5'd20: {valid_roll, dice_face} <= {1'b1, 3'd6};
          default: valid_roll <= 1'b0;
      endcase
    end
  end

  five_sided_dice dice1(
    .clk(clk),
    .req(req),
    .dice_face(face1)
  );

  five_sided_dice dice2(
    .clk(clk),
    .req(req),
    .dice_face(face2)
  );
endmodule

///////////////////////////////////////////////////////////////////////////////
/// five_sided_dice :                                                       ///
///      A model of the five sided dice component                           ///
///////////////////////////////////////////////////////////////////////////////
module five_sided_dice(
  input wire clk,
  input wire req,
  output reg [2:0] dice_face
);
  always @(posedge clk) begin
    if(req) begin
      dice_face  <= $urandom % 5;
    end
  end
endmodule


import "random" for Random
import "/sort" for Sort
import "/fmt" for Fmt

var r = Random.new()

var dice5 = Fn.new { r.int(1, 6) }

var dice7 = Fn.new {
    while (true) {
        var t = (dice5.call() - 1) * 5 + dice5.call() - 1
        if (t < 21) return 1 + (t/3).floor
    }
}

var checkDist = Fn.new { |gen, nRepeats, tolerance|
    var occurs = {}
    for (i in 1..nRepeats) {
        var d = gen.call()
        occurs[d] = occurs.containsKey(d) ? occurs[d] + 1 : 1
    }
    var expected = (nRepeats/occurs.count).floor
    var maxError = (expected * tolerance / 100).floor
    System.print("Repetitions = %(nRepeats), Expected = %(expected)")
    System.print("Tolerance = %(tolerance)\%, Max Error = %(maxError)\n")
    System.print("Integer   Occurrences   Error  Acceptable")
    var f = "  $d        $5d      $5d     $s"
    var allAcceptable = true
    var cmp = Fn.new { |me1, me2| (me1.key - me2.key).sign }
    occurs = occurs.toList
    Sort.insertion(occurs, cmp)
    for (me in occurs) {
        var k = me.key
        var v = me.value
        var error = (v - expected).abs
        var acceptable = (error <= maxError) ? "Yes" : "No"
        if (acceptable == "No") allAcceptable = false
        Fmt.print(f, k, v, error, acceptable)
    }
    System.print("\nAcceptable overall: %(allAcceptable ? "Yes" : "No")")
}

checkDist.call(dice7, 1400000, 0.5)


V LIMIT = 1'000'000
F get_primes(limit)
   V is_prime = [0B] * 2 [+] [1B] * (limit - 1)
   L(n) 0 .< Int(limit ^ 0.5 + 1.5)
      I is_prime[n]
         L(i) (n * n .< limit + 1).step(n)
            is_prime[i] = 0B
   R enumerate(is_prime).filter((i, prime) -> prime).map((i, prime) -> i)

V primes = get_primes(LIMIT)
V primeset = Set(primes)

V s = [[[Int]]()] * 4
[Int] unsexy
L(p) primes
   I p + 6 C primeset
      s[0].append([p, p + 6])
   E
      I p - 6 !C primeset
         unsexy.append(p)
      L.continue
   I p + 12 C primeset
      s[1].append([p, p + 6, p + 12])
   E
      L.continue
   I p + 18 C primeset
      s[2].append([p, p + 6, p + 12, p + 18])
   E
      L.continue
   I p + 24 C primeset
      s[3].append([p, p + 6, p + 12, p + 18, p + 24])

print(‘"SEXY" PRIME GROUPINGS:’)
L(sexy, name) zip(s, ‘pairs triplets quadruplets quintuplets’.split(‘ ’))
   print(‘  #. #. ending with ...’.format(sexy.len, name))
   L(sx) sexy[(len)-5..]
      print(‘    ’sx)

print("\nThere are #. unsexy primes ending with ...".format(unsexy.len))
L(usx) unsexy[(len)-10..]
   print(‘  ’usx)


begin
    % find some sexy primes - primes that differ from another prime by 6     %
    % implements the sieve of Eratosthenes                                   %
    procedure sieve( logical array s ( * ); integer value n ) ;
    begin
        % start with everything flagged as prime                             %
        for i := 1 until n do s( i ) := true;
        % sieve out the non-primes                                           %
        s( 1 ) := false;
        for i := 2 until truncate( sqrt( n ) ) do begin
            if s( i ) then for p := i * i step i until n do s( p ) := false
        end for_i ;
    end sieve ;
    % adds a prime to list of sexy/unsexy primes                             %
    procedure addPrime ( integer value p
                       ; integer array list ( * )
                       ; integer value len
                       ) ;
    begin
        % increment count, shuffle down the primes and add the new one       %
        list( 0 ) := list( 0 ) + 1;
        for i := 1 until len - 1 do list( i ) := list( i + 1 );
        list( len ) := p
    end addPrime ;
    % counts the number of pairs of sexy primes, triplets, quadruplest and   %
    % quintuplets up to n                                                    %
    % the counts of each kind are returned in the 0 element of the arrays    %
    % the last 5 ( or less if there are less than 5 ) of each type of sexy   %
    % prime is returned in the array elements 1 to 5                         %
    procedure countSexyPrimes ( logical array s ( * )
                              ; integer value n
                              ; integer array pairs, triplets, quadruplets, quintuplets ( * )
                              ) ;
    begin
        integer pos2, pos3, pos4, pos5;
        for i := 0 until 5 do pairs( i ) := triplets( i ) := quadruplets( i ) := quintuplets( i ) := 0;
        % look for pairs etc. up to n                                        %
        % 2 cannot be a sexy prime as it is the only even prime, thus:       %
        %     pairs can start at 7, triplets at 13, quadruplets at 19 and    %
        %     quintuplets at 25                                              %
        for p := 7 step 2 until 11 do begin
            if s( p ) and s( p - 6 ) then addPrime( p, pairs, 5 )
        end for_p ;
        for p := 13 step 2 until 17 do begin
            if s( p ) and s( p - 6 )                 then addPrime( p, pairs,       5 );
            if s( p ) and s( p - 6 ) and s( p - 12 ) then addPrime( p, triplets,    5 )
        end for_p ;
        for p := 19 step 2 until 23 do begin
            if s( p ) and s( p - 6 )                 then addPrime( p, pairs,       5 );
            if s( p ) and s( p - 6 ) and s( p - 12 ) then addPrime( p, triplets,    5 );
            if s( p ) and s( p - 6 ) and s( p - 12 ) and s( p - 18 )
                                                     then addPrime( p, quadruplets, 5 )
        end for_p ;
        pos5 := 1;
        pos4 := pos5 + 6;
        pos3 := pos4 + 6;
        pos2 := pos3 + 6;
        for p := pos2 + 6 step 2 until n do begin
            if s( p ) then begin
                if s( pos2 ) then begin % sexy pair                          %
                    addPrime( p, pairs, 5 );
                    if s( pos3 ) then begin % sexy triplet                   %
                        addPrime( p, triplets, 5 );
                        if s( pos4 ) then begin % sexy quadruplet            %
                            addPrime( p, quadruplets, 5 );
                            if s( pos5 ) then begin % sexy quintuplet        %
                                addPrime( p, quintuplets, 5 )
                            end if_s_pos5
                        end if_s_pos4
                    end if_s_pos3
                end if_s_pos2
            end if_s_p ;
            pos2 := pos2 + 2;
            pos3 := pos3 + 2;
            pos4 := pos4 + 2;
            pos5 := pos5 + 2
        end for_p
    end countSexyPrimes ;
    % counts the number of unsexy primes up to n                             %
    % the count is returned in the 0 element of the array                    %
    % the last 5 ( or less if there are less than 5 ) unsexy prime is        %
    % returned in the array elements 1 to 10                                 %
    procedure countUnsexyPrimes ( logical array s ( * )
                                ; integer value n
                                ; integer array unsexy ( * )
                                ) ;
    begin
        for i := 0 until 10 do unsexy( i ) := 0;
        for p := 2, 3, 5 do begin % handle primes below 7 separately         %
            if s( p ) and not s( p + 6 ) then addPrime( p, unsexy, 10 )
        end for_p ;
        for p := 7 step 2 until n do begin
            if s( p ) and not s( p - 6 ) and not s( p + 6 ) then addPrime( p, unsexy, 10 )
        end for_p
    end countUnsexyPrimes ;
    % shows sexy prime pairs                                                 %
    procedure showPrimes ( integer    value elements
                         ; integer    array primes ( * )
                         ; integer    value arrayMax
                         ; string(24) value title
                         ; integer    value maxPrime
                         ) ;
    begin
        write( i_w := 8, s_w := 0, "Found ", primes( 0 ), " ", title, " below ", maxPrime + 1
             , i_w := 2, "; last ", ( if primes( 0 ) > arrayMax then arrayMax else primes( 0 ) ), ":"
             );
        write( i_w := 1, s_w := 0, "    " );
        for p := 1 until arrayMax do begin
            if primes( p ) not = 0 then begin
                integer pn;
                if elements > 1 then writeon( "(" );
                pn := primes( p ) - ( ( elements - 1 ) * 6 );
                for i := 1 until elements do begin
                    writeon( i_w := 1, s_w := 0, " ", pn );
                    pn := pn + 6
                end for_i ;
                if elements > 1 then writeon( " ) " );
            end if_primes_p_ne_0
        end for_p
    end showPrimes ;
    integer MAX_SEXY, MAX_PRIME;
    % for the task, we need to consider primes up to 1 000 035               %
    % however we must still recognise sexy primes up that limit, so we sieve %
    % up to 1 000 035 + 6                                                    %
    MAX_SEXY  := 1000000 + 35;
    MAX_PRIME := MAX_SEXY + 6;
    begin
        logical array s ( 1 :: MAX_PRIME );
        integer array pairs, triplets, quadruplets, quintuplets ( 0 ::  5 );
        integer array unsexy                                    ( 0 :: 10 );
        sieve( s, MAX_PRIME );
        countSexyPrimes( s, MAX_SEXY, pairs, triplets, quadruplets, quintuplets );
        countUnsexyPrimes( s, MAX_SEXY, unsexy );
        showPrimes( 2, pairs,        5, "sexy prime pairs",       MAX_SEXY );
        showPrimes( 3, triplets,     5, "sexy prime triplets",    MAX_SEXY );
        showPrimes( 4, quadruplets,  5, "sexy prime quadruplets", MAX_SEXY );
        showPrimes( 5, quintuplets,  5, "sexy prime quintuplets", MAX_SEXY );
        showPrimes( 1, unsexy,      10, "unsexy primes",          MAX_SEXY )
    end
end.


# syntax: GAWK -f SEXY_PRIMES.AWK
BEGIN {
    cutoff = 1000034
    for (i=1; i<=cutoff; i++) {
      n1 = i
      if (is_prime(n1)) {
        total_primes++
        if ((n2 = n1 + 6) > cutoff) { continue }
        if (is_prime(n2)) {
          save(2,5,n1 FS n2)
          if ((n3 = n2 + 6) > cutoff) { continue }
          if (is_prime(n3)) {
            save(3,5,n1 FS n2 FS n3)
            if ((n4 = n3 + 6) > cutoff) { continue }
            if (is_prime(n4)) {
              save(4,5,n1 FS n2 FS n3 FS n4)
              if ((n5 = n4 + 6) > cutoff) { continue }
              if (is_prime(n5)) {
                save(5,5,n1 FS n2 FS n3 FS n4 FS n5)
              }
            }
          }
        }
        if ((s[2] s[3] s[4] s[5]) !~ (n1 "")) { # check for unsexy
          save(1,10,n1)
        }
      }
    }
    printf("%d primes less than %s\n\n",total_primes,cutoff+1)
    printf("%d unsexy primes\n%s\n\n",c[1],s[1])
    printf("%d sexy prime pairs\n%s\n\n",c[2],s[2])
    printf("%d sexy prime triplets\n%s\n\n",c[3],s[3])
    printf("%d sexy prime quadruplets\n%s\n\n",c[4],s[4])
    printf("%d sexy prime quintuplets\n%s\n\n",c[5],s[5])
    exit(0)
}
function is_prime(x,  i) {
    if (x <= 1) {
      return(0)
    }
    for (i=2; i<=int(sqrt(x)); i++) {
      if (x % i == 0) {
        return(0)
      }
    }
    return(1)
}
function save(key,nbr_to_keep,str) {
    c[key]++
    str = s[key] str ", "
    if (gsub(/,/,"&",str) > nbr_to_keep) {
      str = substr(str,index(str,",")+2)
    }
    s[key] = str
}


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <locale.h>

#define TRUE 1
#define FALSE 0

typedef unsigned char bool;

void sieve(bool *c, int limit) {
    int i, p = 3, p2;
    // TRUE denotes composite, FALSE denotes prime.
    c[0] = TRUE;
    c[1] = TRUE;
    // no need to bother with even numbers over 2 for this task
    for (;;) {
        p2 = p * p;
        if (p2 >= limit) {
            break;
        }
        for (i = p2; i < limit; i += 2*p) {
            c[i] = TRUE;
        }
        for (;;) {
            p += 2;
            if (!c[p]) {
                break;
            }
        }
    }
}

void printHelper(const char *cat, int len, int lim, int n) {
    const char *sp = strcmp(cat, "unsexy primes") ? "sexy prime " : "";
    const char *verb = (len == 1) ? "is" : "are";
    printf("Number of %s%s less than %'d = %'d\n", sp, cat, lim, len);
    printf("The last %d %s:\n", n, verb);
}

void printArray(int *a, int len) {
    int i;
    printf("[");
    for (i = 0; i < len; ++i) printf("%d ", a[i]);
    printf("\b]");
}

int main() {
    int i, ix, n, lim = 1000035;
    int pairs = 0, trips = 0, quads = 0, quins = 0, unsexy = 2;
    int pr = 0, tr = 0, qd = 0, qn = 0, un = 2;
    int lpr = 5, ltr = 5, lqd = 5, lqn = 5, lun = 10;
    int last_pr[5][2], last_tr[5][3], last_qd[5][4], last_qn[5][5];
    int last_un[10];
    bool *sv = calloc(lim - 1, sizeof(bool)); // all FALSE by default
    setlocale(LC_NUMERIC, "");
    sieve(sv, lim);

    // get the counts first
    for (i = 3; i < lim; i += 2) {
        if (i > 5 && i < lim-6 && !sv[i] && sv[i-6] && sv[i+6]) {
            unsexy++;
            continue;
        }
        if (i < lim-6 && !sv[i] && !sv[i+6]) {
            pairs++;
        } else continue;

        if (i < lim-12 && !sv[i+12]) {
            trips++;
        } else continue;

        if (i < lim-18 && !sv[i+18]) {
            quads++;
        } else continue;

        if (i < lim-24 && !sv[i+24]) {
            quins++;
        }
    }
    if (pairs < lpr) lpr = pairs;
    if (trips < ltr) ltr = trips;
    if (quads < lqd) lqd = quads;
    if (quins < lqn) lqn = quins;
    if (unsexy < lun) lun = unsexy;

    // now get the last 'x' for each category
    for (i = 3; i < lim; i += 2) {
        if (i > 5 && i < lim-6 && !sv[i] && sv[i-6] && sv[i+6]) {
            un++;
            if (un > unsexy - lun) {
                last_un[un + lun - 1 - unsexy] = i;
            }
            continue;
        }
        if (i < lim-6 && !sv[i] && !sv[i+6]) {
            pr++;
            if (pr > pairs - lpr) {
                ix = pr + lpr - 1 - pairs;
                last_pr[ix][0] = i; last_pr[ix][1] = i + 6;
            }
        } else continue;

        if (i < lim-12 && !sv[i+12]) {
            tr++;
            if (tr > trips - ltr) {
                ix = tr + ltr - 1 - trips;
                last_tr[ix][0] = i; last_tr[ix][1] = i + 6;
                last_tr[ix][2] = i + 12;
            }
        } else continue;

        if (i < lim-18 && !sv[i+18]) {
            qd++;
            if (qd > quads - lqd) {
                ix = qd + lqd - 1 - quads;
                last_qd[ix][0] = i; last_qd[ix][1] = i + 6;
                last_qd[ix][2] = i + 12; last_qd[ix][3] = i + 18;
            }
        } else continue;

        if (i < lim-24 && !sv[i+24]) {
            qn++;
            if (qn > quins - lqn) {
                ix = qn + lqn - 1 - quins;
                last_qn[ix][0] = i; last_qn[ix][1] = i + 6;
                last_qn[ix][2] = i + 12; last_qn[ix][3] = i + 18;
                last_qn[ix][4] = i + 24;
            }
        }
    }

    printHelper("pairs", pairs, lim, lpr);
    printf("  [");
    for (i = 0; i < lpr; ++i) {
        printArray(last_pr[i], 2);
        printf("\b] ");
    }
    printf("\b]\n\n");

    printHelper("triplets", trips, lim, ltr);
    printf("  [");
    for (i = 0; i < ltr; ++i) {
        printArray(last_tr[i], 3);
        printf("\b] ");
    }
    printf("\b]\n\n");

    printHelper("quadruplets", quads, lim, lqd);
    printf("  [");
    for (i = 0; i < lqd; ++i) {
        printArray(last_qd[i], 4);
        printf("\b] ");
    }
    printf("\b]\n\n");

    printHelper("quintuplets", quins, lim, lqn);
    printf("  [");
    for (i = 0; i < lqn; ++i) {
        printArray(last_qn[i], 5);
        printf("\b] ");
    }
    printf("\b]\n\n");

    printHelper("unsexy primes", unsexy, lim, lun);
    printf("  [");
    printArray(last_un, lun);
    printf("\b]\n");
    free(sv);
    return 0;
}


#include <array>
#include <iostream>
#include <vector>
#include <boost/circular_buffer.hpp>
#include "prime_sieve.hpp"

int main() {
    using std::cout;
    using std::vector;
    using boost::circular_buffer;
    using group_buffer = circular_buffer<vector<int>>;

    const int max = 1000035;
    const int max_group_size = 5;
    const int diff = 6;
    const int array_size = max + diff;
    const int max_groups = 5;
    const int max_unsexy = 10;

    // Use Sieve of Eratosthenes to find prime numbers up to max
    prime_sieve sieve(array_size);

    std::array<int, max_group_size> group_count{0};
    vector<group_buffer> groups(max_group_size, group_buffer(max_groups));
    int unsexy_count = 0;
    circular_buffer<int> unsexy_primes(max_unsexy);
    vector<int> group;

    for (int p = 2; p < max; ++p) {
        if (!sieve.is_prime(p))
            continue;
        if (!sieve.is_prime(p + diff) && (p - diff < 2 || !sieve.is_prime(p - diff))) {
            // if p + diff and p - diff aren't prime then p can't be sexy
            ++unsexy_count;
            unsexy_primes.push_back(p);
        } else {
            // find the groups of sexy primes that begin with p
            group.clear();
            group.push_back(p);
            for (int group_size = 1; group_size < max_group_size; group_size++) {
                int next_p = p + group_size * diff;
                if (next_p >= max || !sieve.is_prime(next_p))
                    break;
                group.push_back(next_p);
                ++group_count[group_size];
                groups[group_size].push_back(group);
            }
        }
    }

    for (int size = 1; size < max_group_size; ++size) {
        cout << "number of groups of size " << size + 1 << " is " << group_count[size] << '\n';
        cout << "last " << groups[size].size() << " groups of size " << size + 1 << ":";
        for (const vector<int>& group : groups[size]) {
            cout << " (";
            for (size_t i = 0; i < group.size(); ++i) {
                if (i > 0)
                    cout << ' ';
                cout << group[i];
            }
            cout << ")";
        }
        cout << "\n\n";
    }
    cout << "number of unsexy primes is " << unsexy_count << '\n';
    cout << "last " << unsexy_primes.size() << " unsexy primes:";
    for (int prime : unsexy_primes)
        cout << ' ' << prime;
    cout << '\n';
    return 0;
}


// Sexy primes. Nigel Galloway: October 2nd., 2018
let n=pCache |> Seq.takeWhile(fun n->n<1000035) |> Seq.filter(fun n->(not (isPrime(n+6)) && (not isPrime(n-6))))) |> Array.ofSeq
printfn "There are %d unsexy primes less than 1,000,035. The last 10 are:" n.Length
Array.skip (n.Length-10) n |> Array.iter(fun n->printf "%d " n); printfn ""
let ni=pCache |> Seq.takeWhile(fun n->n<1000035) |> Seq.filter(fun n->isPrime(n-6)) |> Array.ofSeq
printfn "There are %d sexy prime pairs all components of which are less than 1,000,035. The last 5 are:" ni.Length
Array.skip (ni.Length-5) ni |> Array.iter(fun n->printf "(%d,%d) " (n-6) n); printfn ""
let nig=ni |> Array.filter(fun n->isPrime(n-12))
printfn "There are %d sexy prime triplets all components of which are less than 1,000,035. The last 5 are:" nig.Length
Array.skip (nig.Length-5) nig |> Array.iter(fun n->printf "(%d,%d,%d) " (n-12) (n-6) n); printfn ""
let nige=nig |> Array.filter(fun n->isPrime(n-18))
printfn "There are %d sexy prime quadruplets all components of which are less than 1,000,035. The last 5 are:" nige.Length
Array.skip (nige.Length-5) nige |> Array.iter(fun n->printf "(%d,%d,%d,%d) " (n-18) (n-12) (n-6) n); printfn ""
let nigel=nige |> Array.filter(fun n->isPrime(n-24))
printfn "There are %d sexy prime quintuplets all components of which are less than 1,000,035. The last 5 are:" nigel.Length
Array.skip (nigel.Length-5) nigel |> Array.iter(fun n->printf "(%d,%d,%d,%d,%d) " (n-24) (n-18) (n-12) (n-6) n); printfn ""


USING: combinators.short-circuit fry interpolate io kernel
literals locals make math math.primes math.ranges prettyprint qw
sequences tools.memory.private ;
IN: rosetta-code.sexy-primes

CONSTANT: limit 1,000,035
CONSTANT: primes $[ limit primes-upto ]
CONSTANT: tuplet-names qw{ pair triplet quadruplet quintuplet }

: tuplet ( m n -- seq ) dupd 1 - 6 * + 6 <range> ;

: viable-tuplet? ( seq -- ? )
    [ [ prime? ] [ limit < ] bi and ] all? ;

: sexy-tuplets ( n -- seq ) [ primes ] dip '[
        [ _ tuplet dup viable-tuplet? [ , ] [ drop ] if ] each
    ] { } make ;

: ?last5 ( seq -- seq' ) 5 short tail* ;

: last5 ( seq -- str )
    ?last5 [ { } like unparse ] map " " join ;

:: tuplet-info ( n -- last5 l5-len num-tup limit tuplet-name )
    n sexy-tuplets :> tup tup last5 tup ?last5 length tup length
    commas limit commas n 2 - tuplet-names nth ;

: show-tuplets ( n -- )
    tuplet-info
    [I Number of sexy prime ${0}s < ${1}: ${2}I] nl
    [I Last ${0}: ${1}I] nl nl ;

: unsexy-primes ( -- seq ) primes [
        { [ 6 + prime? not ] [ 6 - prime? not ] } 1&&
    ] filter ;

: show-unsexy ( -- )
    unsexy-primes dup length commas limit commas
    [I Number of unsexy primes < ${0}: ${1}I] nl
    "Last 10: " write 10 short tail* [ pprint bl ] each nl ;

: main ( -- ) 2 5 [a,b] [ show-tuplets ] each show-unsexy ;

MAIN: main


Function isPrime(Byval ValorEval As Uinteger) As Boolean
    If ValorEval < 2 Then Return False
    If ValorEval Mod 2 = 0 Then Return ValorEval = 2
    If ValorEval Mod 3 = 0 Then Return ValorEval = 3
    Dim d As Integer = 5
    While d * d <= ValorEval
        If ValorEval Mod d = 0 Then Return False Else d += 2
        If ValorEval Mod d = 0 Then Return False Else d += 4
    Wend
    Return True
End Function

#define maxi  1000035
Dim As Integer CU = 0, C2 = 0, C3 = 0, C4 = 0, C5 = 0, N, I, P = 0
Dim As Integer Unsexy(10), Pairs(5), Trips(5), Quads(5), Quins(5)

For N = maxi To 2 Step -1
    If isPrime(N) Then
        P += 1
        If Not isPrime(N-6) And Not isPrime(N+6) Then
            If CU < 10 Then Unsexy(CU) = N
            CU += 1
        End If
        If isPrime(N-6) Then
            If C2 < 5 Then Pairs(C2) = N
            C2 += 1
            If isPrime(N-12) Then
                If C3 < 5 Then Trips(C3) = N
                C3 += 1
                If isPrime(N-18) Then
                    If C4 < 5 Then Quads(C4) = N
                    C4 += 1
                    If isPrime(N-24) Then
                        If C5 < 5 Then Quins(C5) = N
                        C5 += 1
                    End If
                End If
            End If
        End If
    End If
Next N

Print P; " primes less than"; maxi

Print Chr(10); C2; " pairs ending with:"
For I = 4 To 0 Step -1
    Print "  [" & Pairs(I)-6 & ", "& Pairs(I) & "]"
Next I

Print Chr(10); C3; " triplets ending with:"
For I = 4 To 0 Step -1
    Print "  [" & Trips(I)-12 & ", "& Trips(I)-6 & ", "& Trips(I) & "]"
Next I

Print Chr(10); C4; " quadruplets ending with:"
For I = 4 To 0 Step -1
    Print "  [" & Quads(I)-18 & ", "& Quads(I)-12 & ", "& Quads(I)-6 & ", "& Quads(I) & "]"
Next I

Print Chr(10); C5; " quintuplet(s) ending with:"
I = Iif(C5 > 5, 5, C5)
For I = I-1 To 0 Step -1
    Print "  [" & Quins(I)-24 & ", "& Quins(I)-18 & ", "& Quins(I)-12 & ", "& Quins(I)-6 & ", "& Quins(I) & "]"
Next I

Print Chr(10); CU; " unsexy primes ending with:"
For I = 9 To 0 Step -1
    Print Unsexy(I); ",";
Next I
Print Chr(8); " "
Sleep


package main

import "fmt"

func sieve(limit int) []bool {
    limit++
    // True denotes composite, false denotes prime.
    c := make([]bool, limit) // all false by default
    c[0] = true
    c[1] = true
    // no need to bother with even numbers over 2 for this task
    p := 3 // Start from 3.
    for {
        p2 := p * p
        if p2 >= limit {
            break
        }
        for i := p2; i < limit; i += 2 * p {
            c[i] = true
        }
        for {
            p += 2
            if !c[p] {
                break
            }
        }
    }
    return c
}

func commatize(n int) string {
    s := fmt.Sprintf("%d", n)
    if n < 0 {
        s = s[1:]
    }
    le := len(s)
    for i := le - 3; i >= 1; i -= 3 {
        s = s[0:i] + "," + s[i:]
    }
    if n >= 0 {
        return s
    }
    return "-" + s
}

func printHelper(cat string, le, lim, max int) (int, int, string) {
    cle, clim := commatize(le), commatize(lim)
    if cat != "unsexy primes" {
        cat = "sexy prime " + cat
    }
    fmt.Printf("Number of %s less than %s = %s\n", cat, clim, cle)
    last := max
    if le < last {
        last = le
    }
    verb := "are"
    if last == 1 {
        verb = "is"
    }
    return le, last, verb
}

func main() {
    lim := 1000035
    sv := sieve(lim - 1)
    var pairs [][2]int
    var trips [][3]int
    var quads [][4]int
    var quins [][5]int
    var unsexy = []int{2, 3}
    for i := 3; i < lim; i += 2 {
        if i > 5 && i < lim-6 && !sv[i] && sv[i-6] && sv[i+6] {
            unsexy = append(unsexy, i)
            continue
        }
        if i < lim-6 && !sv[i] && !sv[i+6] {
            pair := [2]int{i, i + 6}
            pairs = append(pairs, pair)
        } else {
            continue
        }
        if i < lim-12 && !sv[i+12] {
            trip := [3]int{i, i + 6, i + 12}
            trips = append(trips, trip)
        } else {
            continue
        }
        if i < lim-18 && !sv[i+18] {
            quad := [4]int{i, i + 6, i + 12, i + 18}
            quads = append(quads, quad)
        } else {
            continue
        }
        if i < lim-24 && !sv[i+24] {
            quin := [5]int{i, i + 6, i + 12, i + 18, i + 24}
            quins = append(quins, quin)
        }
    }
    le, n, verb := printHelper("pairs", len(pairs), lim, 5)
    fmt.Printf("The last %d %s:\n  %v\n\n", n, verb, pairs[le-n:])

    le, n, verb = printHelper("triplets", len(trips), lim, 5)
    fmt.Printf("The last %d %s:\n  %v\n\n", n, verb, trips[le-n:])

    le, n, verb = printHelper("quadruplets", len(quads), lim, 5)
    fmt.Printf("The last %d %s:\n  %v\n\n", n, verb, quads[le-n:])

    le, n, verb = printHelper("quintuplets", len(quins), lim, 5)
    fmt.Printf("The last %d %s:\n  %v\n\n", n, verb, quins[le-n:])

    le, n, verb = printHelper("unsexy primes", len(unsexy), lim, 10)
    fmt.Printf("The last %d %s:\n  %v\n\n", n, verb, unsexy[le-n:])
}