# returns TRUE if the specified directory is empty, FALSE if it doesn't exist or is non-empty #
PROC is empty directory = ( STRING directory )BOOL:
     IF NOT file is directory( directory )
     THEN
         # directory doesn't exist #
         FALSE
     ELSE
         # directory is empty if it contains no files or just "." and possibly ".." #
         []STRING files   = get directory( directory );
         BOOL     result := FALSE;
         FOR f FROM LWB files TO UPB files
         WHILE result := files[ f ] = "." OR files[ f ] = ".."
         DO
             SKIP
         OD;
         result
     FI # is empty directory # ;

# test the is empty directory procedure #
# show whether the directories specified on the command line ( following "-" ) are empty or not #
BOOL directory name parameter := FALSE;
FOR i TO argc DO
    IF argv( i ) = "-"
    THEN
        # marker to indicate directory names follow #
        directory name parameter := TRUE
    ELIF directory name parameter
    THEN
        # have a directory name - report whether it is emty or not #
        print( ( argv( i ), " is ", IF is empty directory( argv( i ) ) THEN "empty" ELSE "not empty" FI, newline ) )
    FI
OD


emptyDir?: function [folder]-> empty? list folder

print emptyDir? "."


MsgBox % isDir_empty(A_ScriptDir)?"true":"false"

isDir_empty(p) {
	Loop, %p%\* , 1
		return 0
	return 1
}


# syntax: GAWK -f EMPTY_DIRECTORY.AWK
BEGIN {
    n = split("C:\\TEMP3,C:\\NOTHERE,C:\\AWK\\FILENAME,C:\\WINDOWS",arr,",")
    for (i=1; i<=n; i++) {
      printf("'%s' %s\n",arr[i],is_dir(arr[i]))
    }
    exit(0)
}
function is_dir(path,  cmd,dots,entries,msg,rec,valid_dir) {
    cmd = sprintf("DIR %s 2>NUL",path) # MS-Windows
    while ((cmd | getline rec) > 0) {
      if (rec ~ /[0-9]:[0-5][0-9]/) {
        if (rec ~ / (\.|\.\.)$/) { # . or ..
          dots++
          continue
        }
        entries++
      }
      if (rec ~ / Dir\(s\) .* bytes free$/) {
        valid_dir = 1
      }
    }
    close(cmd)
    if (valid_dir == 0) {
      msg = "does not exist"
    }
    else if (valid_dir == 1 && entries == 0) {
      msg = "is an empty directory"
    }
    else if (dots == 0 && entries == 1) {
      msg = "is a file"
    }
    else {
      msg = sprintf("is a directory with %d entries",entries)
    }
    return(msg)
}


FUNCTION check$(dir$)

    IF FILEEXISTS(dir$) THEN
        RETURN IIF$(LEN(WALK$(dir$, 127, ".+", FALSE)), " is NOT empty.", " is empty." )
    ELSE
        RETURN " doesn't exist."
    ENDIF

ENDFUNCTION

dir$ = "bla"
PRINT "Directory '", dir$, "'", check$(dir$)

dir$ = "/mnt"
PRINT "Directory '", dir$, "'", check$(dir$)

dir$ = "."
PRINT "Directory '", dir$, "'", check$(dir$)


@echo off
if "%~1"=="" exit /b 3
set "samp_path=%~1"
set "tst_var="

	%== Store the current directory of the CMD ==%
for /f %%T in ('cd') do set curr_dir=%%T

	%== Go to the samp_path ==%
cd %samp_path% 2>nul ||goto :folder_not_found

	%== The current directory is now samp_path ==%
	%== Scan what is inside samp_path ==%
for /f "usebackq delims=" %%D in (
	`dir /b 2^>nul ^& dir /b /ah 2^>nul`
) do set "tst_var=1"

if "%tst_var%"=="1" (
	echo "%samp_path%" is NOT empty.
	cd %curr_dir%
	exit /b 1
) else (
	echo "%samp_path%" is empty.
	cd %curr_dir%
	exit /b 0
)

:folder_not_found
echo Folder not found.
exit /b 2


      IF FNisdirectoryempty("C:\") PRINT "C:\ is empty" ELSE PRINT "C:\ is not empty"
      IF FNisdirectoryempty("C:\temp") PRINT "C:\temp is empty" ELSE PRINT "C:\temp is not empty"
      END

      DEF FNisdirectoryempty(dir$)
      LOCAL dir%, sh%, res%
      DIM dir% LOCAL 317
      IF RIGHT$(dir$)<>"\" dir$ += "\"
      SYS "FindFirstFile", dir$+"*", dir% TO sh%
      IF sh% = -1 ERROR 100, "Directory doesn't exist"
      res% = 1
      REPEAT
        IF $$(dir%+44)<>"." IF $$(dir%+44)<>".." EXIT REPEAT
        SYS "FindNextFile", sh%, dir% TO res%
      UNTIL res% == 0
      SYS "FindClose", sh%
      = (res% == 0)


#include <stdio.h>
#include <dirent.h>
#include <string.h>

int dir_empty(const char *path)
{
	struct dirent *ent;
	int ret = 1;

	DIR *d = opendir(path);
	if (!d) {
		fprintf(stderr, "%s: ", path);
		perror("");
		return -1;
	}

	while ((ent = readdir(d))) {
		if (!strcmp(ent->d_name, ".") || !(strcmp(ent->d_name, "..")))
			continue;
		ret = 0;
		break;
	}

	closedir(d);
	return ret;
}

int main(int c, char **v)
{
	int ret = 0, i;
	if (c < 2) return -1;

	for (i = 1; i < c; i++) {
		ret = dir_empty(v[i]);
		if (ret >= 0)
			printf("%s: %sempty\n", v[i], ret ? "" : "not ");
	}

	return 0;
}


using System;
using System.IO;

class Program
{
    static void Main( string[] args )
    {
        foreach ( string dir in args )
        {
            Console.WriteLine( "'{0}' {1} empty", dir, IsDirectoryEmpty( dir ) ? "is" : "is not" );
        }
    }

    private static bool IsDirectoryEmpty( string dir )
    {
        return ( Directory.GetFiles( dir ).Length == 0 &&
            Directory.GetDirectories( dir ).Length == 0 );
    }
}


#include <iostream>
#include <boost/filesystem.hpp>

using namespace boost::filesystem;

int main(int argc, char *argv[])
{
    for (int i = 1; i < argc; ++i) {
        path p(argv[i]);

        if (exists(p) && is_directory(p))
            std::cout << "'" << argv[i] << "' is" << (!is_empty(p) ? " not" : "") << " empty\n";
        else
            std::cout << "dir '" << argv[i] << "' could not be found\n";
    }
}


(require '[clojure.java.io :as io])
(defn empty-dir? [path]
  (let [file (io/file path)]
    (assert (.exists file))
    (assert (.isDirectory file))
    (-> file .list empty?))) ; .list ignores "." and ".."


fs = require 'fs'

is_empty_dir = (dir) ->
  throw Error "#{dir} is not a dir" unless fs.statSync(dir).isDirectory()
  # readdirSync does not return . or ..
  fns = fs.readdirSync dir
  fns.length == 0


(defun empty-directory-p (path)
  (and (null (directory (concatenate 'string path "/*")))
       (null (directory (concatenate 'string path "/*/")))))


import std.stdio, std.file;

void main() {
    auto dir = "somedir";
    writeln(dir ~ " is empty: ", dirEmpty(dir));
}

bool dirEmpty(string dirname) {
    if (!exists(dirname) || !isDir(dirname))
        throw new Exception("dir not found: " ~ dirname);
    return dirEntries(dirname, SpanMode.shallow).empty;
}


program Empty_directory;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.IOUtils;

function IsDirectoryEmpty(dir: string): Boolean;
var
  count: Integer;
begin
  count := Length(TDirectory.GetFiles(dir)) + Length(TDirectory.GetDirectories(dir));
  Result := count = 0;
end;

var
  i: Integer;

const
  CHECK: array[Boolean] of string = (' is not', ' is');

begin
  if ParamCount > 0 then
    for i := 1 to ParamCount do
      Writeln(ParamStr(i), CHECK[IsDirectoryEmpty(ParamStr(i))], ' empty');
  Readln;
end.


path = hd(System.argv)
IO.puts File.dir?(path) and Enum.empty?( File.ls!(path) )


3> {ok, []} = file:list_dir_all("/usr").
** exception error: no match of right hand side value
                    {ok,["X11R6","X11","standalone","share","sbin","local",
                         "libexec","lib","bin"]}
4> {ok, []} = file:list_dir_all("/asd").
** exception error: no match of right hand side value {error,enoent}
5> {ok, []} = file:list_dir_all("./empty").
{ok,[]}


open System.IO
let isEmptyDirectory x = (Directory.GetFiles x).Length = 0 && (Directory.GetDirectories x).Length = 0


USE: io.directories
: empty-directory? ( path -- ? ) directory-entries empty? ;


' FB 1.05.0 Win64

#Include "dir.bi"

Function IsDirEmpty(dirPath As String) As Boolean
  Err = 0
  ' check dirPath is a valid directory
  Dim As String fileName = Dir(dirPath, fbDirectory)
  If Len(fileName) = 0 Then
    Err = 1000  ' dirPath is not a valid path
    Return False
  End If
  ' now check if there are any files/subdirectories in it other than . and ..
  Dim fileSpec As String = dirPath + "\*.*"
  Const attribMask = fbNormal Or fbHidden Or fbSystem Or fbDirectory
  Dim outAttrib As UInteger
  fileName = Dir(fileSpec, attribMask, outAttrib)  ' get first file
  Do
    If fileName <> ".." AndAlso fileName <> "." Then
      If Len(fileName) = 0 Then Return True
      Exit Do
    End If
    fileName = Dir  ' get next file
  Loop
  Return False
End Function

Dim outAttrib As UInteger
Dim dirPath As String = "c:\freebasic\docs"  ' known to be empty
Dim empty As Boolean = IsDirEmpty(dirPath)
Dim e As Long = Err
If e = 1000 Then
  Print "'"; dirPath; "' is not a valid directory"
  End
End If
If empty Then
  Print "'"; dirPath; "' is empty"
Else
  Print "'"; dirPath; "' is not empty"
End If
Print
Print "Press any key to quit"
Sleep


Public Sub Main()
Dim sFolder As String = User.home &/ "Rosetta"
Dim sDir As String[] = Dir(sFolder)
Dim sTemp As String
Dim sOutput As String = sfolder & " is NOT empty"

Try sTemp = sDir[0]
If Error Then sOutput = sfolder & " is empty"

Print sOutput

End


package main

import (
	"fmt"
	"io/ioutil"
	"log"
)

func main() {
	empty, err := IsEmptyDir("/tmp")
	if err != nil {
		log.Fatalln(err)
	}
	if empty {
		fmt.Printf("/tmp is empty\n")
	} else {
		fmt.Printf("/tmp is not empty\n")
	}
}

func IsEmptyDir(name string) (bool, error) {
	entries, err := ioutil.ReadDir(name)
	if err != nil {
		return false, err
	}
	return len(entries) == 0, nil
}


def isDirEmpty = { dirName ->
    def dir = new File(dirName)
    dir.exists() && dir.directory && (dir.list() as List).empty
}


import System.Directory (getDirectoryContents)
import System.Environment (getArgs)

isEmpty x = getDirectoryContents x >>= return . f . (== [".", ".."])
    where f True = "Directory is empty"
          f False = "Directory is not empty"

main = getArgs >>= isEmpty . (!! 0) >>= putStrLn


procedure main()
   every dir := "." | "./empty" do
      write(dir, if isdirempty(dir) then " is empty" else " is not empty")
end

procedure isdirempty(s)  #: succeeds if directory s is empty (and a directory)
local d,f
   if ( stat(s).mode ? ="d" ) & ( d := open(s) ) then {
         while f := read(d) do
            if f == ("."|"..") then next else fail
         close(d)
         return s
         }
   else stop(s," is not a directory or will not open")
end


require 'dir'
empty_dir=: 0 = '/*' #@[email protected],~ ]


import java.nio.file.Paths;
//... other class code here
public static boolean isEmptyDir(String dirName){
    return Paths.get(dirName).toFile().listFiles().length == 0;
}


// Node.js v14.15.4
const { readdirSync } = require("fs");
const emptydir = (path) => readdirSync(path).length == 0;

// tests, run like node emptydir.js [directories]
for (let i = 2; i < process.argv.length; i ++) {
  let dir = process.argv[i];
  console.log(`${dir}: ${emptydir(dir) ? "" : "not "}empty`)
}


# v0.6.0
isemptydir(dir::AbstractString) = isempty(readdir(dir))

@show isemptydir(".")
@show isemptydir("/home")


// version 1.1.4

import java.io.File

fun main(args: Array<String>) {
    val dirPath = "docs" // or whatever
    val isEmpty = (File(dirPath).list().isEmpty())
    println("$dirPath is ${if (isEmpty) "empty" else "not empty"}")
}


dir('has_content') -> isEmpty
'<br />'
dir('no_content') -> isEmpty


dim info$(10, 10)
files "c:\", info$()

qtyFiles=val(info$(0,0))
n = qtyFiles+1  'begin directory info

folder$ = info$(n,0)  'path to first directory in c:

files folder$, info$() 're-fill array with data from sub folder

if val(info$(0,0)) + val(info$(0, 1)) <> 0 then
    print "Folder ";folder$;" is not empty."
else
    print "Folder ";folder$;" is empty."
end if


on isDirEmpty (dir)
  return getNthFileNameInFolder(dir, 1) = EMPTY
end


function scandir(directory)
	local i, t, popen = 0, {}, io.popen
	local pfile = popen('ls -a "'..directory..'"')
	for filename in pfile:lines() do
		if filename ~= '.' and filename ~= '..' then
			i = i + 1
			t[i] = filename
		end
	end
	pfile:close()
	return t
end

function isemptydir(directory)
	return #scandir(directory) == 0
end


emptydirectory := proc (dir)
is(listdir(dir) = [".", ".."]);
end proc;


EmptyDirectoryQ[x_] := (SetDirectory[x]; If[FileNames[] == {}, True, False])

Example use:
EmptyDirectoryQ["C:\\Program Files\\Wolfram Research\\Mathematica\\9"]
->True


  function x = isEmptyDirectory(p)
    if isdir(p)
      f = dir(p)
      x = length(f)>2;
    else
      error('Error: %s is not a directory');
    end;
  end;


C:\>rd GAMES
Unable to remove: GAMES.

C:\>


def isempty(dirname)
        return len(new(Nanoquery.IO.File).listDir(dirname)) = 0
end


using System.IO;
using System.Console;

module EmptyDirectory
{
    IsDirectoryEmpty(dir : string) : bool
    {
        Directory.GetFileSystemEntries(dir).Length == 0
    }

    Main(args : array[string]) : void
    {
        foreach (dir in args) {
            when (Directory.Exists(dir)) {
                WriteLine("{0} {1} empty.", dir, if (IsDirectoryEmpty(dir))  "is" else "is not");
            }
        }
    }
}


(define (empty-dir? path-to-check)
	(empty? (clean (lambda (x) (or (= "." x) (= ".." x))) (directory path-to-check)))
)


import os, rdstdin

var empty = true
for f in walkDir(readLineFromStdin "directory: "):
  empty = false
  break
echo empty


function : IsEmptyDirectory(dir : String) ~ Bool {
  return Directory->List(dir)->Size() = 0;
}


let is_dir_empty d =
  Sys.readdir d = [| |]


Call test 'D:\nodir'        /* no such directory      */
Call test 'D:\edir'         /* an empty directory     */
Call test 'D:\somedir'      /* directory with 2 files */
Call test 'D:\somedir','S'  /* directory with 3 files */
Exit
test: Parse Arg fd,nest
If SysIsFileDirectory(fd)=0 Then
  Say 'Directory' fd 'not found'
Else Do
  ret=SysFileTree(fd'\*.*','X', 'F'nest)
  If x.0=0 Then
    say 'Directory' fd 'is empty'
  Else Do
    If nest='' Then
      say 'Directory' fd 'contains' x.0 'files'
    Else
      say 'Directory' fd 'contains' x.0 'files (some nested)'
    End
  End
Return


program emptyDirectory(input, output);

type
	path = string(1024);

{
	\brief determines whether a (hierarchial FS) directory is empty

	\param accessVia a possible route to access a directory
	\return whether \param accessVia is an empty directory
}
function isEmptyDirectory(protected accessVia: path): Boolean;
var
	{ NB: `file` data types without a domain type are non-standard }
	directory: bindable file;
	FD: bindingType;
begin
	{ initialize variables }
	unbind(directory);
	FD := binding(directory);

	FD.name := accessVia;
	{ binding to directories is usually not possible }
	FD.force := true;

	{ the actual test }
	bind(directory, FD);
	FD := binding(directory);
	unbind(directory);

	isEmptyDirectory := FD.bound and FD.directory and (FD.links <= 2)
end;

{ === MAIN ============================================================= }
var
	s: path;
begin
	readLn(s);
	writeLn(isEmptyDirectory(s))
end.


without js -- file i/o
procedure test(string filename)
    string msg
    switch get_file_type(filename) do
        case FILETYPE_UNDEFINED: msg = "is UNDEFINED"
        case FILETYPE_NOT_FOUND: msg = "is NOT_FOUND"
        case FILETYPE_FILE:      msg = "is a FILE"
        case FILETYPE_DIRECTORY:
            integer count = length(filter(vslice(dir(filename),D_NAME),"out",{".",".."}))
            msg = iff(count=0?"is an empty directory"
                             :sprintf("is a directory containing %d files",{count}))
    end switch
    printf(1,"%s %s\n",{filename,msg})
end procedure

constant tests = {"C:\\xx","C:\\not_there","C:\\Program Files (x86)\\Phix\\p.exe","C:\\Windows"}
for i=1 to length(tests) do
    test(tests[i])
end for


$dir = 'path_here';

if(is_dir($dir)){
  //scandir grabs the contents of a directory and array_diff is being used to filter out .. and .
  $list = array_diff(scandir($dir), array('..', '.'));
  //now we can just use empty to check if the variable has any contents regardless of it's type
  if(empty($list)){
    echo 'dir is empty';
  }
  else{
    echo 'dir is not empty';
  }
}
else{
  echo 'not a directory';
}


(prinl "myDir is" (and (dir "myDir") " not") " empty")


$path = "C:\Users"
if((Dir $path).Count -eq 0) {
    "$path is empty"
} else {
    "$path is not empty"
}


non_empty_file('.').
non_empty_file('..').

empty_dir(Dir) :-
	directory_files(Dir, Files),
	maplist(non_empty_file, Files).


Procedure isDirEmpty(path$)
  If Right(path$, 1) <> "\": path$ + "\": EndIf
  Protected dirID = ExamineDirectory(#PB_Any, path$, "*.*")
  Protected result

  If dirID
    result = 1
    While NextDirectoryEntry(dirID)
      If DirectoryEntryType(dirID) = #PB_DirectoryEntry_File Or (DirectoryEntryName(dirID) <> "." And DirectoryEntryName(dirID) <> "..")
        result = 0
        Break
      EndIf
    Wend
    FinishDirectory(dirID)
  EndIf
  ProcedureReturn result
EndProcedure

Define path$, result$

path$ = PathRequester("Choose a path", "C:\")
If path$
  If isDirEmpty(path$)
    result$ = " is empty."
  Else
    result$ = " is not empty."
  EndIf
  MessageRequester("Empty directory test", #DQUOTE$ + path$ + #DQUOTE$ + result$)
EndIf


import os;
if os.listdir(raw_input("directory")):
    print "not empty"
else:
    print "empty"


  is_dir_empty <- function(path){
    if(length(list.files(path)) == 0)
      print("This folder is empty")
  }

  is_dir_empty(path)


#lang racket
(empty? (directory-list "some-directory"))


/*REXX pgm checks to see if a directory is empty; if not, lists entries.*/
parse arg xdir;  if xdir='' then xdir='\someDir' /*Any DIR? Use default.*/
@.=0                                   /*default in case ADDRESS fails. */
trace off                              /*suppress REXX err msg for fails*/
address system 'DIR' xdir '/b' with output stem @.  /*issue the DIR cmd.*/
if rc\==0  then do                                  /*an error happened?*/
                say '***error!*** from DIR' xDIR    /*indicate que pasa.*/
                say 'return code='  rc              /*show the ret Code.*/
                exit rc                             /*exit with the  RC.*/
                end                                 /* [↑]  bad address.*/
#[email protected].rc                                              /*number of entries.*/
if #==0  then #='   no   '                          /*use a word, ¬zero.*/
say center('directory ' xdir " has "     #     ' entries.',79,'─')
exit @.0+rc                            /*stick a fork in it, we're done.*/


myList = dir("C:\Ring\bin")
if len(myList) > 0 see "C:\Ring\bin is not empty" + nl
else see "C:\Ring\bin is empty" + nl ok


files #f, DefaultDir$ + "\*.*"         ' open some directory.

print "hasanswer: ";#f HASANSWER()     ' if it has an answer it is not MT
print "rowcount:  ";#f ROWCOUNT()      ' if not MT, how many files?


use std::fs::read_dir;
use std::error::Error;

fn main() {
    for path in std::env::args().skip(1) { // iterate over the arguments, skipping the first (which is the executable)
        match read_dir(path.as_str()) { // try to read the directory specified
            Ok(contents) => {
                let len = contents.collect::<Vec<_>>().len(); // calculate the amount of items in the directory
                if len == 0 {
                    println!("{} is empty", path);
                } else {
                    println!("{} is not empty", path);
                }
            },
            Err(e) => { // If the attempt failed, print the corresponding error msg
                println!("Failed to read directory \"{}\": {}", path, e.description());
            }
        }
    }
}


import java.io.File

def isDirEmpty(file:File) : Boolean =
   return file.exists && file.isDirectory && file.list.isEmpty


$ include "seed7_05.s7i";
  include "osfiles.s7i";

const func boolean: dirEmpty (in string: dirName) is
  return fileType(dirName) = FILE_DIR and length(readDir(dirName)) = 0;

const proc: main is func
  begin
    writeln(dirEmpty("somedir"));
  end func;


put the temporary folder & "NewFolder" into newFolderPath
make folder newFolderPath -- create a new empty directory

if the filesAndFolders in newFolderPath is empty then
	put "Directory " & newFolderPath & " is empty!"
else
	put "Something is present in " & newFolderPath
end if


Dir.new('/my/dir').is_empty;    # true, false or nil


fun isDirEmpty(path: string) =
  let
    val dir = OS.FileSys.openDir path
    val dirEntryOpt = OS.FileSys.readDir dir
  in
    (
      OS.FileSys.closeDir(dir);
      case dirEntryOpt of
        NONE => true
      | _    => false
    )
  end;


proc isEmptyDir {dir} {
    # Get list of _all_ files in directory
    set filenames [glob -nocomplain -tails -directory $dir * .*]
    # Check whether list is empty (after filtering specials)
    expr {![llength [lsearch -all -not -regexp $filenames {^\.\.?$}]]}
}


#!/bin/sh
DIR=/tmp/foo
[ `ls -a $DIR|wc -l` -gt 2 ]  && echo $DIR is NOT empty || echo $DIR is empty


Sub Main()
    Debug.Print IsEmptyDirectory("C:\Temp")
    Debug.Print IsEmptyDirectory("C:\Temp\")
End Sub

Private Function IsEmptyDirectory(D As String) As Boolean
Dim Sep As String
    Sep = Application.PathSeparator
    D = IIf(Right(D, 1) <> Sep, D & Sep, D)
    IsEmptyDirectory = (Dir(D & "*.*") = "")
End Function


Function IsDirEmpty(path)
	IsDirEmpty = False
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFSO.GetFolder(path)
	If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then
		IsDirEmpty = True
	End If
End Function

'Test
WScript.StdOut.WriteLine IsDirEmpty("C:\Temp")
WScript.StdOut.WriteLine IsDirEmpty("C:\Temp\test")


import "io" for Directory

var isEmptyDir = Fn.new { |path|
    if (!Directory.exists(path)) Fiber.abort("Directory at '%(path)' does not exist.")
    return Directory.list(path).count == 0
}

var path = "test"
var empty = isEmptyDir.call(path)
System.print("'%(path)' is %(empty ? "empty" : "not empty")")


path:="Empty"; File.isDir(path).println();
File.mkdir(path); File.isDir(path).println();
File.glob(path+"/*").println(); // show contents of directory


/*
subject: Elliptic curve digital signature algorithm,
         toy version for small modulus N.
tested : gcc 4.6.3, tcc 0.9.27
*/
#include <stdio.h>
#include <stdlib.h>
#include <time.h>

// 64-bit integer type
typedef long long int dlong;
// rational ec point
typedef struct {
   dlong x, y;
} epnt;
// elliptic curve parameters
typedef struct {
   long a, b;
   dlong N;
   epnt G;
   dlong r;
} curve;
// signature pair
typedef struct {
   long a, b;
} pair;

// dlong for holding intermediate results,
// long variables in exgcd() for efficiency,
// maximum parameter size 2 * p.y (line 129)
// limits the modulus size to 30 bits.

// maximum modulus
const long mxN = 1073741789;
// max order G = mxN + 65536
const long mxr = 1073807325;
// symbolic infinity
const long inf = -2147483647;

// single global curve
curve e;
// point at infinity zerO
epnt zerO;
// impossible inverse mod N
int inverr;

// return mod(v^-1, u)
long exgcd (long v, long u)
{
register long q, t;
long r = 0, s = 1;
if (v < 0) v += u;

   while (v) {
      q = u / v;
      t = u - q * v;
      u = v; v = t;
      t = r - q * s;
      r = s; s = t;
   }
   if (u != 1) {
      printf (" impossible inverse mod N, gcd = %d\n", u);
      inverr = 1;
   }
return r;
}

// return mod(a, N)
static inline dlong modn (dlong a)
{
   a %= e.N;
   if (a < 0) a += e.N;
return a;
}

// return mod(a, r)
dlong modr (dlong a)
{
   a %= e.r;
   if (a < 0) a += e.r;
return a;
}

// return the discriminant of E
long disc (void)
{
dlong c, a = e.a, b = e.b;
   c = 4 * modn(a * modn(a * a));
return modn(-16 * (c + 27 * modn(b * b)));
}

// return 1 if P = zerO
int isO (epnt p)
{
return (p.x == inf) && (p.y == 0);
}

// return 1 if P is on curve E
int ison (epnt p)
{
long r, s;
if (! isO (p)) {
   r = modn(e.b + p.x * modn(e.a + p.x * p.x));
   s = modn(p.y * p.y);
}
return (r == s);
}

// full ec point addition
void padd (epnt *r, epnt p, epnt q)
{
dlong la, t;

if (isO(p)) {*r = q; return;}
if (isO(q)) {*r = p; return;}

if (p.x != q.x) {                    // R:= P + Q
   t = p.y - q.y;
   la = modn(t * exgcd(p.x - q.x, e.N));
}
else                                 // P = Q, R := 2P
   if ((p.y == q.y) && (p.y != 0)) {
      t = modn(3 * modn(p.x * p.x) + e.a);
      la = modn(t * exgcd (2 * p.y, e.N));
   }
   else
      {*r = zerO; return;}           // P = -Q, R := O

t = modn(la * la - p.x - q.x);
r->y = modn(la * (p.x - t) - p.y);
r->x = t; if (inverr) *r = zerO;
}

// R:= multiple kP
void pmul (epnt *r, epnt p, long k)
{
epnt s = zerO, q = p;

   for (; k; k >>= 1) {
      if (k & 1) padd(&s, s, q);
      if (inverr) {s = zerO; break;}
      padd(&q, q, q);
   }
*r = s;
}

// print point P with prefix f
void pprint (char *f, epnt p)
{
dlong y = p.y;

   if (isO (p))
      printf ("%s (0)\n", f);

   else {
      if (y > e.N - y) y -= e.N;
      printf ("%s (%lld, %lld)\n", f, p.x, y);
   }
}

// initialize elliptic curve
int ellinit (long i[])
{
long a = i[0], b = i[1];
   e.N = i[2]; inverr = 0;

if ((e.N < 5) || (e.N > mxN)) return 0;

   e.a = modn(a);
   e.b = modn(b);
   e.G.x = modn(i[3]);
   e.G.y = modn(i[4]);
   e.r = i[5];

if ((e.r < 5) || (e.r > mxr)) return 0;

printf ("\nE: y^2 = x^3 + %dx + %d", a, b);
printf (" (mod %lld)\n", e.N);
pprint ("base point G", e.G);
printf ("order(G, E) = %lld\n", e.r);

return 1;
}

// pseudorandom number [0..1)
double rnd(void)
{
return rand() / ((double)RAND_MAX + 1);
}

// signature primitive
pair signature (dlong s, long f)
{
long c, d, u, u1;
pair sg;
epnt V;

printf ("\nsignature computation\n");
do {
   do {
      u = 1 + (long)(rnd() * (e.r - 1));
      pmul (&V, e.G, u);
      c = modr(V.x);
   }
   while (c == 0);

   u1 = exgcd (u, e.r);
   d = modr(u1 * (f + modr(s * c)));
}
while (d == 0);
printf ("one-time u = %d\n", u);
pprint ("V = uG", V);

sg.a = c; sg.b = d;
return sg;
}

// verification primitive
int verify (epnt W, long f, pair sg)
{
long c = sg.a, d = sg.b;
long t, c1, h1, h2;
dlong h;
epnt V, V2;

   // domain check
   t = (c > 0) && (c < e.r);
   t &= (d > 0) && (d < e.r);
   if (! t) return 0;

printf ("\nsignature verification\n");
   h = exgcd (d, e.r);
   h1 = modr(f * h);
   h2 = modr(c * h);
   printf ("h1,h2 = %d, %d\n", h1,h2);
   pmul (&V, e.G, h1);
   pmul (&V2, W, h2);
   pprint ("h1G", V);
   pprint ("h2W", V2);
   padd (&V, V, V2);
   pprint ("+ =", V);
   if (isO (V)) return 0;
   c1 = modr(V.x);
   printf ("c' = %d\n", c1);

return (c1 == c);
}

// digital signature on message hash f, error bit d
void ec_dsa (long f, long d)
{
long i, s, t;
pair sg;
epnt W;

   // parameter check
   t = (disc() == 0);
   t |= isO (e.G);
   pmul (&W, e.G, e.r);
   t |= ! isO (W);
   t |= ! ison (e.G);
   if (t) goto errmsg;

printf ("\nkey generation\n");
   s = 1 + (long)(rnd() * (e.r - 1));
   pmul (&W, e.G, s);
   printf ("private key s = %d\n", s);
   pprint ("public key W = sG", W);

   // next highest power of 2 - 1
   t = e.r;
   for (i = 1; i < 32; i <<= 1)
      t |= t >> i;
   while (f > t) f >>= 1;
   printf ("\naligned hash %x\n", f);

   sg = signature (s, f);
   if (inverr) goto errmsg;
   printf ("signature c,d = %d, %d\n", sg.a, sg.b);

   if (d > 0) {
      while (d > t) d >>= 1;
      f ^= d;
      printf ("\ncorrupted hash %x\n", f);
   }

   t = verify (W, f, sg);
   if (inverr) goto errmsg;
   if (t)
      printf ("Valid\n_____\n");
   else
      printf ("invalid\n_______\n");

   return;

errmsg:
printf ("invalid parameter set\n");
printf ("_____________________\n");
}

void main (void)
{
typedef long eparm[6];
long d, f;
zerO.x = inf; zerO.y = 0;
srand(time(NULL));

// Test vectors: elliptic curve domain parameters,
// short Weierstrass model y^2 = x^3 + ax + b (mod N)
eparm *sp, sets[10] = {
//    a,   b,  modulus N, base point G, order(G, E), cofactor
   {355, 671, 1073741789, 13693, 10088, 1073807281},
   {  0,   7,   67096021,  6580,   779,   16769911}, // 4
   { -3,   1,     877073,     0,     1,     878159},
   {  0,  14,      22651,    63,    30,        151}, // 151
   {  3,   2,          5,     2,     1,          5},

// ecdsa may fail if...
// the base point is of composite order
   {  0,   7,   67096021,  2402,  6067,   33539822}, // 2
// the given order is a multiple of the true order
   {  0,   7,   67096021,  6580,   779,   67079644}, // 1
// the modulus is not prime (deceptive example)
   {  0,   7,     877069,     3, 97123,     877069},
// fails if the modulus divides the discriminant
   { 39, 387,      22651,    95,    27,      22651},
};
// Digital signature on message hash f,
// set d > 0 to simulate corrupted data
   f = 0x789abcde; d = 0;

   for (sp = sets; ; sp++) {
      if (ellinit (*sp))
         ec_dsa (f, d);

      else
         break;
   }
}


'subject: Elliptic curve digital signature algorithm,
'         toy version for small modulus N.
'tested : FreeBasic 1.05.0

'rational ec point
type epnt
   as longint x, y
end type
'elliptic curve parameters
type curve
   as long a, b
   as longint N
   as epnt G
   as longint r
end type
'signature pair
type pair
   as long a, b
end type

'longint for holding intermediate results,
'long variables in exgcd() for efficiency,
'maximum parameter size 2 * p.y (line 118)
'limits the modulus size to 30 bits.

'maximum modulus
const mxN = 1073741789
'max order G = mxN + 65536
const mxr = 1073807325
'symbolic infinity
const inf = -2147483647

'single global curve
dim shared as curve e
'point at infinity zerO
dim shared as epnt zerO
'impossible inverse mod N
dim shared as byte inverr

'return mod(v^-1, u)
Function exgcd (byval v as long, byval u as long) as long
dim as long q, t
dim as long r = 0, s = 1
if v < 0 then v += u

   while v
      q = u \ v
      t = u - q * v
      u = v: v = t
      t = r - q * s
      r = s: s = t
   wend

   if u <> 1 then
      print " impossible inverse mod N, gcd ="; u
      inverr = -1
   end if

exgcd = r
End Function

'return mod(a, N)
Function modn (byval a as longint) as longint
   a mod= e.N
   if a < 0 then a += e.N
modn = a
End Function

'return mod(a, r)
Function modr (byval a as longint) as longint
   a mod= e.r
   if a < 0 then a += e.r
modr = a
End Function

'return the discriminant of E
Function disc as long
dim as longint c, a = e.a, b = e.b
   c = 4 * modn(a * modn(a * a))
disc = modn(-16 * (c + 27 * modn(b * b)))
End Function

'return -1 if P = zerO
Function isO (byref p as epnt) as byte
isO = (p.x = inf and p.y = 0)
End Function

'return -1 if P is on curve E
Function ison (byref p as epnt) as byte
dim as long r, s
if not isO (p) then
   r = modn(e.b + p.x * modn(e.a + p.x * p.x))
   s = modn(p.y * p.y)
end if
ison = (r = s)
End Function

'full ec point addition
Sub padd (byref r as epnt, byref p as epnt, byref q as epnt)
dim as longint la, t

if isO (p) then r = q: exit sub
if isO (q) then r = p: exit sub

if p.x <> q.x then '                   R := P + Q
   t = p.y - q.y
   la = modn(t * exgcd (p.x - q.x, e.N))

else '                                 P = Q, R := 2P
   if (p.y = q.y) and (p.y <> 0) then
      t = modn(3 * modn(p.x * p.x) + e.a)
      la = modn(t * exgcd (2 * p.y, e.N))

   else
      r = zerO: exit sub '             P = -Q, R := O
   end if
end if

t = modn(la * la - p.x - q.x)
r.y = modn(la * (p.x - t) - p.y)
r.x = t: if inverr then r = zerO
End Sub

'R:= multiple kP
Sub pmul (byref r as epnt, byref p as epnt, byval k as long)
dim as epnt s = zerO, q = p

   while k
      if k and 1 then padd (s, s, q)
      if inverr then s = zerO: exit while
      k shr= 1: padd (q, q, q)
   wend
r = s
End Sub

'print point P with prefix f
Sub pprint (byref f as string, byref p as epnt)
dim as longint y = p.y

   if isO (p) then
      print f;" (0)"

   else
      if y > e.N - y then y -= e.N
      print f;" (";str(p.x);",";y;")"

   end if
End Sub

'initialize elliptic curve
Function ellinit (i() as long) as byte
dim as long a = i(0), b = i(1)
ellinit = 0: inverr = 0
   e.N = i(2)

if (e.N < 5) or (e.N > mxN) then exit function

   e.a = modn(a)
   e.b = modn(b)
   e.G.x = modn(i(3))
   e.G.y = modn(i(4))
   e.r = i(5)

if (e.r < 5) or (e.r > mxr) then exit function

print : ? "E: y^2 = x^3 + ";str(a);"x +";b;
print " (mod ";str(e.N);")"
pprint ("base point G", e.G)
print "order(G, E) ="; e.r

ellinit = -1
End Function

'signature primitive
Function signature (byval s as longint, byval f as long) as pair
dim as long c, d, u, u1
dim as pair sg
dim as epnt V

print : ? "signature computation"
do
   do
      u = 1 + int(rnd * (e.r - 1))
      pmul (V, e.G, u)
      c = modr(V.x)
   loop while c = 0

   u1 = exgcd (u, e.r)
   d = modr(u1 * (f + modr(s * c)))
loop while d = 0
print "one-time u ="; u
pprint ("V = uG", V)

sg.a = c: sg.b = d
signature = sg
End Function

'verification primitive
Function verify (byref W as epnt, byval f as long, byref sg as pair) as byte
dim as long c = sg.a, d = sg.b
dim as long t, c1, h1, h2
dim as longint h
dim as epnt V, V2
verify = 0

   'domain check
   t = (c > 0) and (c < e.r)
   t and= (d > 0) and (d < e.r)
   if not t then exit function

print : ? "signature verification"
   h = exgcd (d, e.r)
   h1 = modr(f * h)
   h2 = modr(c * h)
   print "h1,h2 ="; h1;",";h2
   pmul (V, e.G, h1)
   pmul (V2, W, h2)
   pprint ("h1G", V)
   pprint ("h2W", V2)
   padd (V, V, V2)
   pprint ("+ =", V)
   if isO (V) then exit function
   c1 = modr(V.x)
   print "c' ="; c1

verify = (c1 = c)
End Function

'digital signature on message hash f, error bit d
Sub ec_dsa (byval f as long, byval d as long)
dim as long i, s, t
dim as pair sg
dim as epnt W

   'parameter check
   t = (disc = 0)
   t or= isO (e.G)
   pmul (W, e.G, e.r)
   t or= not isO (W)
   t or= not ison (e.G)
   if t then goto errmsg

print : ? "key generation"
   s = 1 + int(rnd * (e.r - 1))
   pmul (W, e.G, s)
   print "private key s ="; s
   pprint ("public key W = sG", W)

   'next highest power of 2 - 1
   t = e.r: i = 1
   while i < 32
      t or= t shr i: i shl= 1
   wend
   while f > t
      f shr= 1: wend
   print : ? "aligned hash "; hex(f)

   sg = signature (s, f)
   if inverr then goto errmsg
   print "signature c,d ="; sg.a;",";sg.b

   if d > 0 then
      while d > t
         d shr= 1: wend
      f xor= d
      print : ? "corrupted hash "; hex(f)
   end if

   t = verify (W, f, sg)
   if inverr then goto errmsg
   if t then
      print "Valid" : ? "_____"
   else
      print "invalid" : ? "_______"
   end if

   exit sub

errmsg:
print "invalid parameter set"
print "_____________________"
End Sub

'main
dim as long d, f, t, eparm(5)
zerO.x = inf: zerO.y = 0
randomize timer

'Test vectors: elliptic curve domain parameters,
'short Weierstrass model y^2 = x^3 + ax + b (mod N)

'      a,   b,  modulus N, base point G, order(G, E), cofactor
data 355, 671, 1073741789, 13693, 10088, 1073807281
data   0,   7,   67096021,  6580,   779,   16769911 '   4
data  -3,   1,     877073,     0,     1,     878159
data   0,  14,      22651,    63,    30,        151 ' 151
data   3,   2,          5,     2,     1,          5

'ecdsa may fail if...
'the base point is of composite order
data   0,   7,   67096021,  2402,  6067,   33539822 '   2
'the given order is a multiple of the true order
data   0,   7,   67096021,  6580,   779,   67079644 '   1
'the modulus is not prime (deceptive example)
data   0,   7,     877069,     3, 97123,     877069
'fails if the modulus divides the discriminant
data  39, 387,      22651,    95,    27,      22651
data   0, 0, 0

'Digital signature on message hash f,
'set d > 0 to simulate corrupted data
f = &h789ABCDE : d = 0

do
   for t = 0 to 5
      read eparm(t): next

   if ellinit (eparm()) then
      ec_dsa (f, d)

   else
      exit do

   end if
loop

system


package main

import (
    "crypto/ecdsa"
    "crypto/elliptic"
    "crypto/rand"
    "crypto/sha256"
    "encoding/binary"
    "fmt"
    "log"
)

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

func main() {
    priv, err := ecdsa.GenerateKey(elliptic.P256(), rand.Reader)
    check(err)
    fmt.Println("Private key:\nD:", priv.D)
    pub := priv.Public().(*ecdsa.PublicKey)
    fmt.Println("\nPublic key:")
    fmt.Println("X:", pub.X)
    fmt.Println("Y:", pub.Y)

    msg := "Rosetta Code"
    fmt.Println("\nMessage:", msg)
    hash := sha256.Sum256([]byte(msg)) // as [32]byte
    hexHash := fmt.Sprintf("0x%x", binary.BigEndian.Uint32(hash[:]))
    fmt.Println("Hash   :", hexHash)

    r, s, err := ecdsa.Sign(rand.Reader, priv, hash[:])
    check(err)
    fmt.Println("\nSignature:")
    fmt.Println("R:", r)
    fmt.Println("S:", s)

    valid := ecdsa.Verify(&priv.PublicKey, hash[:], r, s)
    fmt.Println("\nSignature verified:", valid)
}


module ToyECDSA

using SHA

import Base.in, Base.==, Base.+, Base.*

export ECDSA_Key, ECDSA_Public_Key, genkey, ECDSA_sign, isverifiedECDSA

# T will be BigInt in most applications
struct CurveFP{T}
    p::T
    a::T
    b::T
    CurveFP(p, a::T, b::T) where T <: Number = new{T}(p, a, b)
end

struct PointEC{T}
    curve::CurveFP{T}
    x::T
    y::T
    order::Union{Number, Nothing}
    function PointEC(curve, x::T, y::T, order=nothing) where T <: Number
        @assert((x, y) in curve)
        new{T}(curve, x, y, order)
    end
end

struct PointINF end
const INFINITY = PointINF()

function ==(point_a::PointEC, point_b::PointEC)
    if point_a.curve == point_b.curve && point_a.x == point_b.x && point_a.y == point_b.y
        return true
    end
    return false
end

function ==(curve_a::CurveFP, curve_b::CurveFP)
    if curve_a.a == curve_b.a && curve_a.b == curve_b.b && curve_a.p == curve_b.p
        return true
    end
    return false
end

+(point_a::PointINF, point_b::PointINF) = point_b
+(point_a::PointINF, point_b::PointEC) = point_b
+(point_a::PointEC, point_b::PointINF) = point_a

function +(point_a::PointEC, point_b::PointEC)
     @assert(point_a.curve == point_b.curve)
     if point_a.x == point_b.x
         if (point_a.y + point_b.y) % point_a.curve.p == 0
             return INFINITY
         else
             return double(point_a)
        end
    end
    p = point_a.curve.p
    λ = (point_a.y - point_b.y) * invmod(point_a.x - point_b.x, p)
    xr = mod(λ * λ - point_a.x - point_b.x, p)
    yr = mod(λ * (point_a.x - xr) - point_a.y, p)
    return PointEC(point_a.curve, xr, yr, point_a.order)
end

*(point_a::PointINF, int_b::Number) = INFINITY
*(int_b::Number, point_a::PointINF) = INFINITY
*(int_b::Number, point_a::PointEC) = point_a * int_b

function *(point_a::PointEC, int_b::Number)
    leftmost_bit(x) = big"2"^Int(trunc(log(2, x)))
    if point_a.order != nothing
        int_b %= point_a.order
    end
    if int_b == 0
        return INFINITY
    end
    int_3b = 3 * int_b
    negative_a = PointEC(point_a.curve, point_a.x, -point_a.y, point_a.order)
    i = BigInt(leftmost_bit(int_3b) ÷ 2)
    result = point_a
    while i > 1
        result = double(result)
        if (int_3b & i) != 0 && (int_b & i) == 0
            result += point_a
        end
        if (int_3b & i) == 0 && (int_b & i) != 0
            result += negative_a
        end
        i ÷= 2
    end
    return result
end

in(z::Tuple, curve::CurveFP) = (z[2]^2 - (z[1]^3 + curve.a*z[1] + curve.b)) % curve.p == 0
in(x::Number,y::Number, curve::CurveFP) = (y^2 -(x^3 + curve.a*x + curve.b)) % curve.p == 0
in(p::PointEC, curve::CurveFP) = (p.y^2 - (p.x^3 + curve.a * p.x + curve.b)) % curve.p == 0
in(point::PointINF, curve::CurveFP) = true

double(point_a::PointINF) = INFINITY

function double(point_a::PointEC)
  a, p = point_a.curve.a, point_a.curve.p
  l = mod((3 * point_a.x^2 + a) * invmod(2 * point_a.y, p), p)
  x3 = mod(l^2 - 2 * point_a.x, p)
  y3 = mod(l * (point_a.x - x3) - point_a.y, p)
  return PointEC(point_a.curve, x3, y3, point_a.order)
end

const secp256k1 = (  # use the Bitcoin ECDSA curve
    p = big"0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F",
    a = big"0x0",
    b = big"0x7",
    r = big"0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141",
    Gx = big"0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798",
    Gy = big"0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8",
)
@assert((secp256k1.Gy^2 - secp256k1.Gx^3 - 7) % secp256k1.p == 0)

function generatemultiplier(stdcurve)
    return foldl((x, y) -> 16 * BigInt(x) + y, rand(0:16, ndigits(stdcurve.r - 1, base=16)))
end

struct ECDSA_Key
    E::CurveFP
    secret::BigInt
    G::PointEC
    r::BigInt
    W::PointEC
end

struct ECDSA_Public_Key
    E::CurveFP
    G::PointEC
    r::BigInt
    W::PointEC
end

function genkey(curve=secp256k1) # default: use Bitcoin standard EC curve secp256k1
    E = CurveFP(curve.p, curve.a, curve.b)
    s = generatemultiplier(curve)
    G = PointEC(E, curve.Gx, curve.Gy, curve.r)
    W = s * G
    return ECDSA_Key(E, s, G, curve.r, W)
end

aspublickey(k::ECDSA_Key) = ECDSA_Public_Key(k.E, k.G, k.r, k.W)
privatekey(k::ECDSA_Key) = k.secret

function ECDSA_sign(m::String, key::ECDSA_Key, digestfunction=sha256)
    r, f = key.r, digestfunction(codeunits(m)) # f = H(m)
    # order of curve points length must be >= sha digest length (in bytes)
    @assert(ndigits(r, base=16) >= length(f))
    c, d, bindigest = BigInt(0), BigInt(0), foldl((x, y) -> 16 * BigInt(x) + y, f)
    while c == 0 || d == 0
        u = generatemultiplier(secp256k1)
        V = u * key.G
        c = mod(V.x, r)
        d = mod((invmod(u, r) * (bindigest + key.secret * c)), r)
    end
    return aspublickey(key), c, d
end

function isverifiedECDSA(m::String, publickey, c, d, digestfunction=sha256)
    if 1 <= c < publickey.r && 1 <= d < publickey.r
        r, f = publickey.r, digestfunction(codeunits(m))
        h, bindigest = invmod(d, r), foldl((x, y) -> 16 * BigInt(x) + y, f)
        h1, h2 = mod(bindigest * h, r), mod(c * h, r)
        verifierpoint = h1 * publickey.G + h2 * publickey.W
        return mod(verifierpoint.x, r) == c
    end
    return false
end

end  # module

using .ToyECDSA

const key = genkey()
const msg = "Bill says this is an elliptic curve digital signature algorithm."
const altered = "Bill says this isn't an elliptic curve digital signature algorithm."

publickey, c, d = ECDSA_sign(msg, key)

println("ECDSA of message <$msg> verified: ", isverifiedECDSA(msg, publickey, c, d))

println("ECDSA of message <$altered> verified: ", isverifiedECDSA(altered, publickey, c, d))


import math, random, strformat

const
  MaxN = 1073741789       # Maximum modulus.
  MaxR = MaxN + 65536     # Maximum order "g".
  Infinity = int64.high   # Symbolic infinity.

type

  Point = tuple[x, y: int64]

  Curve = object
    a, b: int64
    n: int64
    g: Point
    r: int64

  Pair = tuple[a, b: int64]

  Parameters = tuple[a, b, n, gx, gy, r: int]

const ZerO: Point = (Infinity, 0i64)

type
  InversionError = object of ValueError
  InvalidParamError = object of ValueError

template `%`(a, n: int64): int64 =
  ## To simplify the writing.
  floorMod(a, n)

proc exgcd(v, u: int64): int64 =
  ## Return 1/v mod u.
  var u = u
  var v = v
  if v < 0: v += u

  var r = 0i64
  var s = 1i64
  while v != 0:
    let q = u div v
    u = u mod v
    swap u, v
    r -= q * s
    swap r, s

  if u != 1:
    raise newException(InversionError, "impossible inverse mod N, gcd = " & $u)
  result = r

func discr(e: Curve): int64 =
  ## Return the discriminant of "e".
  let c = e.a * e.a % e.n * e.a % e.n * 4
  result = -16 * (e.b * e.b % e.n * 27 + c) % e.n

func isO(p: Point): bool =
  ## Return true if "p" is zero.
  p.x == Infinity and p.y == 0

func isOn(e: Curve; p: Point): bool =
  ## Return true if "p" is on curve "e".
  if p.isO: return true
  let r = ((e.a + p.x * p.x) % e.n * p.x + e.b) % e.n
  let s = p.y * p.y % e.n
  result = r == s

proc add(e: Curve; p, q: Point): Point =
  ## Full Point addition.

  if p.isO: return q
  if q.isO: return p

  var la: int64
  if p.x != q.x:
    la = (p.y - q.y) * exgcd(p.x - q.x, e.n) % e.n
  elif p.y == q.y and p.y != 0:
    la = (p.x * p.x % e.n * 3 + e.a) % e.n * exgcd(2 * p.y, e.n) % e.n
  else:
    return ZerO

  result.x = (la * la - p.x - q.x) % e.n
  result.y = (la * (p.x - result.x) - p.y) % e.n

proc mul(e: Curve; p: Point; k: int64): Point =
  ## Return "kp".
  var q = p
  var k = k
  result = ZerO

  while k != 0:
    if (k and 1) != 0:
      result = e.add(result, q)
    q = e.add(q, q)
    k = k shr 1

proc print(e: Curve; prefix: string; p: Point) =
  ## Print a point with a prefix.
  var y = p.y
  if p.isO:
    echo prefix, " (0)"
  else:
    if y > e.n - y: y -= e.n
    echo prefix, &" ({p.x}, {y})"

proc initCurve(params: Parameters): Curve =
  ## Initialize the curve.

  result.n = params.n
  if result.n notin 5..MaxN:
    raise newException(ValueError, "invalid value for N: " & $result.n)
  result.a = params.a.int64 % result.n
  result.b = params.b.int64 % result.n
  result.g.x = params.gx.int64 % result.n
  result.g.y = params.gy.int64 % result.n
  result.r = params.r

  if result.r notin 5..MaxR:
    raise newException(ValueError, "invalid value for r: " & $result.r)

  echo &"\nE: y^2 = x^3 + {result.a}x + {result.b} (mod {result.n})"
  result.print("base point G", result.g)
  echo &"order(G, E) = {result.r}"

proc rnd(): float =
  ## Return a pseudorandom number in range [0..1[.
  while true:
    result = rand(1.0)
    if result != 1: break

proc signature(e: Curve; s, f: int64): Pair =
  ## Compute the signature.

  var
    c, d = 0i64
    u: int64
    v: Point

  echo "Signature computation"

  while true:
    while true:
      u = 1 + int64(rnd() * float(e.r - 1))
      v = e.mul(e.g, u)
      c = v.x % e.r
      if c != 0: break
    d = exgcd(u, e.r) * (f + s * c % e.r) % e.r
    if d != 0: break

  echo "one-time u = ", u
  e.print("V = uG", v)

  result = (c, d)

proc verify(e: Curve; w: Point; f: int64; sg: Pair): bool =
  ## Verify a signature.

  # Domain check.
  if sg.a notin 1..<e.r or sg.b notin 1..<e.r:
    return false

  echo "\nsignature verification"
  let h = exgcd(sg.b, e.r)
  let h1 = f * h % e.r
  let h2 = sg.a * h % e.r
  echo &"h1, h2 = {h1}, {h2}"
  var v = e.mul(e.g, h1)
  let v2 = e.mul(w, h2)
  e.print("h1G", v)
  e.print("h2W", v2)
  v = e.add(v, v2)
  e.print("+ =", v)
  if v.isO: return false
  let c1 = v.x % e.r
  echo "c’ = ", c1
  result = c1 == sg.a

proc ecdsa(e: Curve; f: int64; d: int) =
  ## Build digital signature for message hash "f" with error bit "d".

  # Parameter check.
  var w = e.mul(e.g, e.r)
  if e.discr() == 0 or e.g.isO or not w.isO or not e.isOn(e.g):
    raise newException(InvalidParamError, "invalid parameter set")

  echo "\nkey generation"
  let s = 1 + int64(rnd() * float(e.r - 1))
  w = e.mul(e.g, s)
  echo "private key s = ", s
  e.print("public key W = sG", w)

  # Find next highest power of two minus one.
  var t = e.r
  var i = 1
  while i < 64:
    t = t or t shr i
    i = i shl 1
  var f = f
  while f > t: f = f shr 1
  echo &"\naligned hash {f:x}"

  let sg = e.signature(s, f)
  echo &"signature c, d = {sg.a}, {sg.b}"

  var d = d
  if d > 0:
    while d > t: d = d shr 1
    f = f xor d
    echo &"\ncorrupted hash {f:x}"

  echo if e.verify(w, f, sg): "Valid" else: "Invalid"

when isMainModule:

  randomize()

  # Test vectors: elliptic curve domain parameters,
  # short Weierstrass model y^2 = x^3 + ax + b (mod N)

  const Sets = [
    #    a,   b,  modulus N, base point G, order(G, E), cofactor
      (355, 671, 1073741789, 13693, 10088, 1073807281),
      (  0,   7,   67096021,  6580,   779,   16769911),
      ( -3,   1,     877073,     0,     1,     878159),
      (  0,  14,      22651,    63,    30,        151),
      (  3,   2,          5,     2,     1,          5),

    # ECDSA may fail if...
    # the base point is of composite order
      (  0,   7,   67096021,  2402,  6067,   33539822),
    # the given order is of composite order
      (  0,   7,   67096021,  6580,   779,   67079644),
    # the modulus is not prime (deceptive example)
      (  0,   7,     877069,     3, 97123,     877069),
    # fails if the modulus divides the discriminant
      ( 39, 387,      22651,    95,    27,      22651)
    ]

  # Digital signature on message hash f,
  # set d > 0 to simulate corrupted data.
  let f = 0x789abcdei64
  let d = 0

  for s in Sets:
    let e = initCurve(s)
    try:
      e.ecdsa(f, d)
    except ValueError:
      echo getCurrentExceptionMsg()
    echo "——————————————"


# 20200828 added Perl programming solution

use strict;
use warnings;

use Crypt::EC_DSA;

my $ecdsa = new Crypt::EC_DSA;

my ($pubkey, $prikey) = $ecdsa->keygen;

print "Message: ", my $msg = 'Rosetta Code', "\n";

print "Private Key :\n$prikey \n";
print "Public key  :\n", $pubkey->x, "\n", $pubkey->y, "\n";

my $signature = $ecdsa->sign( Message => $msg, Key => $prikey );
print "Signature   :\n";
for (sort keys %$signature) { print "$_ => $signature->{$_}\n"; }

$ecdsa->verify( Message => $msg, Key => $pubkey, Signature => $signature ) and
   print "Signature verified.\n"


requires(64)
enum X, Y            -- rational ec point
enum A, B, N, G, R  -- elliptic curve parameters
                    -- also signature pair(A,B)

constant mxN = 1073741789   -- maximum modulus
constant mxr = 1073807325   -- max order G = mxN + 65536
constant inf = -2147483647  -- symbolic infinity

sequence e = {0,0,0,{0,0},0}    -- single global curve
constant zerO = {inf,0}         -- point at infinity zerO

bool inverr -- impossible inverse mod N

function exgcd(atom v, u)
-- return mod(v^-1, u)
atom q, t, r = 0, s = 1
    if v<0 then v += u end if

    while v do
        q = floor(u/v)
        t = u-q*v
        u = v
        v = t
        t = r-q*s
        r = s
        s = t
    end while

    if u!=1 then
        printf(1," impossible inverse mod N, gcd = %d\n",{u})
        inverr = true
    end if

    return r
end function

function modn(atom a)
-- return mod(a, N)
    a = mod(a,e[N])
    if a<0 then a += e[N] end if
    return a
end function

function modr(atom a)
-- return mod(a, r)
    a = mod(a,e[R])
    if a<0 then a += e[R] end if
    return a
end function

function disc()
-- return the discriminant of E
    atom a = e[A], b = e[B],
         c = 4*modn(a*modn(a*a))
    return modn(-16*(c+27*modn(b*b)))
end function

function isO(sequence p)
-- return true if P = zerO
    return (p[X]=inf and p[Y]=0)
end function

function ison(sequence p)
-- return true if P is on curve E
    atom r = 0, s = 0
    if not isO(p) then
        r = modn(e[B]+p[X]*modn(e[A]+p[X]*p[X]))
        s = modn(p[Y]*p[Y])
    end if
    return (r=s)
end function

procedure pprint(string f, sequence p)
-- print point P with prefix f
    if isO(p) then
        printf(1,"%s (0)\n",{f})
    else
        atom y = p[Y]
        if y>e[N]-y then y -= e[N] end if
        printf(1,"%s (%d,%d)\n",{f,p[X],y})
    end if
end procedure

function padd(sequence p, q)
-- full ec point addition
atom la, t

    if isO(p) then return q end if
    if isO(q) then return p end if

    if p[X]!=q[X] then --                   R := P + Q
        t = p[Y]-q[Y]
        la = modn(t*exgcd(p[X]-q[X], e[N]))

    else --                                 P = Q, R := 2P
        if (p[Y]=q[Y]) and (p[Y]!=0) then
            t = modn(3*modn(p[X]*p[X])+e[A])
            la = modn(t*exgcd(2*p[Y], e[N]))
        else
            return zerO --                  P = -Q, R := O
        end if
    end if

    t = modn(la*la-p[X]-q[X])
    sequence r = deep_copy(zerO)
    r[Y] = modn(la*(p[X]-t)-p[Y])
    r[X] = t
    if inverr then r = zerO end if
    return r
end function

function pmul(sequence p, atom k)
-- R:= multiple kP
    sequence s = zerO, q = p

    while k do
        if and_bits(k,1) then
            s = padd(s, q)
        end if
        if inverr then s = zerO; exit end if
        k = floor(k/2)
        q = padd(q, q)
    end while
    return s
end function

function ellinit(sequence i)
-- initialize elliptic curve
atom a = i[1], b = i[2]
    inverr = false
    e[N] = i[3]

    if (e[N]<5) or (e[N]>mxN) then return 0 end if

    e[A] = modn(a)
    e[B] = modn(b)
    e[G][X] = modn(i[4])
    e[G][Y] = modn(i[5])
    e[R] = i[6]

    if (e[R]<5) or (e[R]>mxr) then return 0 end if

    printf(1,"E: y^2 = x^3 + %dx + %d (mod %d)\n",{a,b,e[N]})
    pprint("base point G", e[G])
    printf(1,"order(G, E) = %d\n",{e[R]})

    return -1
end function

function signature(atom s, f)
-- signature primitive
atom c, d, u, u1
sequence V

    printf(1,"signature computation\n")
    while true do
        while true do
--          u = rand(e[R]-1)
            u = 571533488       -- match FreeBASIC output
--          u = 605163545       -- match C output
            V = pmul(e[G], u)
            c = modr(V[X])
            if c!=0 then exit end if
        end while

        u1 = exgcd(u, e[R])
        d = modr(u1*(f+modr(s*c)))
        if d!=0 then exit end if
    end while
    printf(1,"one-time u = %d\n",u)
    pprint("V = uG", V)
    return {c,d}
end function

function verify(sequence W, atom f, sequence sg)
-- verification primitive
atom c = sg[A], d = sg[B],
     t, c1, h1, h2, h
sequence V, V2

   --domain check
    t = (c>0) and (c<e[R])
    t = t and (d>0) and (d<e[R])
    if not t then return 0 end if

    printf(1,"\nsignature verification\n")
    h = exgcd(d, e[R])
    h1 = modr(f*h)
    h2 = modr(c*h)
    printf(1,"h1,h2 = %d,%d\n",{h1,h2})
    V = pmul(e[G], h1)
    V2 = pmul(W, h2)
    pprint("h1G", V)
    pprint("h2W", V2)
    V = padd(V, V2)
    pprint("+ =", V)
    if isO(V) then return 0 end if
    c1 = modr(V[X])
    printf(1,"c' = %d\n",c1)

    return (c1=c)
end function

procedure errmsg()
    printf(1,"invalid parameter set\n")
    printf(1,"_____________________\n")
end procedure

procedure ec_dsa(atom f, d)
-- digital signature on message hash f, error bit d
atom i, s, t
sequence sg, W

   --parameter check
    t = (disc()=0)
    t = t or isO(e[G])
    W = pmul(e[G], e[R])
    t = t or not isO(W)
    t = t or not ison(e[G])
    if t then errmsg() return end if

    puts(1,"\nkey generation\n")
--  s = rand(e[R] - 1)
    s = 509100772       -- match FreeBASIC output
--  s = 1343570         -- match C output
    W = pmul(e[G], s)
    printf(1,"private key s = %d\n",{s})
    pprint("public key W = sG", W)

   --next highest power of 2 - 1
    t = e[R]
    i = 1
    while i<32 do
        t = or_bits(t,floor(t/power(2,i)))
        i *= 2
    end while
    while f>t do
        f = floor(f/2)
    end while
    printf(1,"\naligned hash %x\n\n",{f})

    sg = signature(s, f)
    if inverr then errmsg() return end if
    printf(1,"signature c,d = %d,%d\n",sg)

    if d>0 then
        while d>t do
            d = floor(d/2)
        end while
        f = xor_bits(f,d)
        printf(1,"corrupted hash %x\n",{f})
    end if

    t = verify(W, f, sg)
    if inverr then errmsg() return end if
    if t then
        printf(1,"Valid\n_____\n")
    else
        printf(1,"invalid\n_______\n")
    end if
end procedure

--Test vectors: elliptic curve domain parameters,
--short Weierstrass model y^2 = x^3 + ax + b (mod N)

constant tests = {
--                  a,   b,  modulus N, base point G, order(G, E), cofactor
                  {355, 671, 1073741789, 13693, 10088, 1073807281},
                  {  0,   7,   67096021,  6580,   779,   16769911}, --   4
                  { -3,   1,     877073,     0,     1,     878159},
                  {  0,  14,      22651,    63,    30,        151}, -- 151
                  {  3,   2,          5,     2,     1,          5},

                    --ecdsa may fail if...
                    --the base point is of composite order
                  {  0,   7,   67096021,  2402,  6067,   33539822}, --   2
                    --the given order is a multiple of the true order
                  {  0,   7,   67096021,  6580,   779,   67079644}, --   1
                    --the modulus is not prime (deceptive example)
                  {  0,   7,     877069,     3, 97123,     877069},
                    --fails if the modulus divides the discriminant
                  { 39, 387,      22651,    95,    27,      22651}}

--Digital signature on message hash f,
--set d > 0 to simulate corrupted data
atom f = #789ABCDE,
     d = 0

--for i=1 to length(tests) do
for i=1 to 1 do
    if not ellinit(tests[i]) then exit end if
    ec_dsa(f, d)
end for


from collections import namedtuple
from hashlib import sha256
from math import ceil, log
from random import randint
from typing import NamedTuple

# Bitcoin ECDSA curve
secp256k1_data = dict(
    p=0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F,  # Field characteristic
    a=0x0,  # Curve param a
    b=0x7,  # Curve param b
    r=0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141,  # Order n of basepoint G. Cofactor is 1 so it's ommited.
    Gx=0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798,  # Base point x
    Gy=0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8,  # Base point y
)
secp256k1 = namedtuple("secp256k1", secp256k1_data)(**secp256k1_data)
assert (secp256k1.Gy ** 2 - secp256k1.Gx ** 3 - 7) % secp256k1.p == 0

class CurveFP(NamedTuple):
    p: int  # Field characteristic
    a: int  # Curve param a
    b: int  # Curve param b

def extended_gcd(aa, bb):
    # https://rosettacode.org/wiki/Modular_inverse#Iteration_and_error-handling
    lastremainder, remainder = abs(aa), abs(bb)
    x, lastx, y, lasty = 0, 1, 1, 0
    while remainder:
        lastremainder, (quotient, remainder) = remainder, divmod(
            lastremainder, remainder
        )
        x, lastx = lastx - quotient * x, x
        y, lasty = lasty - quotient * y, y
    return lastremainder, lastx * (-1 if aa < 0 else 1), lasty * (-1 if bb < 0 else 1)

def modinv(a, m):
    # https://rosettacode.org/wiki/Modular_inverse#Iteration_and_error-handling
    g, x, _ = extended_gcd(a, m)
    if g != 1:
        raise ValueError
    return x % m

class PointEC(NamedTuple):
    curve: CurveFP
    x: int
    y: int

    @classmethod
    def build(cls, curve, x, y):
        x = x % curve.p
        y = y % curve.p
        rv = cls(curve, x, y)
        if not rv.is_identity():
            assert rv.in_curve()
        return rv

    def get_identity(self):
        return PointEC.build(self.curve, 0, 0)

    def copy(self):
        return PointEC.build(self.curve, self.x, self.y)

    def __neg__(self):
        return PointEC.build(self.curve, self.x, -self.y)

    def __sub__(self, Q):
        return self + (-Q)

    def __equals__(self, Q):
        # TODO: Assert same curve or implement logic for that.
        return self.x == Q.x and self.y == Q.y

    def is_identity(self):
        return self.x == 0 and self.y == 0

    def __add__(self, Q):
        # TODO: Assert same curve or implement logic for that.
        p = self.curve.p
        if self.is_identity():
            return Q.copy()
        if Q.is_identity():
            return self.copy()
        if Q.x == self.x and (Q.y == (-self.y % p)):
            return self.get_identity()

        if self != Q:
            l = ((Q.y - self.y) * modinv(Q.x - self.x, p)) % p
        else:
            # Point doubling.
            l = ((3 * self.x ** 2 + self.curve.a) * modinv(2 * self.y, p)) % p
        l = int(l)

        Rx = (l ** 2 - self.x - Q.x) % p
        Ry = (l * (self.x - Rx) - self.y) % p
        rv = PointEC.build(self.curve, Rx, Ry)
        return rv

    def in_curve(self):
        return ((self.y ** 2) % self.curve.p) == (
            (self.x ** 3 + self.curve.a * self.x + self.curve.b) % self.curve.p
        )

    def __mul__(self, s):
        # Naive method is exponential (due to invmod right?) so we use an alternative method:
        # https://en.wikipedia.org/wiki/Elliptic_curve_point_multiplication#Montgomery_ladder
        r0 = self.get_identity()
        r1 = self.copy()
        # pdbsas
        for i in range(ceil(log(s + 1, 2)) - 1, -1, -1):
            if ((s & (1 << i)) >> i) == 0:
                r1 = r0 + r1
                r0 = r0 + r0
            else:
                r0 = r0 + r1
                r1 = r1 + r1
        return r0

    def __rmul__(self, other):
        return self.__mul__(other)

class ECCSetup(NamedTuple):
    E: CurveFP
    G: PointEC
    r: int

secp256k1_curve = CurveFP(secp256k1.p, secp256k1.a, secp256k1.b)
secp256k1_basepoint = PointEC(secp256k1_curve, secp256k1.Gx, secp256k1.Gy)

class ECDSAPrivKey(NamedTuple):
    ecc_setup: ECCSetup
    secret: int

    def get_pubkey(self):
        # Compute W = sG to get the pubkey
        W = self.secret * self.ecc_setup.G
        pub = ECDSAPubKey(self.ecc_setup, W)
        return pub

class ECDSAPubKey(NamedTuple):
    ecc_setup: ECCSetup
    W: PointEC

class ECDSASignature(NamedTuple):
    c: int
    d: int

def generate_keypair(ecc_setup, s=None):
    # Select a random integer s in the interval [1, r - 1] for the secret.
    if s is None:
        s = randint(1, ecc_setup.r - 1)
    priv = ECDSAPrivKey(ecc_setup, s)
    pub = priv.get_pubkey()
    return priv, pub

def get_msg_hash(msg):
    return int.from_bytes(sha256(msg).digest(), "big")

def sign(priv, msg, u=None):
    G = priv.ecc_setup.G
    r = priv.ecc_setup.r

    # 1. Compute message representative f = H(m), using a cryptographic hash function.
    #    Note that f can be greater than r but not longer (measuring bits).
    msg_hash = get_msg_hash(msg)

    while True:
        # 2. Select a random integer u in the interval [1, r - 1].
        if u is None:
            u = randint(1, r - 1)

        # 3. Compute V = uG = (xV, yV) and c ≡ xV mod r  (goto (2) if c = 0).
        V = u * G
        c = V.x % r
        if c == 0:
            print(f"c={c}")
            continue
        d = (modinv(u, r) * (msg_hash + priv.secret * c)) % r
        if d == 0:
            print(f"d={d}")
            continue
        break

    signature = ECDSASignature(c, d)
    return signature

def verify_signature(pub, msg, signature):
    r = pub.ecc_setup.r
    G = pub.ecc_setup.G
    c = signature.c
    d = signature.d

    # Verify that c and d are integers in the interval [1, r - 1].
    def num_ok(n):
        return 1 < n < (r - 1)

    if not num_ok(c):
        raise ValueError(f"Invalid signature value: c={c}")
    if not num_ok(d):
        raise ValueError(f"Invalid signature value: d={d}")

    # Compute f = H(m) and h ≡ d^-1 mod r.
    msg_hash = get_msg_hash(msg)
    h = modinv(d, r)

    # Compute h1 ≡ f·h mod r and h2 ≡ c·h mod r.
    h1 = (msg_hash * h) % r
    h2 = (c * h) % r

    # Compute h1G + h2W = (x1, y1) and c1 ≡ x1 mod r.
    # Accept the signature if and only if c1 = c.
    P = h1 * G + h2 * pub.W
    c1 = P.x % r
    rv = c1 == c
    return rv

def get_ecc_setup(curve=None, basepoint=None, r=None):
    if curve is None:
        curve = secp256k1_curve
    if basepoint is None:
        basepoint = secp256k1_basepoint
    if r is None:
        r = secp256k1.r

    # 1. Select an elliptic curve E defined over ℤp.
    #    The number of points in E(ℤp) should be divisible by a large prime r.
    E = CurveFP(curve.p, curve.a, curve.b)

    # 2. Select a base point G ∈ E(ℤp) of order r (which means that rG = 𝒪).
    G = PointEC(E, basepoint.x, basepoint.y)
    assert (G * r) == G.get_identity()

    ecc_setup = ECCSetup(E, G, r)
    return ecc_setup

def main():
    ecc_setup = get_ecc_setup()
    print(f"E: y^2 = x^3 + {ecc_setup.E.a}x + {ecc_setup.E.b} (mod {ecc_setup.E.p})")
    print(f"base point G({ecc_setup.G.x}, {ecc_setup.G.y})")
    print(f"order(G, E) = {ecc_setup.r}")

    print("Generating keys")
    priv, pub = generate_keypair(ecc_setup)
    print(f"private key s = {priv.secret}")
    print(f"public key W = sG ({pub.W.x}, {pub.W.y})")

    msg_orig = b"hello world"
    signature = sign(priv, msg_orig)
    print(f"signature ({msg_orig}, priv) = (c,d) = {signature.c}, {signature.d}")

    validation = verify_signature(pub, msg_orig, signature)
    print(f"verify_signature(pub, {msg_orig}, signature) = {validation}")

    msg_bad = b"hello planet"
    validation = verify_signature(pub, msg_bad, signature)
    print(f"verify_signature(pub, {msg_bad}, signature) = {validation}")

if __name__ == "__main__":
    main()


use Digest::SHA256::Native;

# Following data taken from the C entry
our (\A,\B,\P,\O,\Gx,\Gy) = (355, 671, 1073741789, 1073807281, 13693, 10088);

#`{ Following data taken from the Julia entry; 256-bit; tested
our (\A,\B,\P,\O,\Gx,\Gy) = (0, 7, # https://en.bitcoin.it/wiki/Secp256k1
0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F,
0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141,
0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798,
0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8); # }

role Horizon { method gist { 'EC Point at horizon' } }

class Point {             # modified from the Elliptic_curve_arithmetic entry
   has ($.x, $.y);        # handle modular arithmetic only
   multi method new( \x, \y ) { self.bless(:x, :y) }
   method gist { "EC Point at x=$.x, y=$.y" }
   method isOn { modP(B + $.x * modP(A+$.x²)) == modP($.y²) }
   sub modP ($a is copy) { ( $a %= P ) < 0 ?? ($a += P) !! $a }
}

multi infix:<⊞>(Point \p, Point \q) {
   my \λ = $; # slope
   if p.x ~~ q.x and p.y ~~ q.y {
      return Horizon if p.y == 0 ;
      λ = (3*p.x²+ A) * mult_inv(2*p.y, :modulo(P))
   } else {
      λ = (p.y - q.y) * mult_inv(p.x - q.x, :modulo(P))
   }
   my \xr = (λ²- p.x - q.x);
   my \yr = (λ*(p.x - xr) - p.y);
   return Point.bless: x =>  xr % P, y => yr % P
}

multi infix:<⊠>(Int \n, Point \p) {
   return 0                if n == 0 ;
   return p                if n == 1 ;
   return p ⊞ ((n-1) ⊠ p ) if n % 2 == 1 ;
   return ( n div 2 ) ⊠ ( p ⊞ p )
}

sub mult_inv($n, :$modulo) { # rosettacode.org/wiki/Modular_inverse#Raku
   my ($c, $d, $uc, $vd, $vc, $ud, $q) = $n % $modulo, $modulo, 1, 1, 0, 0, 0;
   while $c != 0 {
      ($q, $c, $d) = ($d div $c, $d % $c, $c);
      ($uc, $vc, $ud, $vd) = ($ud - $q*$uc, $vd - $q*$vc, $uc, $vc);
   }
   return $ud % $modulo;
}

class Signature {

   has ($.n, Point $.G); # Order and Generator point

   method generate_signature(Int \private_key, Str \msg) {
      my \z = :16(sha256-hex msg) % $.n; # self ref: Blob.list.fmt("%02X",'')
      loop ( my $k = my $s = my $r = 0 ; $s == 0 ; ) {
         loop ( $r = $s = 0 ; $r == 0 ; ) {
            $r = (( $k = (1..^$.n).roll ) ⊠ $.G).x % $.n;
         }
         $s = ((z + $r*private_key) * mult_inv $k, :modulo($.n)) % $.n;
      }
      return $r, $s, private_key ⊠ $.G ;
   }

   method verify_signature(\msg, \r, \s, \public_key) {
      my \z = :16(sha256-hex msg) % $.n;
      my \w = mult_inv s, :modulo($.n);
      my (\u1,\u2) = (z*w, r*w).map: { $_ % $.n }
      my \p = (u1 ⊠ $.G ) ⊞ (u2 ⊠ public_key);
      return (p.x % $.n) == (r % $.n)
   }
}

print "The Curve E is        : ";
"𝑦² = 𝑥³ + %s 𝑥 + %s (mod %s) \n".printf(A,B,P);
"with Generator G at   : (%s,%s)\n".printf(Gx,Gy);
my $ec = Signature.new: n => O, G => Point.new: x => Gx, y => Gy ;
say "Order(G, E) is        : ", O;
say "Is G  ∈ E ?           : ", $ec.G.isOn;
say "Message               : ", my \message = "Show me the monKey";
say "The private key dA is : ", my \dA = (1..^O).roll;
my ($r, $s, \Qa) = $ec.generate_signature(dA, message);
say "The public  key Qa is : ", Qa;
say "Is Qa ∈ E ?           : ", Qa.isOn;
say "Is signature valid?   : ", $ec.verify_signature(message, $r, $s, Qa);
say "Message (Tampered)    : ", my \altered = "Show me the money";
say "Is signature valid?   : ", $ec.verify_signature(altered, $r, $s, Qa)


import "/dynamic" for Struct
import "/big" for BigInt
import "/fmt" for Fmt
import "/math" for Boolean
import "random" for Random

var rand = Random.new()

// rational ec point: x and y are BigInts
var Epnt = Struct.create("Epnt", ["x", "y"])

// elliptic curve parameters: N is a BigInt, G is an Epnt, rest are integral Nums
var Curve = Struct.create("Curve", ["a", "b", "N", "G", "r"])

// signature pair: a and b are integral Nums
var Pair = Struct.create("Pair", ["a", "b"])

// maximum modulus
var mxN = 1073741789

// max order G = mxN + 65536
var mxr = 1073807325

// symbolic infinity
var inf = BigInt.new(-2147483647)

// single global curve
var e = Curve.new(0, 0, BigInt.zero, Epnt.new(inf, BigInt.zero), 0)

// impossible inverse mod N
var inverr = false

// return mod(v^-1, u)
var exgcd = Fn.new { |v, u|
    var r = 0
    var s = 1
    if (v < 0) v = v + u
    while (v != 0) {
        var q = (u / v).truncate
        var t = u - q * v
        u = v
        v = t
        t = r - q * s
        r = s
        s = t
    }
    if (u != 1) {
        System.print(" impossible inverse mod N, gcd = %(u)")
        inverr = true
    }
    return r
}

// returns mod(a, N), a is a BigInt
var modn = Fn.new { |a|
    var b = a.copy()
    b = b % e.N
    if (b < 0) b = b + e.N
    return b
}

// returns mod(a, r), a is a BigInt
var modr = Fn.new { |a|
   var b = a.copy()
   b = b % e.r
   if (b < 0) b = b + e.r
   return b
}

// returns the discriminant of E
var disc = Fn.new {
    var a = BigInt.new(e.a)
    var b = BigInt.new(e.b)
    var c = modn.call(a * modn.call(a * a)) * 4
    return modn.call((c + modn.call(b * b) * 27) * (-16)).toSmall
}

// return true if P is 'zero' point (at inf, 0)
var isZero = Fn.new { |p| p.x == inf && p.y == 0 }

// return true if P is on curve E
var isOn = Fn.new { |p|
    var r = 0
    var s = 0
    if (!isZero.call(p)) {
        r = modn.call(p.x * modn.call(p.x * p.x + e.a) + e.b).toSmall
        s = modn.call(p.y * p.y).toSmall
    }
    return r == s
}

// full ec point addition
var padd = Fn.new { |p, q|
    var la = BigInt.zero
    var t  = BigInt.zero
    if (isZero.call(p)) return Epnt.new(q.x, q.y)
    if (isZero.call(q)) return Epnt.new(p.x, p.y)
    if (p.x != q.x) { // R = P + Q
        t = p.y - q.y
        la = modn.call(t * exgcd.call((p.x - q.x).toSmall, e.N.toSmall))
    } else { // P = Q, R = 2P
        if (p.y == q.y && p.y != 0) {
            t = modn.call(modn.call(p.x * p.x) * 3 + e.a)
            la = modn.call(t * exgcd.call((p.y * 2).toSmall, e.N.toSmall))
        } else {
            return Epnt.new(inf, BigInt.zero) // P = -Q, R = O
        }
    }
    if (inverr) return Epnt.new(inf, BigInt.zero)
    t = modn.call(la * la - p.x - q.x)
    return Epnt.new(t, modn.call(la * (p.x - t) - p.y))
}

// R = multiple kP
var pmul = Fn.new { |p, k|
    var s = Epnt.new(inf, BigInt.zero)
    var q = Epnt.new(p.x, p.y)
    while (k != 0) {
        if (k % 2 == 1) s = padd.call(s, q)
        if (inverr) {
            s.x = inf
            s.y = BigInt.zero
            break
        }
        q = padd.call(q, q)
        k = (k/2).floor
    }
    return s
}

// print point P with prefix f
var pprint = Fn.new { |f, p|
    var y = p.y
    if (isZero.call(p)) {
        Fmt.print("$s (0)", f)
    } else {
        if (y > e.N - y) y = y - e.N
        Fmt.print("$s ($i, $i)", f, p.x, y)
    }
}

// initialize elliptic curve
var ellinit = Fn.new { |i|
    var a  = BigInt.new(i[0])
    var b  = BigInt.new(i[1])
    e.N    = BigInt.new(i[2])
    inverr = false
    if (e.N < 5 || e.N > mxN) return false
    e.a = modn.call(a).toSmall
    e.b = modn.call(b).toSmall
    e.G.x = modn.call(BigInt.new(i[3]))
    e.G.y = modn.call(BigInt.new(i[4]))
    e.r = i[5]
    if (e.r < 5 || e.r > mxr) return false
    Fmt.write("\nE: y^2 = x^3 + $ix + $i", a, b)
    Fmt.print(" (mod $i)", e.N)
    pprint.call("base point G", e.G)
    Fmt.print("order(G, E) = $d", e.r)
    return true
}

// signature primitive
var signature = Fn.new { |s, f|
    var c
    var d
    var u
    var u1
    var sg = Pair.new(0, 0)
    var V
    System.print("\nsignature computation")
    while (true) {
        while (true) {
            u = 1 + (rand.float() * (e.r - 1)).truncate
            V = pmul.call(e.G, u)
            c = modr.call(V.x).toSmall
            if (c != 0) break
        }
        u1 = exgcd.call(u, e.r)
        d = modr.call((modr.call(s * c) + f) * u1).toSmall
        if (d != 0) break
    }
    Fmt.print("one-time u = $d", u)
    pprint.call("V = uG", V)
    sg.a = c
    sg.b = d
    return sg
}

// verification primitive
var verify = Fn.new { |W, f, sg|
    var c = sg.a
    var d = sg.b

    // domain check
    var t = (c > 0) && (c < e.r)
    t = Boolean.and(t, d > 0 && d < e.r)
    if (!t) return false
    System.print("\nsignature verification")
    var h = BigInt.new(exgcd.call(d, e.r))
    var h1 = modr.call(h * f).toSmall
    var h2 = modr.call(h * c).toSmall
    Fmt.print ("h1, h2 = $d, $d", h1, h2)
    var V = pmul.call(e.G, h1)
    var V2 = pmul.call(W, h2)
    pprint.call("h1G", V)
    pprint.call("h2W", V2)
    V = padd.call(V, V2)
    pprint.call("+ =", V)
    if (isZero.call(V)) return false
    var c1 = modr.call(V.x).toSmall
    Fmt.print("c' = $d", c1)
    return c1 == c
}

var errmsg = Fn.new {
    System.print("invalid parameter set")
    System.print("_____________________")
}

// digital signature on message hash f, error bit d
var ec_dsa = Fn.new { |f, d|
    // parameter check
    var t = disc.call() == 0
    t = Boolean.or(t, isZero.call(e.G))
    var W = pmul.call(e.G, e.r)
    t = Boolean.or(t, !isZero.call(W))
    t = Boolean.or(t, !isOn.call(e.G))
    if (t) {
        errmsg.call()
        return
    }
    System.print("\nkey generation")
    var s = 1 + (rand.float() * (e.r - 1)).truncate
    W = pmul.call(e.G, s)
    Fmt.print("private key s = $d\n", s)
    pprint.call("public key W = sG", W)

    // next highest power of 2 - 1
    t = e.r
    var i = 1
    while (i < 32) {
        t = t | (t >> i)
        i = i << 1
    }
    while (f > t) f = f >> 1
    Fmt.print("\naligned hash $x", f)
    var sg = signature.call(BigInt.new(s), f)
    if (inverr) {
        errmsg.call()
        return
    }
    Fmt.print("signature c, d = $d, $d", sg.a, sg.b)
    if (d > 0) {
        while (d > t) d = d >> 1
        f = f ^ d
        Fmt.print("\ncorrupted hash $x", f)
    }
    t = verify.call(W, f, sg)
    if (inverr) {
        errmsg.call()
        return
    }
    if (t) {
        System.print("Valid\n_____")
   } else {
        System.print("invalid\n_______")
   }
}

// Test vectors: elliptic curve domain parameters,
// short Weierstrass model y^2 = x^3 + ax + b (mod N)
var sets = [
   //    a,   b,  modulus N, base point G, order(G, E), cofactor
   [355, 671, 1073741789, 13693, 10088, 1073807281],
   [  0,   7,   67096021,  6580,   779,   16769911], // 4
   [ -3,   1,     877073,     0,     1,     878159],
   [  0,  14,      22651,    63,    30,        151], // 151
   [  3,   2,          5,     2,     1,          5],

   // ecdsa may fail if...
   // the base point is of composite order
   [  0,   7,   67096021,  2402,  6067,   33539822], // 2
   // the given order is a multiple of the true order
   [  0,   7,   67096021,  6580,   779,   67079644], // 1
   // the modulus is not prime (deceptive example)
   [  0,   7,     877069,     3, 97123,     877069],
   // fails if the modulus divides the discriminant
   [ 39, 387,      22651,    95,    27,      22651]
]
// Digital signature on message hash f,
// set d > 0 to simulate corrupted data
var f = 0x789abcde
var d = 0

for (s in sets) {
    if (ellinit.call(s)) {
        ec_dsa.call(f, d)
    } else {
        break
    }
}


with Ada.Text_IO, Matrix_Scalar;

procedure Scalar_Ops is

   subtype T is Integer range 1 .. 3;

   package M is new Matrix_Scalar(T, T, Integer);

   -- the functions to solve the task
        function "+" is new M.Func("+");
        function "-" is new M.Func("-");
        function "*" is new M.Func("*");
        function "/" is new M.Func("/");
        function "**" is new M.Func("**");
        function "mod" is new M.Func("mod");

   -- for output purposes, we need a Matrix->String conversion
        function Image is new M.Image(Integer'Image);

   A: M.Matrix := ((1,2,3),(4,5,6),(7,8,9)); -- something to begin with

begin
   Ada.Text_IO.Put_Line("  Initial M=" & Image(A));
   Ada.Text_IO.Put_Line("        M+2=" & Image(A+2));
   Ada.Text_IO.Put_Line("        M-2=" & Image(A-2));
   Ada.Text_IO.Put_Line("        M*2=" & Image(A*2));
   Ada.Text_IO.Put_Line("        M/2=" & Image(A/2));
   Ada.Text_IO.Put_Line("  square(M)=" & Image(A ** 2));
   Ada.Text_IO.Put_Line("    M mod 2=" & Image(A mod 2));
   Ada.Text_IO.Put_Line("(M*2) mod 3=" & Image((A*2) mod 3));
end Scalar_Ops;


#!/usr/local/bin/a68g --script #

MODE SCALAR = REAL;
FORMAT scalar fmt = $g(0, 2)$;

MODE MATRIX = [3, 3]SCALAR;
FORMAT vector fmt = $"("n(2 UPB LOC MATRIX - 2 LWB LOC MATRIX)(f(scalar fmt)", ")f(scalar fmt)")"$;
FORMAT matrix fmt = $"("n(1 UPB LOC MATRIX - 1 LWB LOC MATRIX)(f(vector fmt)","l" ")f(vector fmt)")"$;

PROC elementwise op = (PROC(SCALAR, SCALAR)SCALAR op, MATRIX a, UNION(SCALAR, MATRIX) b)MATRIX: (
  [LWB a:UPB a, 2 LWB a:2 UPB a]SCALAR out;
  CASE b IN
  (SCALAR b):
    FOR i FROM LWB out TO UPB out DO
      FOR j FROM 2 LWB out TO 2 UPB out DO
        out[i, j]:=op(a[i, j], b)
      OD
    OD,
  (MATRIX b):
    FOR i FROM LWB out TO UPB out DO
      FOR j FROM 2 LWB out TO 2 UPB out DO
        out[i, j]:=op(a[i, j], b[i, j])
      OD
    OD
  ESAC;
  out
);

PROC plus  = (SCALAR a, b)SCALAR: a+b,
     minus = (SCALAR a, b)SCALAR: a-b,
     times = (SCALAR a, b)SCALAR: a*b,
     div   = (SCALAR a, b)SCALAR: a/b,
     pow   = (SCALAR a, b)SCALAR: a**b;

main:(
    SCALAR scalar := 10;
    MATRIX matrix = (( 7, 11, 13),
                     (17, 19, 23),
                     (29, 31, 37));

    printf(($f(matrix fmt)";"l$,
      elementwise op(plus,  matrix, scalar),
      elementwise op(minus, matrix, scalar),
      elementwise op(times, matrix, scalar),
      elementwise op(div,   matrix, scalar),
      elementwise op(pow,   matrix, scalar),

      elementwise op(plus,  matrix, matrix),
      elementwise op(minus, matrix, matrix),
      elementwise op(times, matrix, matrix),
      elementwise op(div,   matrix, matrix),
      elementwise op(pow,   matrix, matrix)
  ))
)


#include <hopper.h>

main:
  /* create an integer random array */
  A=-1,{10}rand array(A), mulby(10), ceil, mov(A)
  {","}tok sep
  {"\ENF","ORIGINAL ARRAY :",A,"\OFF\n","="}reply(90),
  println
  {"Increment :\t"},    ++A,{A}          println
  {"Decrement :\t"},    --A,{A}          println
  {"post Increment: "}, A++,             println
             {*"\t",A}                   println
  {"post Decrement: "}, A--,             println
             {*"\t",A}                   println
  {"A + 5 :\t\t"},      {A} plus (5),    println
  {"5 + A :\t\t"},      {5} plus (A),    println
  {"A - 5 :\t\t"},      {A} minus (5),   println
  {"5 - A :\t\t"},      {5} minus (A),   println
  {"A * 5 :\t\t"},      {A} mul by (5),  println
  {"5 * A :\t\t"},      {5} mul by (A),  println
  {"A / 5 :\t\t"},      {A} div by (5),  println
  {"5 / A :\t\t"},      {5} div by (A),  println
  {"A \ 5 :\t\t"},      {A} idiv by (5), println
  {"5 \ A :\t\t"},      {5} idiv by (A), println
  {"A ^ 5 :\t\t"},      {A} pow by (5),  println
  {"5 ^ A :\t\t"},      {5} pow by (A),  println
  {"A % 5 :\t\t"},      {A} module (5),  println
  {"5 % A :\t\t"},      {5} module (A),  println
  {"SQRT(A) + 5:\t"},   {A} sqrt, plus(5),
                        tmp=0,cpy(tmp),  println
  {"--> CEIL :\t"}      {tmp},ceil,      println
  {"--> FLOOR :\t"}     {tmp},floor,     println
  {"A + A :\t\t"},      {A} plus (A),    println
  {"A - A :\t\t"},      {A} minus (A),   println
  {"A * A :\t\t"},      {A} mulby (A),   println
  {"A / A :\t\t"},      {A} div by (A),  println
  {"A \ A :\t\t"},      {A} idiv by (A), println
  {"A ^ A :\t\t"},      {A} pow by (A),  println
  {"A % A :\t\t"},      {A} module (A),  println
  {"Etcetera...\n"},                     println
exit(0)


ElementWise(M, operation, Val){
    A := Obj_Copy(M),
    for r, obj in A
        for c, v in obj	{
            V := IsObject(Val) ? Val[r, c] : Val
            switch, operation {
                case "+": A[r, c]	:= A[r, c] + V
                case "-": A[r, c]	:= A[r, c] - V
                case "*": A[r, c]	:= A[r, c] * V
                case "/": A[r, c]	:= A[r, c] / V
                case "Mod": A[r, c]	:= Mod(A[r, c], V)
                case "^": A[r, c]	:= A[r, c] ** V
            }
        }
    return A
}


      DIM a(1,2), b(1,2), c(1,2)
      a() = 7, 8, 7, 4, 0, 9 : b() = 4, 5, 1, 6, 2, 1

      REM Matrix-Matrix:
      c() = a() + b() : PRINT FNshowmm(a(), "+", b(), c())
      c() = a() - b() : PRINT FNshowmm(a(), "-", b(), c())
      c() = a() * b() : PRINT FNshowmm(a(), "*", b(), c())
      c() = a() / b() : PRINT FNshowmm(a(), "/", b(), c())
      PROCpowmm(a(), b(), c()) : PRINT FNshowmm(a(), "^", b(), c()) '

      REM Matrix-Scalar:
      c() = a() + 3 : PRINT FNshowms(a(), "+", 3, c())
      c() = a() - 3 : PRINT FNshowms(a(), "-", 3, c())
      c() = a() * 3 : PRINT FNshowms(a(), "*", 3, c())
      c() = a() / 3 : PRINT FNshowms(a(), "/", 3, c())
      PROCpowms(a(), 3, c()) : PRINT FNshowms(a(), "^", 3, c())
      END

      DEF PROCpowmm(a(), b(), c())
      LOCAL i%, j%
      FOR i% = 0 TO DIM(a(),1)
        FOR j% = 0 TO DIM(a(),2)
          c(i%,j%) = a(i%,j%) ^ b(i%,j%)
        NEXT
      NEXT
      ENDPROC

      DEF PROCpowms(a(), b, c())
      LOCAL i%, j%
      FOR i% = 0 TO DIM(a(),1)
        FOR j% = 0 TO DIM(a(),2)
          c(i%,j%) = a(i%,j%) ^ b
        NEXT
      NEXT
      ENDPROC

      DEF FNshowmm(a(), op$, b(), c())
      = FNlist(a()) + " " + op$ + " " + FNlist(b()) + " = " + FNlist(c())

      DEF FNshowms(a(), op$, b, c())
      = FNlist(a()) + " " + op$ + " " + STR$(b) + " = " + FNlist(c())

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


#include <math.h>

#define for_i for(i = 0; i < h; i++)
#define for_j for(j = 0; j < w; j++)
#define _M double**
#define OPM(name, _op_) \
	void eop_##name(_M a, _M b, _M c, int w, int h){int i,j;\
		for_i for_j c[i][j] = a[i][j] _op_ b[i][j];}
OPM(add, +);OPM(sub, -);OPM(mul, *);OPM(div, /);

#define OPS(name, res) \
	void eop_s_##name(_M a, double s, _M b, int w, int h) {double x;int i,j;\
		for_i for_j {x = a[i][j]; b[i][j] = res;}}
OPS(mul, x*s);OPS(div, x/s);OPS(add, x+s);OPS(sub, x-s);OPS(pow, pow(x, s));


using System;
using System.Collections.Generic;
using System.Linq;

public static class ElementWiseOperations
{
    private static readonly Dictionary<string, Func<double, double, double>> operations =
        new Dictionary<string, Func<double, double, double>> {
            { "add", (a, b) => a + b },
            { "sub", (a, b) => a - b },
            { "mul", (a, b) => a * b },
            { "div", (a, b) => a / b },
            { "pow", (a, b) => Math.Pow(a, b) }
        };

    private static readonly Func<double, double, double> nothing = (a, b) => a;

    public static double[,] DoOperation(this double[,] m, string name, double[,] other) =>
        DoOperation(m, operations.TryGetValue(name, out var operation) ? operation : nothing, other);

    public static double[,] DoOperation(this double[,] m, Func<double, double, double> operation, double[,] other) {
        if (m == null || other == null) throw new ArgumentNullException();
        int rows = m.GetLength(0), columns = m.GetLength(1);
        if (rows != other.GetLength(0) || columns != other.GetLength(1)) {
            throw new ArgumentException("Matrices have different dimensions.");
        }

        double[,] result = new double[rows, columns];
        for (int r = 0; r < rows; r++) {
            for (int c = 0; c < columns; c++) {
                result[r, c] = operation(m[r, c], other[r, c]);
            }
        }
        return result;
    }

    public static double[,] DoOperation(this double[,] m, string name, double number) =>
        DoOperation(m, operations.TryGetValue(name, out var operation) ? operation : nothing, number);

    public static double[,] DoOperation(this double[,] m, Func<double, double, double> operation, double number) {
        if (m == null) throw new ArgumentNullException();
        int rows = m.GetLength(0), columns = m.GetLength(1);
        double[,] result = new double[rows, columns];
        for (int r = 0; r < rows; r++) {
            for (int c = 0; c < columns; c++) {
                result[r, c] = operation(m[r, c], number);
            }
        }
        return result;
    }

    public static void Print(this double[,] m) {
        if (m == null) throw new ArgumentNullException();
        int rows = m.GetLength(0), columns = m.GetLength(1);
        for (int r = 0; r < rows; r++) {
            Console.WriteLine("[ " + string.Join(", ", Enumerable.Range(0, columns).Select(c => m[r, c])) + " ]");
        }
    }

}

public class Program
{
    public static void Main() {
        double[,] matrix = {
            { 1, 2, 3, 4 },
            { 5, 6, 7, 8 },
            { 9, 10, 11, 12 }
        };

        double[,] tens = {
            { 10, 10, 10, 10 },
            { 20, 20, 20, 20 },
            { 30, 30, 30, 30 }
        };

        matrix.Print();
        WriteLine();

        (matrix = matrix.DoOperation("add", tens)).Print();
        WriteLine();

        matrix.DoOperation((a, b) => b - a, 100).Print();
    }
}


#include <cassert>
#include <cmath>
#include <iostream>
#include <valarray>

template <typename scalar_type> class matrix {
public:
    matrix(size_t rows, size_t columns) : rows_(rows), columns_(columns) {
        elements_.resize(rows * columns);
    }
    matrix(size_t rows, size_t columns, scalar_type value)
        : rows_(rows), columns_(columns), elements_(value, rows * columns) {}

    size_t rows() const { return rows_; }
    size_t columns() const { return columns_; }

    const scalar_type& at(size_t row, size_t column) const {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[index(row, column)];
    }
    scalar_type& at(size_t row, size_t column) {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[index(row, column)];
    }

    matrix& operator+=(scalar_type e) {
        elements_ += e;
        return *this;
    }
    matrix& operator-=(scalar_type e) {
        elements_ -= e;
        return *this;
    }
    matrix& operator*=(scalar_type e) {
        elements_ *= e;
        return *this;
    }
    matrix& operator/=(scalar_type e) {
        elements_ /= e;
        return *this;
    }

    matrix& operator+=(const matrix& other) {
        assert(rows_ == other.rows_);
        assert(columns_ == other.columns_);
        elements_ += other.elements_;
        return *this;
    }
    matrix& operator-=(const matrix& other) {
        assert(rows_ == other.rows_);
        assert(columns_ == other.columns_);
        elements_ -= other.elements_;
        return *this;
    }
    matrix& operator*=(const matrix& other) {
        assert(rows_ == other.rows_);
        assert(columns_ == other.columns_);
        elements_ *= other.elements_;
        return *this;
    }
    matrix& operator/=(const matrix& other) {
        assert(rows_ == other.rows_);
        assert(columns_ == other.columns_);
        elements_ /= other.elements_;
        return *this;
    }

    matrix& negate() {
        for (scalar_type& element : elements_)
            element = -element;
        return *this;
    }
    matrix& invert() {
        for (scalar_type& element : elements_)
            element = 1 / element;
        return *this;
    }

    friend matrix pow(const matrix& a, scalar_type b) {
        return matrix(a.rows_, a.columns_, std::pow(a.elements_, b));
    }
    friend matrix pow(const matrix& a, const matrix& b) {
        assert(a.rows_ == b.rows_);
        assert(a.columns_ == b.columns_);
        return matrix(a.rows_, a.columns_, std::pow(a.elements_, b.elements_));
    }
private:
    matrix(size_t rows, size_t columns, std::valarray<scalar_type>&& values)
        : rows_(rows), columns_(columns), elements_(std::move(values)) {}

    size_t index(size_t row, size_t column) const {
        return row * columns_ + column;
    }
    size_t rows_;
    size_t columns_;
    std::valarray<scalar_type> elements_;
};

template <typename scalar_type>
matrix<scalar_type> operator+(const matrix<scalar_type>& a, scalar_type b) {
    matrix<scalar_type> c(a);
    c += b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator-(const matrix<scalar_type>& a, scalar_type b) {
    matrix<scalar_type> c(a);
    c -= b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator*(const matrix<scalar_type>& a, scalar_type b) {
    matrix<scalar_type> c(a);
    c *= b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator/(const matrix<scalar_type>& a, scalar_type b) {
    matrix<scalar_type> c(a);
    c /= b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator+(scalar_type a, const matrix<scalar_type>& b) {
    matrix<scalar_type> c(b);
    c += a;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator-(scalar_type a, const matrix<scalar_type>& b) {
    matrix<scalar_type> c(b);
    c.negate() += a;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator*(scalar_type a, const matrix<scalar_type>& b) {
    matrix<scalar_type> c(b);
    c *= a;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator/(scalar_type a, const matrix<scalar_type>& b) {
    matrix<scalar_type> c(b);
    c.invert() *= a;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator+(const matrix<scalar_type>& a,
                              const matrix<scalar_type>& b) {
    matrix<scalar_type> c(a);
    c += b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator-(const matrix<scalar_type>& a,
                              const matrix<scalar_type>& b) {
    matrix<scalar_type> c(a);
    c -= b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator*(const matrix<scalar_type>& a,
                              const matrix<scalar_type>& b) {
    matrix<scalar_type> c(a);
    c *= b;
    return c;
}

template <typename scalar_type>
matrix<scalar_type> operator/(const matrix<scalar_type>& a,
                              const matrix<scalar_type>& b) {
    matrix<scalar_type> c(a);
    c /= b;
    return c;
}

template <typename scalar_type>
void print(std::ostream& out, const matrix<scalar_type>& matrix) {
    out << '[';
    size_t rows = matrix.rows(), columns = matrix.columns();
    for (size_t row = 0; row < rows; ++row) {
        if (row > 0)
            out << ", ";
        out << '[';
        for (size_t column = 0; column < columns; ++column) {
            if (column > 0)
                out << ", ";
            out << matrix.at(row, column);
        }
        out << ']';
    }
    out << "]\n";
}

void test_matrix_matrix() {
    const size_t rows = 3, columns = 2;
    matrix<double> a(rows, columns);
    for (size_t i = 0; i < rows; ++i) {
        for (size_t j = 0; j < columns; ++j)
            a.at(i, j) = double(columns * i + j + 1);
    }
    matrix<double> b(a);

    std::cout << "a + b:\n";
    print(std::cout, a + b);

    std::cout << "\na - b:\n";
    print(std::cout, a - b);

    std::cout << "\na * b:\n";
    print(std::cout, a * b);

    std::cout << "\na / b:\n";
    print(std::cout, a / b);

    std::cout << "\npow(a, b):\n";
    print(std::cout, pow(a, b));
}

void test_matrix_scalar() {
    const size_t rows = 3, columns = 4;
    matrix<double> a(rows, columns);
    for (size_t i = 0; i < rows; ++i) {
        for (size_t j = 0; j < columns; ++j)
            a.at(i, j) = double(columns * i + j + 1);
    }

    std::cout << "a + 10:\n";
    print(std::cout, a + 10.0);

    std::cout << "\na - 10:\n";
    print(std::cout, a - 10.0);

    std::cout << "\n10 - a:\n";
    print(std::cout, 10.0 - a);

    std::cout << "\na * 10:\n";
    print(std::cout, a * 10.0);

    std::cout << "\na / 10:\n";
    print(std::cout, a / 10.0);

    std::cout << "\npow(a, 0.5):\n";
    print(std::cout, pow(a, 0.5));
}

int main() {
    test_matrix_matrix();
    std::cout << '\n';
    test_matrix_scalar();
    return 0;
}


(defn initial-mtx [i1 i2 value]
  (vec (repeat i1 (vec (repeat i2 value)))))

(defn operation [f mtx1 mtx2]
  (if (vector? mtx1)
    (vec (map #(vec (map f %1 %2)) mtx1 mtx2)))
    (recur f (initial-mtx (count mtx2) (count (first mtx2)) mtx1) mtx2)
  ))


(defun element-wise-matrix (fn A B)
  (let* ((len (array-total-size A))
         (m   (car (array-dimensions A)))
         (n   (cadr (array-dimensions A)))
         (C   (make-array `(,m ,n) :initial-element 0.0d0)))

    (loop for i from 0 to (1- len) do
         (setf (row-major-aref C i)
               (funcall fn
                        (row-major-aref A i)
                        (row-major-aref B i))))
    C))

;; A.+B, A.-B, A.*B, A./B, A.^B.
(defun m+ (A B) (element-wise-matrix #'+    A B))
(defun m- (A B) (element-wise-matrix #'-    A B))
(defun m* (A B) (element-wise-matrix #'*    A B))
(defun m/ (A B) (element-wise-matrix #'/    A B))
(defun m^ (A B) (element-wise-matrix #'expt A B))


import std.stdio, std.typetuple, std.traits;

T[][] elementwise(string op, T, U)(in T[][] A, in U B) {
  auto R = new typeof(return)(A.length, A[0].length);
  foreach (r, row; A)
    R[r][] = mixin("row[] " ~ op ~ (isNumeric!U ? "B" : "B[r][]"));
  return R;
}

void main() {
  const M = [[3, 5, 7], [1, 2, 3], [2, 4, 6]];
  foreach (op; TypeTuple!("+", "-", "*", "/", "^^"))
    writefln("%s:\n[%([%(%d, %)],\n %)]]\n\n[%([%(%d, %)],\n %)]]\n",
             op, elementwise!op(M, 2), elementwise!op(M, M));
}


EVAL
=LAMBDA(s, EVALUATE(s))

matrix
={1,2,3;4,5,6;7,8,9}


USING: combinators.extras formatting kernel math.functions
math.matrices math.vectors prettyprint sequences ;

: show ( a b words -- )
    [
        3dup execute( x x -- x ) [ unparse ] dip
        "%u %u %s = %u\n" printf
    ] 2with each ; inline

: m^n ( m n -- m ) [ ^ ] curry matrix-map ;
: m^  ( m m -- m ) [ v^ ] 2map ;

{ { 1 2 } { 3 4 } } { { 5 6 } { 7 8 } } { m+ m- m* m/ m^ }
{ { -1 9 4 } { 5 -13 0 } } 3 { m+n m-n m*n m/n m^n }
[ show ] [email protected]


program element_operations
  implicit none

  real(kind=4), dimension(3,3) :: a,b
  integer :: i

  a=reshape([(i,i=1,9)],shape(a))

  print*,'addition'
  b=a+a
  call print_arr(b)

  print*,'multiplication'
  b=a*a
  call print_arr(b)

  print*,'division'
  b=a/b
  call print_arr(b)

  print*,'exponentiation'
  b=a**a
  call print_arr(b)

  print*,'trignometric'
  b=cos(a)
  call print_arr(b)

  print*,'mod'
  b=mod(int(a),3)
  call print_arr(b)

  print*,'element selection'
  b=0
  where(a>3) b=1
  call print_arr(b)

  print*,'elemental functions can be applied to single values:'
  print*,square(3.0)
  print*,'or element wise to arrays:'
  b=square(a)
  call print_arr(b)

contains

  elemental real function square(a)
    real, intent(in) :: a
    square=a*a
  end function square

  subroutine print_arr(arr)
    real, intent(in) :: arr(:,:)
    integer :: i
    do i=1,size(arr,dim=2)
       print*,arr(:,i)
    end do
  end subroutine print_arr

end program element_operations


Dim Shared As Double a(1,2) = {{7, 8, 7}, {4, 0, 9}}
Dim Shared As Double b(1,2) = {{4, 5, 1}, {6, 2, 1}}
Dim Shared As Double c(1,2)
Dim Shared As Double fila, columna
Dim Shared As String p

Sub list(a() As Double)
    p = "["
    For fila = 0 To Ubound(a,1)
        p &= "["
        For columna = 0 To Ubound(b,2)
            p &= Str(a(fila, columna)) + ", "
        Next columna
        p = Left(p,Len(p)-2) + "]"
    Next fila
    p &= "]"
    Print p;
End Sub

REM Matrix-Matrix:
Sub Mostrarmm(a() As Double, op As String, b() As Double, c() As Double)
    list(a()) : Print " "; op; " "; : list(b()) : Print " = "; : list(c()) : Print
End Sub

Sub addmm(a() As Double, b() As Double, c() As Double)
    REM adición
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(b,2) To Ubound(b,2)
            c(fila, columna) = a(fila,columna) + b(fila,columna)
        Next columna
    Next fila
End Sub

Sub resmm(a() As Double, b() As Double, c() As Double)
    REM sustracción
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(b,2) To Ubound(b,2)
            c(fila, columna) = a(fila,columna) - b(fila,columna)
        Next columna
    Next fila
End Sub

Sub mulmm(a() As Double, b() As Double, c() As Double)
    REM multiplicación
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(b,2) To Ubound(b,2)
            c(fila, columna) = a(fila,columna) * b(fila,columna)
        Next columna
    Next fila
End Sub

Sub divmm(a() As Double, b() As Double, c() As Double)
    REM división
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(b,2) To Ubound(b,2)
            c(fila, columna) = a(fila,columna) / b(fila,columna)
        Next columna
    Next fila
End Sub

Sub powmm(a() As Double, b() As Double, c() As Double)
    REM exponenciación
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(b,2) To Ubound(b,2)
            c(fila, columna) = a(fila,columna) ^ b(fila,columna)
        Next columna
    Next fila
End Sub

REM Matrix-Scalar:
Sub Mostrarms(a() As Double, op As String, b As Double, c() As Double)
    list(a()) : Print " "; op; " "; Str(b); " = "; : list(c()) : Print
End Sub

Sub addms(a() As Double, b As Double, c() As Double)
    REM adición
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(a,2) To Ubound(a,2)
            c(fila, columna) = a(fila,columna) + b
        Next columna
    Next fila
End Sub

Sub resms(a() As Double, b As Double, c() As Double)
    REM sustracción
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(a,2) To Ubound(a,2)
            c(fila, columna) = a(fila,columna) - b
        Next columna
    Next fila
End Sub

Sub mulms(a() As Double, b As Double, c() As Double)
    REM multiplicación
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(a,2) To Ubound(a,2)
            c(fila, columna) = a(fila,columna) * b
        Next columna
    Next fila
End Sub

Sub divms(a() As Double, b As Double, c() As Double)
    REM división
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(a,2) To Ubound(a,2)
            c(fila, columna) = a(fila,columna) / b
        Next columna
    Next fila
End Sub

Sub powms(a() As Double, b As Double, c() As Double)
    REM exponenciación
    For fila = Lbound(a,1) To Ubound(a,1)
        For columna = Lbound(a,2) To Ubound(a,2)
            c(fila, columna) = a(fila,columna) ^ b
        Next columna
    Next fila
End Sub

REM Matrix-Matrix:
addmm(a(), b(), c()) : Mostrarmm(a(), "+", b(), c())
resmm(a(), b(), c()) : Mostrarmm(a(), "-", b(), c())
mulmm(a(), b(), c()) : Mostrarmm(a(), "*", b(), c())
divmm(a(), b(), c()) : Mostrarmm(a(), "/", b(), c())
powmm(a(), b(), c()) : Mostrarmm(a(), "^", b(), c())
Print
REM Matrix-Scalar:
addms(a(), 3, c()) : Mostrarms(a(), "+", 3, c())
resms(a(), 3, c()) : Mostrarms(a(), "-", 3, c())
mulms(a(), 3, c()) : Mostrarms(a(), "*", 3, c())
divms(a(), 3, c()) : Mostrarms(a(), "/", 3, c())
powms(a(), 3, c()) : Mostrarms(a(), "^", 3, c())
Sleep