#include <tcl.h>

/* A data structure used to enforce data safety */
struct block {
    int size;
    unsigned char data[4];
};

static int
Memalloc(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const *objv)
{
    Tcl_HashTable *nameMap = clientData;
    static int nameCounter = 0;
    char nameBuf[30];
    Tcl_HashEntry *hPtr;
    int size, dummy;
    struct block *blockPtr;

    /* Parse arguments */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "size");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &size) != TCL_OK) {
	return TCL_ERROR;
    }
    if (size < 1) {
	Tcl_AppendResult(interp, "size must be positive", NULL);
	return TCL_ERROR;
    }

    /* The ckalloc() function will panic on failure to allocate. */
    blockPtr = (struct block *)
	    ckalloc(sizeof(struct block) + (unsigned) (size<4 ? 0 : size-4));

    /* Set up block */
    blockPtr->size = size;
    memset(blockPtr->data, 0, blockPtr->size);

    /* Give it a name and return the name */
    sprintf(nameBuf, "block%d", nameCounter++);
    hPtr = Tcl_CreateHashEntry(nameMap, nameBuf, &dummy);
    Tcl_SetHashValue(hPtr, blockPtr);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(nameBuf, -1));
    return TCL_OK;
}

static int
Memfree(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const *objv)
{
    Tcl_HashTable *nameMap = clientData;
    Tcl_HashEntry *hPtr;
    struct block *blockPtr;

    /* Parse the arguments */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "handle");
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "unknown handle", NULL);
	return TCL_ERROR;
    }
    blockPtr = Tcl_GetHashValue(hPtr);

    /* Squelch the memory */
    Tcl_DeleteHashEntry(hPtr);
    ckfree((char *) blockPtr);
    return TCL_OK;
}

static int
Memset(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const *objv)
{
    Tcl_HashTable *nameMap = clientData;
    Tcl_HashEntry *hPtr;
    struct block *blockPtr;
    int index, byte;

    /* Parse the arguments */
    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "handle index byte");
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "unknown handle", NULL);
	return TCL_ERROR;
    }
    blockPtr = Tcl_GetHashValue(hPtr);
    if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[3], &byte) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0 || index >= blockPtr->size) {
	Tcl_AppendResult(interp, "index out of range", NULL);
	return TCL_ERROR;
    }

    /* Update the byte of the data block */
    blockPtr->data[index] = (unsigned char) byte;
    return TCL_OK;
}

static int
Memget(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const *objv)
{
    Tcl_HashTable *nameMap = clientData;
    Tcl_HashEntry *hPtr;
    struct block *blockPtr;
    int index, byte;

    /* Parse the arguments */
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "handle index");
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "unknown handle", NULL);
	return TCL_ERROR;
    }
    blockPtr = Tcl_GetHashValue(hPtr);
    if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0 || index >= blockPtr->size) {
	Tcl_AppendResult(interp, "index out of range", NULL);
	return TCL_ERROR;
    }

    /* Read the byte from the data block and return it */
    Tcl_SetObjResult(interp, Tcl_NewIntObj(blockPtr->data[index]));
    return TCL_OK;
}

static int
Memaddr(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const *objv)
{
    Tcl_HashTable *nameMap = clientData;
    Tcl_HashEntry *hPtr;
    struct block *blockPtr;
    int addr;

    /* Parse the arguments */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "handle");
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "unknown handle", NULL);
	return TCL_ERROR;
    }
    blockPtr = Tcl_GetHashValue(hPtr);

    /* This next line is non-portable */
    addr = (int) blockPtr->data;
    Tcl_SetObjResult(interp, Tcl_NewIntObj(addr));
    return TCL_OK;
}

int
Memalloc_Init(Tcl_Interp *interp)
{
    /* Make the hash table */
    Tcl_HashTable *hashPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(hashPtr, TCL_STRING_KEYS);

    /* Register the commands */
    Tcl_CreateObjCommand(interp, "memalloc", Memalloc, hashPtr, NULL);
    Tcl_CreateObjCommand(interp, "memfree", Memfree, hashPtr, NULL);
    Tcl_CreateObjCommand(interp, "memset", Memset, hashPtr, NULL);
    Tcl_CreateObjCommand(interp, "memget", Memget, hashPtr, NULL);
    Tcl_CreateObjCommand(interp, "memaddr", Memaddr, hashPtr, NULL);

    /* Register the package */
    return Tcl_PkgProvide(interp, "memalloc", "1.0");
}


include "cowgol.coh";

const MAX := 1000;

# Table output
sub printtab(n: int8) is
    if n<0 then
        print_char('-');
        n := -n;
    else
        print_char(' ');
    end if;
    print_char(n as uint8 + '0');
    print_char(' ');
end sub;

# Generate Merten numbers
var M: int8[MAX+1];
M[0] := 0;
M[1] := 1;

var n: @indexof M := 2;
while n < @sizeof M loop
    M[n] := 1;
    var k: @indexof M := 2;
    while k <= n loop
        M[n] := M[n] - M[n/k];
        k := k + 1;
    end loop;
    n := n + 1;
end loop;

# Find zeroes and crossings
var zero: uint8 := 0;
var cross: uint8 := 0;
n := 1;
while n < @sizeof M loop
    if M[n] == 0 then
        zero := zero + 1;
        if M[n-1] != 0 then
            cross := cross + 1;
        end if;
    end if;
    n := n + 1;
end loop;

# Print table
print("The first 99 Mertens numbers are:\n");
print("   ");
n := 1;
var col: uint8 := 9;
while n < 100 loop
    printtab(M[n]);
    col := col - 1;
    if col == 0 then
        print_nl();
        col := 10;
    end if;
    n := n + 1;
end loop;

print("M(n) is zero "); print_i8(zero); print(" times\n");
print("M(n) crosses zero "); print_i8(cross); print(" times\n");


program Mertens_function;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TMertens = record
    merts: TArray<Integer>;
    zeros, crosses: Integer;
    class function Mertens(_to: Integer): TMertens; static;
  end;

{ TMertens }

class function TMertens.Mertens(_to: Integer): TMertens;
var
  sum, zeros, crosses: Integer;
begin
  if _to < 1 then
    _to := 1;

  sum := 0;
  zeros := 0;
  crosses := 0;

  SetLength(Result.merts, _to + 1);
  var primes := [2];
  for var i := 1 to _to do
  begin
    var j := i;
    var cp := 0;
    var spf := false;
    for var p in primes do
    begin
      if p > j then
        Break;
      if j mod p = 0 then
      begin
        j := j div p;
        inc(cp);
      end;

      if j mod p = 0 then
      begin
        spf := true;
        Break;
      end;
    end;
    if (cp = 0) and (i > 2) then
    begin
      cp := 1;
      SetLength(primes, Length(primes) + 1);
      primes[High(primes)] := i;
    end;

    if not spf then
    begin
      if cp mod 2 = 0 then
        inc(sum)
      else
        dec(sum);
    end;

    Result.merts[i] := sum;
    if sum = 0 then
    begin
      inc(zeros);
      if (i > 1) and (Result.merts[i - 1] <> 0) then
        inc(crosses);
    end;
  end;
  Result.zeros := zeros;
  Result.crosses := crosses;
end;

begin
  var m := TMertens.mertens(1000);
  writeln('Mertens sequence - First 199 terms:');
  for var i := 0 to 199 do
  begin
    if i = 0 then
    begin
      write('    ');
      Continue;
    end;
    if i mod 20 = 0 then
      writeln;
    write(format(' %3d', [m.merts[i]]));
  end;
  writeln(#10#10'Equals zero ', m.zeros, ' times between 1 and 1000');
  writeln(#10'Crosses zero ', m.crosses, ' times between 1 and 1000');
  {$IFNDEF UNIX} readln; {$ENDIF}
end.


package main

import "fmt"

type rs232p9 uint16

const (
	CD9  rs232p9 = 1 << iota // Carrier detect
	RD9                      // Received data
	TD9                      // Transmitted data
	DTR9                     // Data terminal ready
	SG9                      // signal ground
	DSR9                     // Data set ready
	RTS9                     // Request to send
	CTS9                     // Clear to send
	RI9                      // Ring indicator
)

func main() {
	// set some nonsense bits just for example
	p := RI9 | TD9 | CD9
	fmt.Printf("Type=%T value=%#04x\n", p, p)
}


labels=: <;._2]0 :0
CD   Carrier detect
RD   Received data
TD   Transmitted data
DTR  Data terminal ready
SG   Signal ground
DSR  Data set ready
RTS  Request to send
CTS  Clear to send
RI   Ring indicator
)


1  2  3  4  5
6  7  8  9
                        9 pin
PG   Protective ground
TD   Transmitted data     3
RD   Received data        2
RTS  Request to send      7
CTS  Clear to send        8
DSR  Data set ready       6
SG   Signal ground        5
CD   Carrier detect       1
+ voltage (testing)


// version 1.0.6

const val OFF = false
const val ON  = true

fun toOnOff(b: Boolean) = if (b) "ON" else "OFF"

data class Rs232Pins9(
    var carrierDetect     : Boolean = OFF,
    var receivedData      : Boolean = OFF,
    var transmittedData   : Boolean = OFF,
    var dataTerminalReady : Boolean = OFF,
    var signalGround      : Boolean = OFF,
    var dataSetReady      : Boolean = OFF,
    var requestToSend     : Boolean = OFF,
    var clearToSend       : Boolean = OFF,
    var ringIndicator     : Boolean = OFF
) {
    fun setPin(n: Int, v: Boolean) {
        when (n) {
            1 -> carrierDetect     = v
            2 -> receivedData      = v
            3 -> transmittedData   = v
            4 -> dataTerminalReady = v
            5 -> signalGround      = v
            6 -> dataSetReady      = v
            7 -> requestToSend     = v
            8 -> clearToSend       = v
            9 -> ringIndicator     = v
        }
    }
}

fun main(args: Array<String>) {
    val plug = Rs232Pins9(carrierDetect = ON, receivedData = ON) // set first two pins, say
    println(toOnOff(plug.component2()))                          // print value of pin 2 by number
    plug.transmittedData = ON                                    // set pin 3 by name
    plug.setPin(4, ON)                                           // set pin 4 by number
    println(toOnOff(plug.component3()))                          // print value of pin 3 by number
    println(toOnOff(plug.dataTerminalReady))                     // print value of pin 4 by name
    println(toOnOff(plug.ringIndicator))                         // print value of pin 9 by name
}


// create a list with 10 elements all initialized to zero
var squares = List.filled(10, 0)
// give them different values and print them
for (i in 0..9) squares[i] = i * i
System.print(squares)
// add another element to the list dynamically and print it again
squares.add(10 * 10)
System.print(squares)
squares = null // make eligible for GC


; linux x86_64

struc block
free: resb 1 ; whether or not this block is free
size: resb 2 ; size of the chunk of memory
next: resb 8 ; the next chunk after this one
mem:
endstruc

section .data
hStart: dq 0 ; the beginning of our heap space
break: dq 0 ; the current end of our heap space

section .text

Allocate:

  push rdi ; save the size argument

  cmp qword [break], 0 ; if breakpoint is zero this
  je firstAlloc        ; is the first call to allocate

  mov rdi, qword [hStart] ; else address of heap start

  findBlock: ; look for a suitable block of memory

    cmp byte [rdi + free], 2
    je newBlock ; end of heap reached, create new block

    cmp byte [rdi + free], 0
    je skipBlock ; this block taken

    ; this block is free, make
    ; sure it's big enough
    mov bx, word [rdi + size]
    mov rcx, qword [rsp] ; compare against our size arg
    cmp cx, bx
    jg skipBlock ; keep looking if not big enough

    mov byte [rdi + free], 0 ; else mark as taken
    add rdi, mem
    add rsp, 8 ; discard size arg, we didn't need it
    mov rax, rdi ; return pointer to this block
    ret

    skipBlock:
      mov rsi, qword [rdi + next] ; load next
      mov rdi, rsi                ' block address
      jmp findBlock

    newBlock:
      mov rax, rdi
      add rdi, 1024
      cmp rdi, qword [break]
      jl initAndAllocate
      push rax
      mov rdi, qword [break] ; if we are getting low on
      add rdi, 4096          ; heap space, we ask OS for
      mov rax, 12            ; more memory with brk syscall
      syscall
      cmp rax, qword [break] ; if breakpoint has not increased,
      je allocFail           ; then memory could not be allocated
      mov qword [break], rax
      pop rax
      jmp initAndAllocate

  firstAlloc:    ; extra work has to be done on first
    mov rax, 12  ; call to this subroutine
    mov rdi, 0
    syscall
    mov qword [hStart], rax ; init heap start
    add rax, 4096
    mov rdi, rax
    mov rax, 12   ; get heap memory with sys brk
    syscall
    cmp rax, qword [hStart]
    je allocFail
    mov qword [break], rax
    mov rax, qword [hStart]

  initAndAllocate:
    mov byte [rax + free], 0  ; mark block free
    pop rdi ; pop size arg off stack
    mov word [rax + size], di ; mark it's size
    lea rsi, [rax + mem + rdi]
    mov byte [rsi + free], 2 ; mark heap end block
    mov qword [rax + next], rsi ; mark next block
    add rax, mem ; return pointer to block's memory space
    ret

allocFail: ; exit(1) when allocation fails
  mov rax, 60
  mov rdi, 1
  syscall
  ret

; free this block so it can be
; reused in a subsequent call to allocate
Release:
  sub rdi, mem
  mov byte [rdi + free], 1
  ret


int Array(10);          \allocates 10 integers (40 bytes) of heap space
Array2:= Reserve(10*4); \another way to allocate 10 integers of heap space
Array3:= MAlloc(4);     \allocate 4 paragraphs (64 bytes) of conventional memory
...
Release(Array3);        \release this memory so it can be used elsewhere


Data(123);  // this bit bucket expects hold 123 bytes
List.createLong(123);  // this list expects to hold 123 elements


10 REM This code is written for a 48k spectrum
20 CLEAR 65535 - 8192: REM reserve 8192 bytes of memory
30 CLEAR 65535: REM unreserve the memory, moving the ramtop back to the top of the ram


proc nonrec mertens([*] short m) void:
    word n,k;
    m[1] := 1;
    for n from 2 upto dim(m,1)-1 do
        m[n] := 1;
        for k from 2 upto n do
            m[n] := m[n] - m[n/k]
        od
    od
corp

proc nonrec main() void:
    [1001] short m;
    word x, y, eqz, crossz;

    mertens(m);
    writeln("The first 99 Mertens numbers are:");
    for y from 0 by 10 upto 90 do
        for x from 0 upto 9 do
            if x+y=0
                then write("   ")
                else write(m[x+y]:3)
            fi
        od;
        writeln()
    od;

    eqz := 0;
    crossz := 0;
    for x from 2 upto dim(m,1)-1 do
        if m[x]=0 then
            eqz := eqz + 1;
            if m[x-1]~=0 then crossz := crossz + 1 fi
        fi
    od;
    writeln("M(N) is zero ",eqz," times.");
    writeln("M(N) crosses zero ",crossz," times.")
corp


func mertensNumbers(max) {
    let mertens = Array.Empty(max + 1, 1)
    for n in 2..max {
        for k in 2..n {
            mertens[n] -= mertens[n / k]
        }
    }
    mertens
}

let max = 1000
let mertens = mertensNumbers(max)

let count = 200
let columns = 20
print("First \(count - 1) Mertens numbers:")

for i in 0..<count {
    if i % columns > 0 {
        print(" ", terminator: "")
    }
    print(i == 0 ? "   " : mertens[i].ToString().PadLeft(2, ' ') + " ", terminator: "")
    if (i + 1) % columns == 0 {
        print()
    }
}

var (zero, cross, previous) = (0, 0, 0)
for i in 1..max {
    let m = mertens[i]
    if m == 0 {
        zero += 1
        if previous != 0 {
            cross += 1
        }
    }
    previous = m
}

print("M(n) is zero \(zero) times for 1 <= n <= \(max).")
print("M(n) crosses zero \(cross) times for 1 <= n <= \(max).")


// Mertens function. Nigel Galloway: January 31st., 2021
let mertens=mobius|>Seq.scan((+)) 0|>Seq.tail
mertens|>Seq.take 500|>Seq.chunkBySize 25|>Seq.iter(fun n->Array.iter(printf "%3d") n;printfn "\n####")
let n=mertens|>Seq.take 1000|>Seq.mapi(fun n g->(n+1,g))|>Seq.groupBy snd|>Map.ofSeq
n|>Map.iter(fun n g->printf "%3d->" n; g|>Seq.iter(fun(n,_)->printf "%3d " n); printfn "\n####")
printfn "%d Zeroes\n####" (Seq.length (snd n.[0]))
printfn "Crosses zero %d times" (mertens|>Seq.take 1000|>Seq.pairwise|>Seq.sumBy(fun(n,g)->if n<>0 && g=0 then 1 else 0)))


>> rs232 = struct('carrier_detect', logical(1),...
'received_data' , logical(1), ...
'transmitted_data', logical(1),...
'data_terminal_ready', logical(1),...
'signal_ground', logical(1),...
'data_set_ready', logical(1),...
'request_to_send', logical(1),...
'clear_to_send', logical(1),...
'ring_indicator', logical(1))

rs232 =

         carrier_detect: 1
          received_data: 1
       transmitted_data: 1
    data_terminal_ready: 1
          signal_ground: 1
         data_set_ready: 1
        request_to_send: 1
          clear_to_send: 1
         ring_indicator: 1

>> struct2cell(rs232)

ans =

    [1]
    [1]
    [1]
    [1]
    [1]
    [1]
    [1]
    [1]
    [1]


:- module rs232.

:- interface.

:- import_module bool, io, list, string.

:- type rs232_pin
   ---> carrier_detect
      ; received_data
      ; transmitted_data
      ; data_terminal_ready
      ; signal_ground
      ; data_set_ready
      ; request_to_send
      ; clear_to_send
      ; ring_indicator.

:- type rs232.

:- func rs232_bits       = rs232.
:- func rs232_bits(bool) = rs232.

:- func rs232_set(rs232, rs232_pin)   = rs232.
:- func rs232_clear(rs232, rs232_pin) = rs232.

:- pred rs232_is_set(rs232::in, rs232_pin::in) is semidet.
:- pred rs232_is_clear(rs232::in, rs232_pin::in) is semidet.

:- func rs232_set_bits(rs232, list(rs232_pin))   = rs232.
:- func rs232_clear_bits(rs232, list(rs232_pin)) = rs232.

:- func to_string(rs232) = string.

:- pred write_rs232(rs232::in, io::di, io::uo) is det.

:- implementation.

:- import_module bitmap.

:- type rs232 == bitmap.

rs232_bits          = rs232_bits(no).
rs232_bits(Default) = bitmap.init(9, Default).

rs232_set(A, Pin)   = unsafe_set(A, to_index(Pin)).
rs232_clear(A, Pin) = unsafe_clear(A, to_index(Pin)).

rs232_is_set(A, Pin)   :- unsafe_is_set(A, to_index(Pin)).
rs232_is_clear(A, Pin) :- unsafe_is_clear(A, to_index(Pin)).

rs232_set_bits(A, Pins)   = foldl((func(Pin, B) = rs232_set(B, Pin)), Pins, A).
rs232_clear_bits(A, Pins) = foldl((func(Pin, B) = rs232_clear(B, Pin)), Pins, A).

to_string(A) = bitmap.to_string(A).

write_rs232(A, !IO) :- write_bitmap(resize(A, 16, no), !IO).
                       % cannot write a bitmap that isn't byte-divisible

:- func to_index(rs232_pin) = bit_index.
to_index(carrier_detect)      = 0.
to_index(received_data)       = 1.
to_index(transmitted_data)    = 2.
to_index(data_terminal_ready) = 3.
to_index(signal_ground)       = 4.
to_index(data_set_ready)      = 5.
to_index(request_to_send)     = 6.
to_index(clear_to_send)       = 7.
to_index(ring_indicator)      = 8.

:- end_module rs232.


type
  rs232Data = enum
    carrierDetect,
    receivedData,
    transmittedData,
    dataTerminalReady,
    signalGround,
    dataSetReady,
    requestToSend,
    clearToSend,
    ringIndicator

# Bit vector of 9 bits
var bv = {carrierDetect, signalGround, ringIndicator}
echo cast[uint16](bv) # Conversion of bitvector to 2 bytes for writing

let readValue: uint16 = 123
bv = cast[set[rs232Data]](readValue) # Conversion of a read value to bitvector
echo bv


open ExtLib
class rs232_data = object
  val d = BitSet.create 9

  method carrier_detect      = BitSet.is_set d 0
  method received_data       = BitSet.is_set d 1
  method transmitted_data    = BitSet.is_set d 2
  method data_terminal_ready = BitSet.is_set d 3
  method signal_ground       = BitSet.is_set d 4
  method data_set_ready      = BitSet.is_set d 5
  method request_to_send     = BitSet.is_set d 6
  method clear_to_send       = BitSet.is_set d 7
  method ring_indicator      = BitSet.is_set d 8

  method set_carrier_detect      b = (if b then BitSet.set else BitSet.unset) d 0
  method set_received_data       b = (if b then BitSet.set else BitSet.unset) d 1
  method set_transmitted_data    b = (if b then BitSet.set else BitSet.unset) d 2
  method set_data_terminal_ready b = (if b then BitSet.set else BitSet.unset) d 3
  method set_signal_ground       b = (if b then BitSet.set else BitSet.unset) d 4
  method set_data_set_ready      b = (if b then BitSet.set else BitSet.unset) d 5
  method set_request_to_send     b = (if b then BitSet.set else BitSet.unset) d 6
  method set_clear_to_send       b = (if b then BitSet.set else BitSet.unset) d 7
  method set_ring_indicator      b = (if b then BitSet.set else BitSet.unset) d 8
end
;;


USING: formatting grouping io kernel math math.extras
math.ranges math.statistics prettyprint sequences ;

! Take the cumulative sum of the mobius sequence to avoid
! summing lower terms over and over.
: mertens-upto ( n -- seq ) [1,b] [ mobius ] map cum-sum ;

"The first 199 terms of the Mertens sequence:" print
199 mertens-upto " " prefix 20 group
[ [ "%3s" printf ] each nl ] each nl

"In the first 1,000 terms of the Mertens sequence there are:"
print 1000 mertens-upto
[ [ zero? ] count bl pprint bl "zeros." print ]
[
    2 <clumps> [ first2 [ 0 = not ] [ zero? ] bi* and ] count bl
    pprint bl "zero crossings." print
] bi


: AMOUNT 1000 ;

variable mertens AMOUNT cells allot
: M 1- cells mertens + ; \ 1-indexed array

: make-mertens
  1 1 M !
  2 begin dup AMOUNT <= while
    1 over M !
    2 begin over over >= while
      over over / M @
      2 pick M @ swap -
      2 pick M !
    1+ repeat
    drop
  1+ repeat
  drop
;

: print-row
  begin dup while
    swap dup M @ 3 .r 1+
    swap 1-
  repeat
  drop
;

: print-table ."    "
  1 9 print-row cr
  begin dup 100 < while 10 print-row cr repeat
  drop
;

: find-zero-cross
  0 0
  1 begin dup AMOUNT <= while
    dup M @ 0= if
      swap 1+ swap
      dup 1- M @ 0<> if rot 1+ -rot then
    then
    1+
  repeat
  drop
;

make-mertens
." The first 99 Mertens numbers are:" cr print-table
find-zero-cross
." M(N) is zero " . ." times." cr
." M(N) crosses zero " . ." times." cr
bye


      program Mertens
      implicit none
      integer M(1000), n, k, zero, cross

C     Generate Mertens numbers
      M(1) = 1
      do 10 n=2, 1000
          M(n) = 1
          do 10 k=2, n
              M(n) = M(n) - M(n/k)
 10   continue

C     Print table
      write (*,"('The first 99 Mertens numbers are:')")
      write (*,"('   ')",advance='no')
      k = 9
      do 20 n=1, 99
          write (*,'(I3)',advance='no') M(n)
          k = k-1
          if (k .EQ. 0) then
              k=10
              write (*,*)
          end if
 20   continue

C     Calculate zeroes and crossings
      zero = 0
      cross = 0
      do 30 n=2, 1000
          if (M(n) .EQ. 0) then
              zero = zero + 1
              if (M(n-1) .NE. 0) cross = cross+1
          end if
 30   continue

 40   format("M(N) is zero ",I2," times.")
      write (*,40) zero
 50   format("M(N) crosses zero ",I2," times.")
      write (*,50) cross
      end program


use Bit::Vector::Minimal qw();
my $vec = Bit::Vector::Minimal->new(size => 24);

my %rs232 = reverse (
     1 => 'PG   Protective ground',
     2 => 'TD   Transmitted data',
     3 => 'RD   Received data',
     4 => 'RTS  Request to send',
     5 => 'CTS  Clear to send',
     6 => 'DSR  Data set ready',
     7 => 'SG   Signal ground',
     8 => 'CD   Carrier detect',
     9 => '+ voltage (testing)',
    10 => '- voltage (testing)',
    12 => 'SCD  Secondary CD',
    13 => 'SCS  Secondary CTS',
    14 => 'STD  Secondary TD',
    15 => 'TC   Transmit clock',
    16 => 'SRD  Secondary RD',
    17 => 'RC   Receiver clock',
    19 => 'SRS  Secondary RTS',
    20 => 'DTR  Data terminal ready',
    21 => 'SQD  Signal quality detector',
    22 => 'RI   Ring indicator',
    23 => 'DRS  Data rate select',
    24 => 'XTC  External clock',
);

$vec->set($rs232{'RD   Received data'}, 1);
$vec->get($rs232{'TC   Transmit clock'});


function padto( i as ubyte, j as integer ) as string
    return wspace(i-len(str(j)))+str(j)
end function

dim as integer M( 1 to 1000 ), n, col, k, psum
dim as integer num_zeroes = 0, num_cross = 0
dim as string outstr

M(1) = 1
for n = 2 to 1000
    psum = 0
    for k = 2 to n
        psum += M(int(n/k))
    next k
    M(n) = 1 - psum
    if M(n) = 0 then
        num_zeroes += 1
        if M(n-1)<>0 then
            num_cross += 1
        end if
    end if
next n

print using "There are ### zeroes in the range 1 to 1000."; num_zeroes
print using "There are ### crossings in the range 1 to 1000."; num_cross
print "The first 100 Mertens numbers are: "

for n=1 to 100
    outstr += padto(3, M(n))+"  "
    if n mod 10 = 0 then
        print outstr
        outstr = ""
    end if
next n


package main

import "fmt"

func mertens(to int) ([]int, int, int) {
    if to < 1 {
        to = 1
    }
    merts := make([]int, to+1)
    primes := []int{2}
    var sum, zeros, crosses int
    for i := 1; i <= to; i++ {
        j := i
        cp := 0      // counts prime factors
        spf := false // true if there is a square prime factor
        for _, p := range primes {
            if p > j {
                break
            }
            if j%p == 0 {
                j /= p
                cp++
            }
            if j%p == 0 {
                spf = true
                break
            }
        }
        if cp == 0 && i > 2 {
            cp = 1
            primes = append(primes, i)
        }
        if !spf {
            if cp%2 == 0 {
                sum++
            } else {
                sum--
            }
        }
        merts[i] = sum
        if sum == 0 {
            zeros++
            if i > 1 && merts[i-1] != 0 {
                crosses++
            }
        }
    }
    return merts, zeros, crosses
}

func main() {
    merts, zeros, crosses := mertens(1000)
    fmt.Println("Mertens sequence - First 199 terms:")
    for i := 0; i < 200; i++ {
        if i == 0 {
            fmt.Print("    ")
            continue
        }
        if i%20 == 0 {
            fmt.Println()
        }
        fmt.Printf("  % d", merts[i])
    }
    fmt.Println("\n\nEquals zero", zeros, "times between 1 and 1000")
    fmt.Println("\nCrosses zero", crosses, "times between 1 and 1000")
}


constant CD=1, RD=2, TD=3, DTR=4, ...
atom addr = allocate(2)  -- or wherever
--read
sequence bits = int_to_bits(peek2u(addr),16)
integer dtr = bits[DTR]
--write
bits[DTR] = 1
poke2(addr,bits_to_int(bits))


# Define bit constants
(for (N . Mask) '(CD RD TD DTR SG DSR RTS CTS RI)
   (def Mask (>> (- 1 N) 1)) )

# Test if Clear to send
(when (bit? CTS Data)
   ... )


declare 1 RS232_layout,
   2 Carrier_Detect       Bit(1),
   2 Received_Data        Bit(1),
   2 Transmitted_Data     Bit(1),
   2 Data_Terminal_ready  Bit(1),
   2 Signal_Ground        Bit(1),
   2 Data_Set_Ready       Bit(1),
   2 Request_To_Send      Bit(1),
   2 Clear_To_Send        Bit(1),
   2 Ring_Indicator       Bit(1);


from ctypes import Structure, c_int

rs232_9pin  = "_0 CD RD TD DTR SG DSR RTS CTS RI".split()
rs232_25pin = ( "_0  PG  TD  RD  RTS CTS DSR SG  CD  pos neg"
                "_11 SCD SCS STD TC  SRD RC"
                "_18 SRS DTR SQD RI DRS XTC" ).split()

class RS232_9pin(Structure):
    _fields_ = [(__, c_int, 1) for __ in rs232_9pin]

class RS232_25pin(Structure):
    _fields_ = [(__, c_int, 1) for __ in rs232_25pin]


#lang racket

(require ffi/unsafe)

(define (_autobitmask l)
  (_bitmask (append* (for/list ([x l] [i (in-naturals)]) `(,x = ,(expt 2 i))))))

(define _rs232 (_autobitmask '(CD RD TD DTR SG DSR RTS CTS RI )))

;; Usually it will get used when using foreign functions automatically, but
;; this demonstrates the conversions explicitly
(require (only-in '#%foreign ctype-scheme->c ctype-c->scheme))
((ctype-scheme->c _rs232) '(SG TD RI)) ; -> 276
((ctype-c->scheme _rs232) 276)         ; -> '(TD SG RI)


import           Data.List.Split          (chunksOf)
import qualified Data.MemoCombinators  as Memo
import           Math.NumberTheory.Primes (unPrime, factorise)
import           Text.Printf              (printf)

moebius :: Integer -> Int
moebius = product . fmap m . factorise
  where
    m (p, e)
      | unPrime p == 0 = 0
      | e == 1 = -1
      | otherwise = 0

mertens :: Integer -> Int
mertens = Memo.integral (\n -> sum $ fmap moebius [1..n])

countZeros :: [Integer] -> Int
countZeros = length . filter ((==0) . mertens)

crossesZero :: [Integer] -> Int
crossesZero = length . go . fmap mertens
  where
    go (x:y:xs)
      | y == 0 && x /= 0 = y : go (y:xs)
      | otherwise        = go (y:xs)
    go _ = []

main :: IO ()
main = do
  printf "The first 99 terms for M(1..99):\n\n   "
  mapM_ (printf "%3d" . mertens) [1..9] >> printf "\n"
  mapM_ (\row -> mapM_ (printf "%3d" . mertens) row >> printf "\n") $ chunksOf 10 [10..99]
  printf "\nM(n) is zero %d times for 1 <= n <= 1000.\n" $ countZeros [1..1000]
  printf "M(n) crosses zero %d times for 1 <= n <= 1000.\n" $ crossesZero [1..1000]


enum T_RS232 <
    carrier_detect
    received_data
    transmitted_data
    data_terminal_ready
    signal_ground
    data_set_ready
    request_to_send
    clear_to_send
    ring_indicator
>;

my bit @signal[T_RS232];

@signal[signal_ground] = 1;


/* REXX ***************************************************************
* Decode Memory structure of  RS-232 Plug Definition
* Not sure if I understood it completely :-) Open for corrections
* You never stop learning (as long as you live)
* 03.08.2012 Walter Pachl
**********************************************************************/
Call decode 'ABC'
Call decode 'XY'
Exit

decode:
  Parse Arg c
  cb=c2b(c)
  If length(cb)=24 Then Do
    Parse Var cb,
     /*    1 - PG  */ Protective ground      +1,
     /* 3  2 - TD  */ Transmitted_data       +1,
     /* 2  3 - RD  */ Received_data          +1,
     /* 7  4 - RTS */ Request_to_send        +1,
     /* 8  5 - CTS */ Clear_to_send          +1,
     /* 6  6 - DSR */ Data_set_ready         +1,
     /* 5  7 - SG  */ Signal_ground          +1,
     /* 1  8 - CD  */ Carrier_detect         +1,
     /*    9 - +   */ plus_voltage           +1,
     /*   10 - -   */ minus_voltage          +1,
     /*   11 -     */ .                      +1,
     /*   12 - SCD */ Secondary_CD           +1,
     /*   13 - SCS */ Secondary_CTS          +1,
     /*   14 - STD */ Secondary_TD           +1,
     /*   15 - TC  */ Transmit_clock         +1,
     /*   16 - SRD */ Secondary_RD           +1,
     /*   17 - RC  */ Receiver_clock         +1,
     /*   18 -     */ .                      +1,
     /*   19 - SRS */ Secondary_RTS          +1,
     /* 4 20 - DTR */ Data_terminal_ready    +1,
     /*   21 - SQD */ Signal_quality_detector+1,
     /* 9 22 - RI  */ Ring_indicator         +1,
     /*   23 - DRS */ Data_rate_select       +1,
     /*   24 - XTC */ External_clock         +1
    Say '24 bins:' cb
    Say ' 1 - PG  Protective ground       ='Protective ground
    Say ' 2 - TD  Transmitted data        ='Transmitted_data
    Say ' 3 - RD  Received data           ='Received_data
    Say ' 4 - RTS Request to send         ='Request_to_send
    Say ' 5 - CTS Clear to send           ='Clear_to_send
    Say ' 6 - DSR Data set ready          ='Data_set_ready
    Say ' 7 - SG  Signal ground           ='Signal_ground
    Say ' 8 - CD  Carrier detect          ='Carrier_detect
    Say ' 9 - +   plus voltage            ='plus_voltage
    Say '10 - -   minus voltage           ='minus_voltage
    Say ' '
    Say '12 - SCD Secondary CD            ='Secondary_CD
    Say '13 - SCS Secondary CTS           ='Secondary_CTS
    Say '14 - STD Secondary TD            ='Secondary_TD
    Say '15 - TC  Transmit clock          ='Transmit_clock
    Say '16 - SRD Secondary RD            ='Secondary_RD
    Say '17 - RC  Receiver clock          ='Receiver_clock
    Say ' '
    Say '19 - SRS Secondary RTS           ='Secondary_RTS
    Say '20 - DTR Data terminal ready     ='Data_terminal_ready
    Say '21 - SQD Signal quality detector ='Signal_quality_detector
    Say '22 - RI  Ring indicator          ='Ring_indicator
    Say '23 - DRS Data rate select        ='Data_rate_select
    Say '24 - XTC External hlock          ='External_clock
    End
  Else Do
    Parse Var cb,
    /* 1  8 - CD  */ Carrier_detect         +1,
    /* 2  3 - RD  */ Received_data          +1,
    /* 3  2 - TD  */ Transmitted_data       +1,
    /* 4 20 - DTR */ Data_terminal_ready    +1,
    /* 5  7 - SG  */ Signal_ground          +1,
    /* 6  6 - DSR */ Data_set_ready         +1,
    /* 7  4 - RTS */ Request_to_send        +1,
    /* 8  5 - CTS */ Clear_to_send          +1,
    /* 9 22 - RI  */ Ring_indicator         +1
    Say ' '
    Say '9-bin:' left(cb,9)
    Say ' 1 CD   Carrier detect      ='Carrier_detect
    Say ' 2 RD   Received data       ='Received_data
    Say ' 3 TD   Transmitted data    ='Transmitted_data
    Say ' 4 DTR  Data terminal ready ='Data_terminal_ready
    Say ' 5 SG   Signal ground       ='Signal_ground
    Say ' 6 DSR  Data set ready      ='Data_set_ready
    Say ' 7 RTS  Request to send     ='Request_to_send
    Say ' 8 CTS  Clear to send       ='Clear_to_send
    Say ' 9 RI   Ring indicator      ='Ring_indicator
    End
  Return
c2b: Procedure
/* REXX ***************************************************************
* c2b Convert a character string to a bit string
* 03.08.2012 Walter Pachl
**********************************************************************/
Parse Arg c
x=c2x(c)
res=''
Do While x<>''
  Parse Var x hb +1 x
  Select
    When hb='0' Then bs='0000'
    When hb='1' Then bs='0001'
    When hb='2' Then bs='0010'
    When hb='3' Then bs='0011'
    When hb='4' Then bs='0100'
    When hb='5' Then bs='0101'
    When hb='6' Then bs='0110'
    When hb='7' Then bs='0111'
    When hb='8' Then bs='1000'
    When hb='9' Then bs='1001'
    When hb='A' Then bs='1010'
    When hb='B' Then bs='1011'
    When hb='C' Then bs='1100'
    When hb='D' Then bs='1101'
    When hb='E' Then bs='1110'
    When hb='F' Then bs='1111'
    End
  res=res||bs
  End
Return res


public class MertensFunction {

    public static void main(String[] args) {
        System.out.printf("First 199 terms of the merten function are as follows:%n    ");
        for ( int n = 1 ; n < 200 ; n++ ) {
            System.out.printf("%2d  ", mertenFunction(n));
            if ( (n+1) % 20 == 0 ) {
                System.out.printf("%n");
            }
        }

        for ( int exponent = 3 ; exponent<= 8 ; exponent++ ) {
            int zeroCount = 0;
            int zeroCrossingCount = 0;
            int positiveCount = 0;
            int negativeCount = 0;
            int mSum = 0;
            int mMin = Integer.MAX_VALUE;
            int mMinIndex = 0;
            int mMax = Integer.MIN_VALUE;
            int mMaxIndex = 0;
            int nMax = (int) Math.pow(10, exponent);
            for ( int n = 1 ; n <= nMax ; n++ ) {
                int m = mertenFunction(n);
                mSum += m;
                if ( m < mMin ) {
                    mMin = m;
                    mMinIndex = n;
                }
                if ( m > mMax ) {
                    mMax = m;
                    mMaxIndex = n;
                }
                if ( m > 0 ) {
                    positiveCount++;
                }
                if ( m < 0 ) {
                    negativeCount++;
                }
                if ( m == 0 ) {
                    zeroCount++;
                }
                if ( m == 0 && mertenFunction(n - 1) != 0 ) {
                    zeroCrossingCount++;
                }
            }
            System.out.printf("%nFor M(x) with x from 1 to %,d%n", nMax);
            System.out.printf("The maximum of M(x) is M(%,d) = %,d.%n", mMaxIndex, mMax);
            System.out.printf("The minimum of M(x) is M(%,d) = %,d.%n", mMinIndex, mMin);
            System.out.printf("The sum of M(x) is %,d.%n", mSum);
            System.out.printf("The count of positive M(x) is %,d, count of negative M(x) is %,d.%n", positiveCount, negativeCount);
            System.out.printf("M(x) has %,d zeroes in the interval.%n", zeroCount);
            System.out.printf("M(x) has %,d crossings in the interval.%n", zeroCrossingCount);
        }
    }

    private static int MU_MAX = 100_000_000;
    private static int[] MU = null;
    private static int[] MERTEN = null;

    //  Compute mobius and merten function via sieve
    private static int mertenFunction(int n) {
        if ( MERTEN != null ) {
            return MERTEN[n];
        }

        //  Populate array
        MU = new int[MU_MAX+1];
        MERTEN = new int[MU_MAX+1];
        MERTEN[1] = 1;
        int sqrt = (int) Math.sqrt(MU_MAX);
        for ( int i = 0 ; i < MU_MAX ; i++ ) {
            MU[i] = 1;
        }

        for ( int i = 2 ; i <= sqrt ; i++ ) {
            if ( MU[i] == 1 ) {
                //  for each factor found, swap + and -
                for ( int j = i ; j <= MU_MAX ; j += i ) {
                    MU[j] *= -i;
                }
                //  square factor = 0
                for ( int j = i*i ; j <= MU_MAX ; j += i*i ) {
                    MU[j] = 0;
                }
            }
        }

        int sum = 1;
        for ( int i = 2 ; i <= MU_MAX ; i++ ) {
            if ( MU[i] == i ) {
                MU[i] = 1;
            }
            else if ( MU[i] == -i ) {
                MU[i] = -1;
            }
            else if ( MU[i] < 0 ) {
                MU[i] = 1;
            }
            else if ( MU[i] > 0 ) {
                MU[i] = -1;
            }
            sum += MU[i];
            MERTEN[i] = sum;
        }
        return MERTEN[n];
    }

}


V items = [‘fee fie’, ‘huff and puff’, ‘mirror mirror’, ‘tick tock’]

L
   L(item) items
      print(‘#2. #.’.format(L.index + 1, item))

   V reply = input(‘Which is from the three pigs: ’).trim(‘ ’)
   I !reply.is_digit()
      L.continue

   I Int(reply) C 1..items.len
      print(‘You chose: ’items[Int(reply) - 1])
      L.break


require 'bit-struct'

class RS232_9 < BitStruct
  unsigned :cd,  1, "Carrier detect"       #1
  unsigned :rd,  1, "Received data"        #2
  unsigned :td,  1, "Transmitted data"     #3
  unsigned :dtr, 1, "Data terminal ready"  #4
  unsigned :sg,  1, "Signal ground"        #5
  unsigned :dsr, 1, "Data set ready"       #6
  unsigned :rts, 1, "Request to send"      #7
  unsigned :cts, 1, "Clear to send"        #8
  unsigned :ri,  1, "Ring indicator"       #9

  def self.new_with_int(value)
    data = {}
    fields.each_with_index {|f, i| data[f.name] = value[i]}
    new(data)
  end
end

num = rand(2**9 - 1)
puts "num = #{num}"

sample1 = RS232_9.new([("%09d" % num.to_s(2)).reverse].pack("B*"))
puts sample1.inspect_detailed

sample2 = RS232_9.new_with_int(num)
puts sample2.inspect_detailed

puts "CD is #{sample2.cd == 1 ? 'on' : 'off'}"


object Rs232Pins9 extends App {

  val (off: Boolean, on: Boolean) = (false, true)
  val plug = new Rs232Pins9(carrierDetect = on, receivedData = on) // set first two pins, say

  def toOnOff(b: Boolean) = if (b) "on" else "off"

  class Rs232Pins9(
                    var carrierDetect: Boolean = off,
                    var receivedData: Boolean = off,
                    var transmittedData: Boolean = off,
                    var dataTerminalReady: Boolean = off,
                    var signalGround: Boolean = off,
                    var dataSetReady: Boolean = off,
                    var requestToSend: Boolean = off,
                    var clearToSend: Boolean = off,
                    var ringIndicator: Boolean = off
                  ) {
    def setPin(n: Int, v: Boolean) {
      (n) match {
        case 1 => carrierDetect = v
        case 2 => receivedData = v
        case 3 => transmittedData = v
        case 4 => dataTerminalReady = v
        case 5 => signalGround = v
        case 6 => dataSetReady = v
        case 7 => requestToSend = v
        case 8 => clearToSend = v
        case 9 => ringIndicator = v
      }
    }
  }

  // println(toOnOff(plug.component2()))                          // print value of pin 2 by number
  plug.transmittedData = on // set pin 3 by name
  plug.setPin(4, on) // set pin 4 by number
  // println(toOnOff(plug.component3()))                          // print value of pin 3 by number
  println(toOnOff(plug.dataTerminalReady)) // print value of pin 4 by name
  println(toOnOff(plug.ringIndicator)) // print value of pin 9 by name
}


def sum(s): reduce s as $x (null; . + $x);

def nwise($n):
  def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end;
  n;

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

# input: an array
# output: number of crossings at $value
def count_crossings($value):
  . as $a
  | reduce range(0; length) as $i ({};
    if $a[$i] == $value
      then if $i == 0 or .prev != $value then .count += 1 else . end
      else .
      end
      | .prev = $a[$i] )
  | .count;


using Primes, Formatting

function moebius(n::Integer)
    @assert n > 0
    m(p, e) = p == 0 ? 0 : e == 1 ? -1 : 0
    return reduce(*, m(p, e) for (p, e) in factor(n) if p  ≥ 0; init=1)
end
μ(n) = moebius(n)

mertens(x) = sum(n -> μ(n), 1:x)
M(x) = mertens(x)

print("First 99 terms of the Mertens function for positive integers:\n   ")
for n in 1:99
    print(lpad(M(n), 3), n % 10 == 9 ? "\n" : "")
end

function maximinM(N)
    z, cros, lastM, maxi, maxM, mini, minM, sumM, pos, neg = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    for i in 1:N
        m = μ(i) + lastM
        if m == 0 && lastM != 0
            cros += 1
        end
        sumM += m
        lastM = m
        if m > maxM
            maxi = i
            maxM = m
        elseif m < minM
            mini = i
            minM = m
        end
        if m > 0
            pos += 1
        elseif m < 0
            neg += 1
        else
            z += 1
        end
    end
    println("\nFor M(x) with x from 1 to $(format(N, commas=true)):")
    println("The maximum of M(x) is M($(format(maxi, commas=true)) = $maxM.")
    println("The minimum of M(x) is M($(format(mini, commas=true))) = $minM.")
    println("The sum of M(x) is $(format(sumM, commas=true)).")
    println("The count of positive M(x) is $(format(pos, commas=true)), count of negative M(x) is $(format(neg, commas=true)).")
    println("M(x) has $(format(z, commas=true)) zeroes in the interval.")
    println("M(x) has $(format(cros, commas=true)) crossings in the interval.")
    diff = pos - neg
    if diff > 0
        println("Positive M(x) exceed negative ones by $(format(diff, commas=true)).")
    else
        println("Negative M(x) exceed positive ones by $(format(-diff, commas=true)).")
    end
end

foreach(maximinM, (1000, 1_000_000, 1_000_000_000))


            NORMAL MODE IS INTEGER
            DIMENSION M(1000)

            M(1) = 1
            THROUGH GENMRT, FOR N=2, 1, N.G.1000
            M(N) = 1
            THROUGH GENMRT, FOR K=2, 1, K.G.N
GENMRT      M(N) = M(N) - M(N/K)

            PRINT COMMENT $ FIRST 99 MERTEN NUMBERS ARE$
            VECTOR VALUES F9 = $S3,9(I2,S1)*$
            VECTOR VALUES F10 = $10(I2,S1)*$

            PRINT FORMAT F9, M(1), M(2), M(3), M(4), M(5), M(6),
          0                  M(7), M(8), M(9)

            THROUGH SHOW, FOR N=10, 10, N.GE.100
SHOW        PRINT FORMAT F10, M(N), M(N+1), M(N+2), M(N+3), M(N+4),
          0   M(N+5), M(N+6), M(N+7), M(N+8), M(N+9), M(N+10)

            ZERO = 0
            CROSS = 0
            THROUGH ZC, FOR N=1, 1, N.G.1000
            WHENEVER M(N).E.0, ZERO = ZERO + 1
ZC          WHENEVER M(N).E.0 .AND. M(N-1).NE.0, CROSS = CROSS + 1

            VECTOR VALUES FZ = $13HM(N) IS ZERO ,I2,S1,5HTIMES*$
            PRINT FORMAT FZ, ZERO

            VECTOR VALUES FC = $18HM(N) CROSSES ZERO ,I2,S1,5HTIMES*$
            PRINT FORMAT FC, CROSS

            END OF PROGRAM


ClearAll[Mertens]
Mertens[n_] := Total[MoebiusMu[Range[n]]]
Grid[Partition[Mertens /@ Range[99], UpTo[10]]]
Count[Mertens /@ Range[1000], 0]
SequenceCount[Mertens /@ Range[1000], {Except[0], 0}]


MODULE Mertens;
FROM InOut IMPORT WriteString, WriteInt, WriteCard, WriteLn;

CONST Max = 1000;
VAR n, k, x, y, zero, cross: CARDINAL;
    M: ARRAY [1..Max] OF INTEGER;

BEGIN
    M[1] := 1;
    FOR n := 2 TO Max DO
        M[n] := 1;
        FOR k := 2 TO n DO
            M[n] := M[n] - M[n DIV k];
        END;
    END;

    WriteString("The first 99 Mertens numbers are:");
    WriteLn();
    FOR y := 0 TO 90 BY 10 DO
        FOR x := 0 TO 9 DO
            IF x+y=0 THEN WriteString("   ");
            ELSE WriteInt(M[x+y], 3);
            END;
        END;
        WriteLn();
    END;

    zero := 0;
    cross := 0;
    FOR n := 2 TO Max DO
        IF M[n] = 0 THEN
            zero := zero + 1;
            IF M[n-1] # 0 THEN
                cross := cross + 1;
            END;
        END;
    END;

    WriteString("M(n) is zero ");
    WriteCard(zero,0);
    WriteString(" times.");
    WriteLn();
    WriteString("M(n) crosses zero ");
    WriteCard(cross,0);
    WriteString(" times.");
    WriteLn();
END Mertens.


DEFINE PTR="CARD"

BYTE FUNC Init(PTR ARRAY items)
  items(0)="fee fie"
  items(1)="huff and puff"
  items(2)="mirror mirror"
  items(3)="tick tock"
RETURN (4)

PROC ShowMenu(PTR ARRAY items BYTE count)
  BYTE i

  FOR i=1 TO count
  DO
    PrintF("(%B) %S%E",i,items(i-1))
  OD
RETURN

BYTE FUNC GetMenuItem(PTR ARRAY items BYTE count)
  BYTE res

  DO
    ShowMenu(items,count) PutE()
    Print("Make your choise: ")
    res=InputB()
  UNTIL res>=1 AND res<=count
  OD
RETURN (res-1)

PROC Main()
  PTR ARRAY items(10)
  BYTE count,res

  count=Init(items)
  res=GetMenuItem(items,count)
  PrintF("You have chosen: %S%E",items(res))
RETURN


with ada.text_io,Ada.Strings.Unbounded; use  ada.text_io, Ada.Strings.Unbounded;

procedure menu is
	type menu_strings is array (positive range <>) of Unbounded_String ;
	function "+" (s : string) return Unbounded_String is (To_Unbounded_String (s));

	function choice (m : menu_strings; prompt : string) return string is
	begin
		if m'length > 0 then
			loop
				put_line (prompt);
				for i in m'range loop
					put_line (i'img &") " & To_String (m(i)));
				end loop;
				begin
					return To_String (m(positive'value (get_line)));
					exception when others => put_line ("Try again !");
				end;
			end loop;
		end if;
		return "";
	end choice;

begin
	put_line ("You chose " &
		choice ((+"fee fie",+"huff and puff",+"mirror mirror",+"tick tock"),"Enter your choice "));
end menu;


set rs232_bits {CD RD TD DTR SG DSR RTS CTS RI}

proc rs232_encode args {
    set res 0
    foreach arg $args {
        set pos [lsearch $::rs232_bits $arg]
        if {$pos >=0} {set res [expr {$res | 1<<$pos}]}
    }
    return $res
}
proc rs232_decode int {
    set res {}
    set i -1
    foreach bit $::rs232_bits {
        incr i
        if {$int & 1<<$i} {lappend res $bit}
    }
    return $res
}
#------------------------------ Test suite
foreach {test => expected} {
    {rs232_encode CD} -> 1
    {rs232_decode 1} -> CD
    {rs232_encode CD RD TD} -> 7
    {rs232_decode 7} -> {CD RD TD}
} {
    catch $test res
    if {$res ne $expected} {puts "$test -> $res, expected $expected"}
}


import "/seq" for Lst
import "/fmt" for Fmt

var ON  = true
var OFF = false

// Converts "ON"/"OFF" string to true/false.
var AsBool = Fn.new { |s| s == "ON" }

class RS232_9 {
    static names { ["CD", "RD", "TD", "DTR", "SG", "DSR", "RTS", "CTS", "RI"] }

    construct new() { _settings = [OFF] * 9 } // all pins OFF

    // get pin setting as an ON/OFF string by pin name or number; returns null if invalid
    [p] {
        if (p is String) {
            var ix = Lst.indexOf(RS232_9.names, p)
            return (ix >= 0 && ix < 9) ? (_settings[ix] ? "ON" : "OFF") : null
        }
        if (p is Num) {
            return (p.isInteger && p >= 1 && p <= 9) ? (_settings[p-1] ? "ON" : "OFF") : null
        }
        return null
    }

    // set pin by pin name or number; does nothing if invalid
    [p] = (v) {
        if (v.type == String && (v == "ON" || v == "OFF")) v = AsBool.call(v)
        if (v.type != Bool) return
        if (p is String) {
            var ix = Lst.indexOf(RS232_9.names, p)
            if (ix >= 0 && ix < 9) _settings[ix] = v
        }
        if (p is Num && p.isInteger && p >= 1 && p <= 9) _settings[p-1] = v
    }

    // prints all pin settings
    toString { (1..9).map { |i| "%(i) %(Fmt.s(-3, RS232_9.names[i-1])) = %(this[i])" }.join("\n") }
}

var plug = RS232_9.new()
plug["CD"]  = ON      // set pin 1 by name
plug[3]     = ON      // set pin 3 by number
plug["DSR"] = "ON"    // set pin 6 by name and using a string
System.print(plug)    // print the state of the pins


import sequtils, strformat

func mertensNumbers(max: int): seq[int] =
  result = repeat(1, max + 1)
  for n in 2..max:
    for k in 2..n:
      dec result[n], result[n div k]

const Max = 1000
let mertens = mertensNumbers(Max)

echo "First 199 Mertens numbers:"
const Count = 200
var column = 0
for i in 0..<Count:
  if column > 0: stdout.write ' '
  stdout.write if i == 0: "  " else: &"{mertens[i]:>2}"
  inc column
  if column == 20:
    stdout.write '\n'
    column = 0

var zero, cross, previous = 0
for i in 1..Max:
  let m = mertens[i]
  if m == 0:
    inc zero
    if previous != 0:
      inc cross
  previous = m

echo ""
echo &"M(n) is zero {zero} times for 1 ⩽ n ⩽ {Max}."
echo &"M(n) crosses zero {cross} times for 1 ⩽ n ⩽ {Max}."


program Merten;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$Optimization ON,ALL}
{$ELSE}
   {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils;
const
  BigLimit = 10*1000*1000*1000;//1e10

type
  tSieveElement = Int8;
  tpSieve = pInt8;
  tMoebVal = array[-1..1] of Int64;
var
  MertensValues : array[-40000..50500] of NativeInt;
  primes : array of byte;
  sieve : array of tSieveElement;

procedure CompactPrimes;
//searching for needed primes
//last primes are marked with -1
var
  pSieve : tpSieve;
  i,lmt,dp:NativeInt;
Begin
  setlength(Primes,74500);//suffices for primes to calc square upto 1e12
  //extract difference of primes
  i := 2;
  lmt := 0;
  dp := 2;
  pSieve :=@sieve[0];
  repeat
    IF pSieve[i]= 0 then
    Begin
      //mark for Moebius
      pSieve[i]:= -1;
      primes[lmt] := dp;
      dp := 0;
      inc(lmt);
    end;
    inc(dp);
    inc(i);
  until i*i >BigLimit;
  setlength(Primes,lmt+1);

  repeat
    IF pSieve[i]= 0 then
      //mark for Moebius
      pSieve[i]:= -1;
    inc(i);
  until i >BigLimit;
end;

procedure SieveSquares;
//mark all powers >=2 of prime  => all powers = 2 is sufficient
var
  pSieve : tpSieve;
  i,sq,k,prime : NativeInt;
Begin
  pSieve := @sieve[0];
  prime := 0;
  For i := 0 to High(primes) do
  Begin
    prime := prime+primes[i];
    sq := prime*prime;
    k := sq;
    if sq > BigLimit then
      break;
    repeat
      pSieve[k] := 0;
      inc(k,sq);
    until k> BigLimit;
  end;
end;

procedure initPrimes;
var
  pSieve : tpSieve;
  fakt,
  sieveprime : NativeUint;
begin
  pSieve := @sieve[0];
  sieveprime := 2;
  repeat
    if pSieve[sieveprime]=0 then
    begin
      fakt := sieveprime+sieveprime;
      while fakt <=BigLimit do
      Begin
        //count divisors
        inc(pSieve[fakt]);
        inc(fakt,sieveprime);
      end;
    end;
    inc(sieveprime);
  until sieveprime>BigLimit DIV 2;
  //Möbius of 1
  pSieve[1] := 1;

  //convert to Moebius
  For fakt := 2 to BigLimit do
  Begin
    sieveprime := pSieve[fakt];
    IF sieveprime<>0 then
      pSieve[fakt] := 1-(2*(sieveprime AND 1)) ;
  end;
  CompactPrimes;
  SieveSquares;
end;

procedure OutMerten10(Lmt,ZeroCross:NativeInt;Const MoebVal:tMoebVal);
var
  i,j: NativeInt;
Begin
  Writeln(lmt:11,MoebVal[-1]:11,MoebVal[1]:11,MoebVal[-1]+MoebVal[1]:11,
  MoebVal[-1]-MoebVal[1]:7,MoebVal[0]:11);
  i:= low(MertensValues);
  while MertensValues[i] = 0 do
    inc(i);
  j:= High(MertensValues);
  while MertensValues[j] = 0 do
    dec(j);
  write('Merten min ',i:6,' max ',j:6,' zero''s ',MertensValues[0]:8);
  writeln(' zeroCross ',ZeroCross);
  writeln;
end;

procedure Count_x10;
var
  MoebCount: tMoebVal;
  pSieve : tpSieve;
  i,lmt,Merten,Moebius,LastMert,ZeroCross: NativeInt;
begin
  writeln('[1 to limit]');
  Writeln('Limit        Moeb. odd   Moeb.even  sqr-free Merten     Zero''s');

  pSieve := @sieve[0];
  For i := -1 to 1 do
    MoebCount[i]:=0;
  ZeroCross := 0;
  LastMert :=1;
  Merten :=0;
  lmt := 10;
  i := 1;
  repeat
    while i <= lmt do
    Begin
      Moebius := pSieve[i];
      inc(MoebCount[Moebius]);
      inc(Merten,Moebius);
      inc(MertensValues[Merten]);//MoebCount[1]-MoebCount[-1]]);
      inc(ZeroCross,ORD( (Merten = 0) AND (LastMert <> 0)));
      LastMert := Merten;
      inc(i);
    end;
    OutMerten10(Lmt,ZeroCross,MoebCount);

    IF lmt >= BigLimit then
      BREAK;
    lmt := lmt*10;
    IF lmt >BigLimit then
      lmt := BigLimit;
  until false;
  writeln;
end;

procedure OutMerten(lmt:NativeInt);
var
  i,k,m : NativeInt;
Begin
  iF lmt> BigLimit then
    lmt := BigLimit;
  writeln('Mertens numbers from 1 to ',lmt);
  k := 9;
  write('':3);
  m := 0;
  For i := 1 to lmt do
  Begin
    inc(m,sieve[i]);
    write(m:3);
    dec(k);
    IF k = 0 then
    Begin
      writeln;
      k := 10;
    end;
  end;
  writeln;
end;

procedure OutMoebius(lmt:NativeInt);
var
  i,k : NativeInt;
Begin
  iF lmt> BigLimit then
    lmt := BigLimit;
  writeln('Möbius numbers from 1 to ',lmt);
  k := 19;
  write('':3);
  For i := 1 to lmt do
  Begin
    write(sieve[i]:3);
    dec(k);
    IF k = 0 then
    Begin
      writeln;
      k := 20;
    end;
  end;
  writeln;
end;

Begin
  setlength(sieve,BigLimit+1);
  InitPrimes;
  SieveSquares;
  Count_x10;
  OutMoebius(199);
  OutMerten(99);
  setlength(primes,0);
  setlength(sieve,0);
end.


PROC menu select := (FLEX[]STRING items, UNION(STRING, VOID) prompt)STRING:
(
        INT choice;

        IF LWB items <= UPB items THEN
                WHILE
                        FOR i FROM LWB items TO UPB items DO
                                printf(($g(0)") "gl$, i, items[i]))
                        OD;
                        CASE prompt IN
                                (STRING prompt):printf(($g" "$, prompt)),
                                (VOID):printf($"Choice ? "$)
                        ESAC;
                        read((choice, new line));
                # WHILE # 1 > choice OR choice > UPB items
                DO SKIP OD;
                items[choice]
        ELSE
                ""
        FI
);

test:(
        FLEX[0]STRING items := ("fee fie", "huff and puff", "mirror mirror", "tick tock");
        STRING prompt := "Which is from the three pigs : ";

        printf(($"You chose "g"."l$, menu select(items, prompt)))
)


menu: function [items][
    selection: neg 1
    while [not? in? selection 1..size items][
        loop.with:'i items 'item -> print ~"|i+1|. |item|"
        inp: input "Enter a number: "
        if numeric? inp ->
            selection: to :integer inp
    ]
	print items\[selection-1]
]

menu ["fee fie" "huff and puff" "mirror mirror" "tick tock"]


softRS232_LO equ &C000 ;%87654321 (each bit represents the state of a numbered pin)
softRS232_HI equ &C001 ;%-------9

ld hl,softRS232_LO ;memory location of soft RS232 port
ld c,&00           ;&00 = the port that the RS232 is connected to.
                   ;This is just an example, the actual port number depends on where the hardware is connected.

outi               ;send the value contained in softRS232_LO thru port &00
outi               ;send the value contained in softRS232_HI thru port &00


use utf8;
use strict;
use warnings;
use feature 'say';
use List::Util 'uniq';

sub prime_factors {
    my ($n, $d, @factors) = (shift, 1);
    while ($n > 1 and $d++) {
        $n /= $d, push @factors, $d until $n % $d;
    }
    @factors
}

sub μ {
    my @p = prime_factors(shift);
    @p == uniq(@p) ? 0 == @p%2 ? 1 : -1 : 0
}

sub progressive_sum {
    my @sum = shift @_;
    push @sum, $sum[-1] + $_ for @_;
    @sum
}

my($upto, $show, @möebius) = (1000, 199, ());
push @möebius, μ($_) for 1..$upto;
my @mertens = progressive_sum @möebius;

say "Mertens sequence - First $show terms:\n" .
    (' 'x4 . sprintf "@{['%4d' x $show]}", @mertens[0..$show-1]) =~ s/((.){80})/$1\n/gr .
    sprintf("\nEquals zero %3d times between 1 and $upto", scalar grep { ! $_ } @mertens) .
    sprintf "\nCrosses zero%3d times between 1 and $upto", scalar grep { ! $mertens[$_-1] and $mertens[$_] } 1 .. @mertens;


function Mertens(integer n)
    integer res = 1
    for k=2 to n do
        res -= Mertens(floor(n/k))
    end for
    return res
end function
sequence s = {"  ."}
for i=1 to 143 do s = append(s,sprintf("%3d",Mertens(i))) end for
puts(1,join_by(s,1,12," "))

integer prev = 1, zeroes = 0, crosses = 0
for n=2 to 1000 do
    integer m = Mertens(n)
    if m=0 then
        zeroes += 1
        crosses += prev!=0
    end if
    prev = m
end for
printf(1,"\nMertens[1..1000] equals zero %d times and crosses zero %d times\n",{zeroes,crosses})


Menu(list:=""){
	if !list			; if called with an empty list
		return			; return an empty string
	for i, v in x := StrSplit(list, "`n", "`r")
		string .= (string?"`n":"") i "- " v
		, len := StrLen(v) > len ? StrLen(v) : len
	while !x[Choice]
		InputBox , Choice, Please Select From Menu, % string ,, % 200<len*7 ? 200 ? len*7 , % 120 + x.count()*20
	return x[Choice]
}


# syntax: GAWK -f MENU.AWK
BEGIN {
    print("you picked:",menu(""))
    print("you picked:",menu("fee fie:huff and puff:mirror mirror:tick tock"))
    exit(0)
}
function menu(str,  ans,arr,i,n) {
    if (str == "") {
      return
    }
    n = split(str,arr,":")
    while (1) {
      print("")
      for (i=1; i<=n; i++) {
        printf("%d - %s\n",i,arr[i])
      }
      printf("? ")
      getline ans
      if (ans in arr) {
        return(arr[ans])
      }
      print("invalid choice")
    }
}


mertens: procedure options(main);
    %replace MAX by 1000;

    declare M(1:MAX) fixed binary(5);
    declare (n, k) fixed binary(10);
    declare (isZero, crossZero) fixed binary(8);

    M(1) = 1;
    do n = 2 to MAX;
        M(n) = 1;
        do k = 2 to n;
            M(n) = M(n) - M(divide(n,k,10));
        end;
    end;

    put skip list('The first 99 Mertens numbers are:');
    put skip list('   ');
    do n = 1 to 99;
        put edit(M(n)) (F(3));
        if mod(n,10) = 9 then put skip;
    end;

    isZero = 0;
    crossZero = 0;
    do n = 2 to MAX;
        if M(n) = 0 then do;
            isZero = isZero + 1;
            if M(n-1) ^= 0 then
                crossZero = crossZero + 1;
        end;
    end;

    put skip list('Zeroes:   ',isZero);
    put skip list('Crossings:',crossZero);
end mertens;


:- dynamic mertens_number_cache/2.

mertens_number(1, 1):- !.
mertens_number(N, M):-
    mertens_number_cache(N, M),
    !.
mertens_number(N, M):-
    N >= 2,
    mertens_number(N, 2, M, 0),
    assertz(mertens_number_cache(N, M)).

mertens_number(N, N, M, M):- !.
mertens_number(N, K, M, S):-
    N1 is N // K,
    mertens_number(N1, M1),
    K1 is K + 1,
    S1 is S - M1,
    mertens_number(N, K1, M, S1).

print_mertens_numbers(Count):-
    print_mertens_numbers(Count, 0).

print_mertens_numbers(Count, Count):-!.
print_mertens_numbers(Count, N):-
    (N == 0 ->
        write('   ')
        ;
        mertens_number(N, M),
        writef('%3r', [M])
    ),
    N1 is N + 1,
    Column is N1 mod 20,
    (N > 0, Column == 0 ->
        nl
        ;
        true
    ),
    print_mertens_numbers(Count, N1).

count_zeros(From, To, Z, C):-
    count_zeros(From, To, Z, C, 0, 0, 0).

count_zeros(From, To, Z, C, Z, C, _):-
    From > To,
    !.
count_zeros(From, To, Z, C, Z1, C1, P):-
    mertens_number(From, M),
    (M == 0 -> Z2 is Z1 + 1 ; Z2 = Z1),
    (M == 0, P \= 0 -> C2 is C1 + 1 ; C2 = C1),
    Next is From + 1,
    count_zeros(Next, To, Z, C, Z2, C2, M).

main:-
    writeln('First 199 Mertens numbers:'),
    print_mertens_numbers(200),
    count_zeros(1, 1000, Z, C),
    writef('M(n) is zero %t times for 1 <= n <= 1000.\n', [Z]),
    writef('M(n) crosses zero %t times for 1 <= n <= 1000.\n', [C]).


"FEE FIE"→Str1
"HUFF AND PUFF"→Str2
"MIRROR MIRROR"→Str3
"TICK TOCK"→Str4
For(I,1,4)
 Disp I▶Hex+3,":",strGet(Str1,I-1),i
End
Disp "NUMBER? "
input→A
{A}-'0'→N
If N<1 or N>4
 Disp "BAD NUMBER",i
 Return
End
Disp strGet(Str1,N-1),i


 FUNCTION sel$(choices$(), prompt$)
   IF UBOUND(choices$) - LBOUND(choices$) = 0 THEN sel$ = ""
   ret$ = ""
   DO
      FOR i = LBOUND(choices$) TO UBOUND(choices$)
         PRINT i; ": "; choices$(i)
      NEXT i
      INPUT ;prompt$, index
      IF index <= UBOUND(choices$) AND index >= LBOUND(choices$) THEN ret$ = choices$(index)
   WHILE ret$ = ""
   sel$ = ret$
END FUNCTION


@echo off & setlocal enabledelayedexpansion

set "menuChoices="fee fie","huff and puff","mirror mirror","tick tock""

call :menu

pause>nul & exit

:menu
	if defined menuChoices (
		set "counter=0" & for %%a in (%menuChoices%) do (
			set /a "counter+=1"
			set "currentMenuChoice=%%a"
			set option[!counter!]=!currentMenuChoice:"=!
		)
	)
:tryagain
cls&echo.
for /l %%a in (1,1,%counter%) do echo %%a^) !option[%%a]!
echo.
set /p "input=Choice 1-%counter%: "
echo.
for /l %%a in (1,1,%counter%) do (
	if !input! equ %%a echo You chose [ %%a^) !option[%%a]! ] & goto :EOF
)
echo.
echo.Invalid Input. Please try again...
pause
goto :tryagain


Dim M.i(1000)

M(1)=1
For n=2 To 1000
  psum=0
  For k=2 To n : psum+M(Int(n/k)) : Next : M(n)=1-psum
  If M(n)=0 : z+1 : If M(n-1)<>0 : c+1 : EndIf : EndIf
Next

OpenConsole("")
PrintN("First 99 Mertens numbers:") : Print(Space(4))
For n=1 To 99 : Print(RSet(Str(M(n)),4)) : If n%10=9 : PrintN("") : EndIf : Next
PrintN("M(N) is zero "+Str(z)+" times.") : PrintN("M(N) crosses zero "+Str(c)+" times.")
Input()


def mertens(count):
    """Generate Mertens numbers"""
    m = [None, 1]
    for n in range(2, count+1):
        m.append(1)
        for k in range(2, n+1):
            m[n] -= m[n//k]
    return m

ms = mertens(1000)

print("The first 99 Mertens numbers are:")
print("  ", end=' ')
col = 1
for n in ms[1:100]:
    print("{:2d}".format(n), end=' ')
    col += 1
    if col == 10:
        print()
        col = 0

zeroes = sum(x==0 for x in ms)
crosses = sum(a!=0 and b==0 for a,b in zip(ms, ms[1:]))
print("M(N) equals zero {} times.".format(zeroes))
print("M(N) crosses zero {} times.".format(crosses))


      DIM list$(4)
      list$() = "fee fie", "huff and puff", "mirror mirror", "tick tock"
      selected$ = FNmenu(list$(), "Please make a selection: ")
      PRINT selected$
      END

      DEF FNmenu(list$(), prompt$)
      LOCAL index%, select$
      IF SUM(list$()) = "" THEN = ""
      REPEAT
        CLS
        FOR index% = 0 TO DIM(list$() ,1)
          IF list$(index%)<>"" PRINT ; index% ":", list$(index%)
        NEXT
        PRINT prompt$ ;
        INPUT "" select$
        index% = VAL(select$)
        IF select$<>STR$(index%) index% = -1
        IF index%>=0 IF index%<=DIM(list$() ,1) IF list$(index%)="" index% = -1
      UNTIL index%>=0 AND index%<=DIM(list$(), 1)
      = list$(index%)


menu = { prompt, choices |
  true? choices.empty?
  { "" }
  {
    choices.each_with_index { c, i |
      p "#{i}. #{c}"
    }

    selection = ask prompt

      true? selection.numeric?
      { selection = selection.to_i
        true? selection < 0 || { selection >= choices.length }
          { p "Selection is out of range"; menu prompt, choices }
          { choices[selection] }
      }
    { p "Selection must be a number"; menu prompt, choices }
  }
}

p menu "Selection: " ["fee fie" "huff and puff" "mirror mirror" "tick tock"]


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

const char *menu_select(const char *const *items, const char *prompt);

int
main(void)
{
	const char *items[] = {"fee fie", "huff and puff", "mirror mirror", "tick tock", NULL};
	const char *prompt = "Which is from the three pigs?";

	printf("You chose %s.\n", menu_select(items, prompt));

	return EXIT_SUCCESS;
}

const char *
menu_select(const char *const *items, const char *prompt)
{
	char buf[BUFSIZ];
	int i;
	int choice;
	int choice_max;

	if (items == NULL)
		return NULL;

	do {
		for (i = 0; items[i] != NULL; i++) {
			printf("%d) %s\n", i + 1, items[i]);
		}
		choice_max = i;
		if (prompt != NULL)
			printf("%s ", prompt);
		else
			printf("Choice? ");
		if (fgets(buf, sizeof(buf), stdin) != NULL) {
			choice = atoi(buf);
		}
	} while (1 > choice || choice > choice_max);

	return items[choice - 1];
}


use Prime::Factor;

sub μ (Int \n) {
    return 0 if n %% 4 or n %% 9 or n %% 25 or n %% 49 or n %% 121;
    my @p = prime-factors(n);
    +@p == +@p.unique ?? +@p %% 2 ?? 1 !! -1 !! 0
}

my @mertens = lazy [\+] flat '', 1, (2..*).hyper.map: -> \n { μ(n) };

put "Mertens sequence - First 199 terms:\n",
    @mertens[^200]».fmt('%3s').batch(20).join("\n"),
    "\n\nEquals zero ", +@mertens[1..1000].grep( !* ),
    ' times between 1 and 1000', "\n\nCrosses zero ",
    +@mertens[1..1000].kv.grep( {!$^v and @mertens[$^k]} ),
    " times between 1 and 1000\n\nFirst Mertens equal to:";

for 10, 20, 30 … 100 -> $threshold {
    printf "%4d: M(%d)\n", -$threshold, @mertens.first: * == -$threshold, :k;
    printf "%4d: M(%d)\n",  $threshold, @mertens.first: * ==  $threshold, :k;
}


/*REXX pgm computes & shows a value grid of the Mertens function for a range of integers*/
parse arg LO HI grp eqZ xZ .                     /*obtain optional arguments from the CL*/
if  LO=='' |  LO==","  then  LO=    0            /*Not specified?  Then use the default.*/
if  HI=='' |  HI==","  then  HI=  199            /* "      "         "   "   "     "    */
if grp=='' | grp==","  then grp=   20            /* "      "         "   "   "     "    */
if eqZ=='' | eqZ==","  then eqZ= 1000            /* "      "         "   "   "     "    */
if  xZ=='' |  xZ==","  then  xZ= 1000            /* "      "         "   "   "     "    */
call genP                                        /*generate primes up to max  √  HIHI   */
               call Franz LO, HI
if eqZ>0  then call Franz 1, -eqZ
if  xZ>0  then call Franz -1, xZ
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Franz: parse arg a 1 oa,b 1 ob;        @Mertens= ' The Mertens sequence from '
a= abs(a);   b= abs(b);    grid= oa>=0 & ob>=0   /*semaphore used to show a grid title. */
if grid  then say center(@Mertens LO " ──► " HI" ", max(50, grp*3), '═')    /*show title*/
         else say
zeros= 0                                         /*# of  0's found for Mertens function.*/
Xzero= 0                                         /*number of times that zero was crossed*/
$=;                 prev=                        /*$  holds output grid of GRP numbers. */
   do j=a  to b;     _= Mertens(j)               /*process some numbers from  LO ──► HI.*/
   if _==0  then zeros= zeros + 1                /*Is Zero?  Then bump the zeros counter*/
   if _==0  then if prev\==0 then Xzero= Xzero+1 /*prev ¬=0?   "   "    "  Xzero    "   */
   prev= _
   if grid  then $= $ right(_, 2)                /*build grid if A & B are non─negative.*/
   if words($)==grp  then do;  say substr($, 2);  $=    /*show grid if fully populated, */
                          end                           /*  and nullify it for more #s. */
   end   /*j*/                                   /*for small grids, using wordCnt is OK.*/

if $\==''  then say substr($, 2)                 /*handle any residual numbers not shown*/
if oa<0  then say @Mertens   a    " to "    b   ' has crossed zero '    Xzero    " times."
if ob<0  then say @Mertens   a    " to "    b   ' has '                 zeros    " zeros."
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
Mertens: procedure expose @. !!. M.;  parse arg n; if M.n\==.  then return M.n
         if n<1  then return '∙'; m= 0           /*handle special cases of non─positive#*/
              do k=1  for n;   m= m + mobius(k)  /*sum the  MU's  up to  N.             */
              end   /*k*/                        /* [↑] mobius function uses memoization*/
         M.n= m;          return m               /*return the sum of all the  MU's.     */
/*──────────────────────────────────────────────────────────────────────────────────────*/
mobius: procedure expose @. !!.;  parse arg x 1 ox  /*get integer to be tested for  mu  */
        if !!.x\==.  then return !!.x            /*X computed before?  Return that value*/
        if x<1  then return '∙';      mu= 0      /*handle special case of non-positive #*/
             do k=1;  p= @.k; if p>x  then leave       /* (P)    > X?   Then we're done.*/
             if p*p>x    then do; mu= mu+1; leave; end /* (P**2) > X?   Bump # and leave*/
             if x//p==0  then do; mu= mu+1       /*X divisible by P?   Bump  mu  number.*/
                                  x= x % p       /*                    Divide by prime. */
                                  if x//p==0  then return 0  /*X÷by P?  Then return zero*/
                              end
             end   /*k*/                         /*MU (below) is almost always small, <9*/
        !!.ox=  -1 ** mu;         return !!.ox   /*raise -1 to the mu power, memoize it.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
genP: @.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13 /*initialize some low primes; # primes.*/
      !!.=.;  M.=!!.;      #= 6;  sq.#= @.6**2   /*     "     2 arrays for memoization. */
       do [email protected].#+4  by 2  to max(HI, eqZ, xZ); parse var j '' -1 _   /*odd Ps from now on*/
       if _==5 then iterate; if j//3==0 then iterate; if j//7==0  then iterate /*÷ 5 3 7*/
          do k=7  while sq.k<=j                  /*divide by some generated odd primes. */
          if j//@.k==0  then iterate j           /*Is J divisible by  P?  Then not prime*/
          end   /*k*/                            /* [↓]  a prime  (J)  has been found.  */
       #= #+1;          @.#=j;  sq.j= j*j        /*bump P count;  P──►@.;  compute  J**2*/
       end      /*j*/;                    return /*calculate the squares of some primes.*/


using System;
using System.Collections.Generic;

public class Menu
{
        static void Main(string[] args)
        {
            List<string> menu_items = new List<string>() { "fee fie", "huff and puff", "mirror mirror", "tick tock" };
            //List<string> menu_items = new List<string>();
            Console.WriteLine(PrintMenu(menu_items));
            Console.ReadLine();
        }
        private static string PrintMenu(List<string> items)
        {
            if (items.Count == 0)
                return "";

            string input = "";
            int i = -1;
            do
            {
                for (int j = 0; j < items.Count; j++)
                    Console.WriteLine("{0}) {1}", j, items[j]);

                Console.WriteLine("What number?");
                input = Console.ReadLine();

            } while (!int.TryParse(input, out i) || i >= items.Count || i < 0);
            return items[i];
        }
}


#include <iostream>
#include <string>
#include <vector>

void print_menu(const std::vector<std::string>& terms)
{
    for (size_t i = 0; i < terms.size(); i++) {
        std::cout << i + 1 << ") " << terms[i] << '\n';
    }
}

int parse_entry(const std::string& entry, int max_number)
{
    int number = std::stoi(entry);
    if (number < 1 || number > max_number) {
        throw std::invalid_argument("");
    }

    return number;
}

std::string data_entry(const std::string& prompt, const std::vector<std::string>& terms)
{
    if (terms.empty()) {
        return "";
    }

    int choice;
    while (true) {
        print_menu(terms);
        std::cout << prompt;

        std::string entry;
        std::cin >> entry;

        try {
            choice = parse_entry(entry, terms.size());
            return terms[choice - 1];
        } catch (std::invalid_argument&) {
            // std::cout << "Not a valid menu entry!" << std::endl;
        }
    }
}

int main()
{
    std::vector<std::string> terms = {"fee fie", "huff and puff", "mirror mirror", "tick tock"};
    std::cout << "You chose: " << data_entry("> ", terms) << std::endl;
}


require 'prime'

def μ(n)
  return 1 if self == 1
  pd = n.prime_division
  return 0 unless pd.map(&:last).all?(1)
  pd.size.even? ? 1 : -1
end

def M(n)
  (1..n).sum{|n| μ(n)}
end

(["  "] + (1..199).map{|n|"%2s" % M(n)}).each_slice(20){|line| puts line.join(" ") }

ar = (1..1000).map{|n| M(n)}
puts "\nThe Mertens function is zero #{ar.count(0)} times in the range (1..1000);"
puts "it crosses zero #{ar.each_cons(2).count{|m1, m2| m1 != 0 && m2 == 0}} times."


import Foundation

func mertensNumbers(max: Int) -> [Int] {
    var mertens = Array(repeating: 1, count: max + 1)
    for n in 2...max {
        for k in 2...n {
            mertens[n] -= mertens[n / k]
        }
    }
    return mertens
}

let max = 1000
let mertens = mertensNumbers(max: max)

let count = 200
let columns = 20
print("First \(count - 1) Mertens numbers:")
for i in 0..<count {
    if i % columns > 0 {
        print(" ", terminator: "")
    }
    print(i == 0 ? "  " : String(format: "%2d", mertens[i]), terminator: "")
    if (i + 1) % columns == 0 {
        print()
    }
}

var zero = 0, cross = 0, previous = 0
for i in 1...max {
    let m = mertens[i]
    if m == 0 {
        zero += 1
        if previous != 0 {
            cross += 1
        }
    }
    previous = m
}
print("M(n) is zero \(zero) times for 1 <= n <= \(max).")
print("M(n) crosses zero \(cross) times for 1 <= n <= \(max).")


"Run the module `menu`."
shared void run() {
 	value selection = menu("fee fie", "huff And puff", "mirror mirror", "tick tock");
 	print(selection);
}

String menu(String* strings) {
	if(strings.empty) {
		return "";
	}
	value entries = map(zipEntries(1..strings.size, strings));
	while(true) {
		for(index->string in entries) {
			print("``index``) ``string``");
		}
		process.write("> ");
		value input = process.readLine();
		if(exists input, exists int = parseInteger(input), exists string = entries[int]) {
			return string;
		}
	}
}


(defn menu [prompt choices]
  (if (empty? choices)
    ""
    (let [menutxt (apply str (interleave
                              (iterate inc 1)
                              (map #(str \space % \newline) choices)))]
      (println menutxt)
      (print prompt)
      (flush)
      (let [index (read-string (read-line))]
        ; verify
        (if (or (not (integer? index))
                (> index (count choices))
                (< index 1))
          ; try again
          (recur prompt choices)
          ; ok
          (nth choices (dec index)))))))

(println "You chose: "
         (menu "Which is from the three pigs: "
               ["fee fie" "huff and puff" "mirror mirror" "tick tock"]))


fn mertens(t int) ([]int, int, int) {
    mut to:=t
    if to < 1 {
        to = 1
    }
    mut merts := []int{len:to+1}
    mut primes := [2]
    mut sum := 0
    mut zeros := 0
    mut crosses := 0
    for i := 1; i <= to; i++ {
        mut j := i
        mut cp := 0      // counts prime factors
        mut spf := false // true if there is a square prime factor
        for p in primes {
            if p > j {
                break
            }
            if j%p == 0 {
                j /= p
                cp++
            }
            if j%p == 0 {
                spf = true
                break
            }
        }
        if cp == 0 && i > 2 {
            cp = 1
            primes << i
        }
        if !spf {
            if cp%2 == 0 {
                sum++
            } else {
                sum--
            }
        }
        merts[i] = sum
        if sum == 0 {
            zeros++
            if i > 1 && merts[i-1] != 0 {
                crosses++
            }
        }
    }
    return merts, zeros, crosses
}

fn main() {
    merts, zeros, crosses := mertens(1000)
    println("Mertens sequence - First 199 terms:")
    for i := 0; i < 200; i++ {
        if i == 0 {
            print("    ")
            continue
        }
        if i%20 == 0 {
            println('')
        }
        print("  ${merts[i]:2}")
    }
    println("\n\nEquals zero $zeros times between 1 and 1000")
    println("\nCrosses zero $crosses times between 1 and 1000")
}


import "/fmt" for Fmt
import "/math" for Int

var isSquareFree = Fn.new { |n|
    var i = 2
    while (i * i <= n) {
        if (n%(i*i) == 0) return false
        i = (i > 2) ? i + 2 : i + 1
    }
    return true
}

var mu = Fn.new { |n|
    if (n < 1) Fiber.abort("Argument must be a positive integer")
    if (n == 1) return 1
    var sqFree = isSquareFree.call(n)
    var factors = Int.primeFactors(n)
    if (sqFree && factors.count % 2 == 0) return 1
    if (sqFree) return -1
    return 0
}

var M = Fn.new { |x| (1..x).reduce { |sum, n| sum + mu.call(n) } }

System.print("The first 199 Mertens numbers are:")
for (i in 0..9) {
    for (j in 0..19) {
        if (i == 0 && j == 0) {
            System.write("    ")
        } else {
            System.write("%(Fmt.dm(3, M.call(i*20 + j))) ")
        }
    }
    System.print()
}

// use the recurrence relationship for the last 2 parts rather than calling M directly
var count = 0
var mertens = M.call(1)
for (i in 2..1000) {
    mertens = mertens + mu.call(i)
    if (mertens == 0) count = count + 1
}
System.print("\nThe Mertens function is zero %(count) times in the range [1, 1000].")

count = 0
var prev = M.call(1)
for (i in 2..1000) {
    var next = prev + mu.call(i)
    if (next == 0 && prev != 0) count = count + 1
    prev = next
}
System.print("\nThe Mertens function crosses zero %(count) times in the range [1, 1000].")


       IDENTIFICATION DIVISION.
       PROGRAM-ID. Test-Prompt-Menu.

       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  Num-Options    USAGE UNSIGNED-INT VALUE 4.
       01  Example-Menu.
           03  Example-Options-Data.
               05  FILLER PIC X(30) VALUE "fee fie".
               05  FILLER PIC X(30) VALUE "huff and puff".
               05  FILLER PIC X(30) VALUE "mirror mirror".
               05  FILLER PIC X(30) VALUE "tick tock".

           03  Example-Options-Values REDEFINES Example-Options-Data.
               05  Example-Options PIC X(30) OCCURS 4 TIMES.

       01  Chosen-Option PIC X(30).

       PROCEDURE DIVISION.
           CALL "Prompt-Menu" USING BY CONTENT Num-Options
               BY CONTENT Example-Menu
               BY REFERENCE Chosen-Option

           DISPLAY "You chose: " Chosen-Option

           GOBACK
           .

       END PROGRAM Test-Prompt-Menu.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. Prompt-Menu.

       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  User-Input        USAGE UNSIGNED-INT.
       01  Input-Flag        PIC X.
           88  Valid-Input   VALUE "Y".

       01  Options-Index     USAGE UNSIGNED-INT.
       01  Index-Display     PIC Z(10).

       LINKAGE SECTION.

       01  Num-Options       USAGE UNSIGNED-INT.
       01  Menu-Options.
           03  Options-Table PIC X(30) OCCURS 0 TO 10000000 TIMES
               DEPENDING ON Num-Options.

       01  Chosen-Option     PIC X(30).

       PROCEDURE DIVISION USING Num-Options Menu-Options Chosen-Option.
       Main.
           IF Num-Options = 0
               MOVE SPACES TO Chosen-Option
               GOBACK
           END-IF

           PERFORM UNTIL Valid-Input
               PERFORM Display-Menu-Options

               DISPLAY "Choose an option: " WITH NO ADVANCING
               ACCEPT User-Input

               PERFORM Validate-Input
           END-PERFORM

           MOVE Options-Table (User-Input) TO Chosen-Option

           GOBACK
           .

       Display-Menu-Options.
           PERFORM VARYING Options-Index FROM 1 BY 1
                   UNTIL Num-Options < Options-Index
               MOVE Options-Index TO Index-Display
               DISPLAY
                   Index-Display ". " Options-Table (Options-Index)
               END-DISPLAY
           END-PERFORM
           .

       Validate-Input.
           IF User-Input = 0 OR > Num-Options
               DISPLAY "Invalid input."
           ELSE
               SET Valid-Input TO TRUE
           END-IF
           .

       END PROGRAM Prompt-Menu.


fcn mertensW(n){
   [1..].tweak(fcn(n,pm){
      pm.incN(mobius(n));
      pm.value
   }.fp1(Ref(0)))
}
fcn mobius(n){
   pf:=primeFactors(n);
   sq:=pf.filter1('wrap(f){ (n % (f*f))==0 });  // False if square free
   if(sq==False){ if(pf.len().isEven) 1 else -1 }
   else 0
}
fcn primeFactors(n){  // Return a list of prime factors of n
   acc:=fcn(n,k,acc,maxD){  // k is 2,3,5,7,9,... not optimum
      if(n==1 or k>maxD) acc.close();
      else{
	 q,r:=n.divr(k);   // divr-->(quotient,remainder)
	 if(r==0) return(self.fcn(q,k,acc.write(k),q.toFloat().sqrt()));
	 return(self.fcn(n,k+1+k.isOdd,acc,maxD))  # both are tail recursion
      }
   }(n,2,Sink(List),n.toFloat().sqrt());
   m:=acc.reduce('*,1);      // mulitply factors
   if(n!=m) acc.append(n/m); // opps, missed last factor
   else acc;
}


(defun select (prompt choices)
  (if (null choices)
    ""
    (do (n)
        ((and n (<= 0 n (1- (length choices))))
         (nth n choices))
      (format t "~&~a~%" prompt)
      (loop for n from 0
            for c in choices
            do (format t "  ~d) ~a~%" n c))
      (force-output)
      (setf n (parse-integer (read-line *standard-input* nil)
                             :junk-allowed t)))))


import std.stdio, std.conv, std.string, std.array, std.typecons;

string menuSelect(in string[] entries) {
    static Nullable!(int, -1) validChoice(in string input,
                                          in int nEntries)
    pure nothrow {
        try {
            immutable n = input.to!int;
            return typeof(return)((n >= 0 && n <= nEntries) ? n : -1);
        } catch (Exception e) // Very generic
            return typeof(return)(-1); // Not valid.
    }

    if (entries.empty)
        return "";

    while (true) {
        "Choose one:".writeln;
        foreach (immutable i, const entry; entries)
            writefln("  %d) %s", i, entry);
        "> ".write;
        immutable input = readln.chomp;
        immutable choice = validChoice(input, entries.length - 1);
        if (choice.isNull)
            "Wrong choice.".writeln;
        else
            return entries[choice]; // We have a valid choice.
    }
}

void main() {
    immutable items = ["fee fie", "huff and puff",
                       "mirror mirror", "tick tock"];
    writeln("You chose '", items.menuSelect, "'.");
}


program Menu;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

function ChooseMenu(Options: TArray<string>; Prompt: string): string;
var
  index: Integer;
  value: string;
begin
  if Length(Options) = 0 then
    exit('');
  repeat
    writeln;
    for var i := 0 to length(Options) - 1 do
      writeln(i + 1, '. ', Options[i]);
    write(#10, Prompt, ' ');
    Readln(value);
    index := StrToIntDef(value, -1);
  until (index > 0) and (index <= length(Options));
  Result := Options[index];
end;

begin
  writeln('You picked ', ChooseMenu(['fee fie', 'huff and puff', 'mirror mirror',
    'tick tock'], 'Enter number: '));
  readln;
end.


defmodule Menu do
  def select(_, []), do: ""
  def select(prompt, items) do
    IO.puts ""
    Enum.with_index(items) |> Enum.each(fn {item,i} -> IO.puts " #{i}. #{item}" end)
    answer = IO.gets("#{prompt}: ") |> String.strip
    case Integer.parse(answer) do
      {num, ""} when num in 0..length(items)-1 -> Enum.at(items, num)
      _ -> select(prompt, items)
    end
  end
end

# test empty list
response = Menu.select("Which is empty", [])
IO.puts "empty list returns: #{inspect response}"

# "real" test
items = ["fee fie", "huff and puff", "mirror mirror", "tick tock"]
response = Menu.select("Which is from the three pigs", items)
IO.puts "you chose: #{inspect response}"


PROCEDURE Selection(choices$[],prompt$->sel$)
   IF UBOUND(choices$,1)-LBOUND(choices$,1)=0 THEN
      sel$=""
      EXIT PROCEDURE
   END IF
   ret$=""
   REPEAT
      FOR i=LBOUND(choices$,1) TO UBOUND(choices$,1) DO
         PRINT(i;": ";choices$[i])
      END FOR
      PRINT(prompt$;)
      INPUT(index)
      IF index<=UBOUND(choices$,1) AND index>=LBOUND(choices$,1) THEN ret$=choices$[index] END IF
   UNTIL ret$<>""
   sel$=ret$
END PROCEDURE


include get.e

function menu_select(sequence items, object prompt)
    if length(items) = 0 then
        return ""
    else
        for i = 1 to length(items) do
            printf(1,"%d) %s\n",{i,items[i]})
        end for

        if atom(prompt) then
            prompt = "Choice?"
        end if

        return items[prompt_number(prompt,{1,length(items)})]
    end if
end function

constant items = {"fee fie", "huff and puff", "mirror mirror", "tick tock"}
constant prompt = "Which is from the three pigs? "

printf(1,"You chose %s.\n",{menu_select(items,prompt)})


open System

let rec menuChoice (options : string list) prompt =
    if options = [] then ""
    else
        for i = 0 to options.Length - 1 do
            printfn "%d. %s" (i + 1) options.[i]

        printf "%s" prompt
        let input = Int32.TryParse(Console.ReadLine())

        match input with
        | true, x when 1 <= x && x <= options.Length -> options.[x - 1]
        | _, _ -> menuChoice options prompt

[<EntryPoint>]
let main _ =
    let menuOptions = ["fee fie"; "huff and puff"; "mirror mirror"; "tick tock"]
    let choice = menuChoice menuOptions "Choose one: "
    printfn "You chose: %s" choice

    0


USING: formatting io kernel math math.parser sequences ;

: print-menu ( seq -- )
    [ 1 + swap "%d - %s\n" printf ] each-index
    "Your choice? " write flush ;

: (select) ( seq -- result )
    dup print-menu readln string>number dup integer? [
        drop 1 - swap 2dup bounds-check?
        [ nth ] [ nip (select) ] if
    ] [ drop (select) ] if* ;

: select ( seq -- result ) [ "" ] [ (select) ] if-empty ;


class Main
{
  static Void displayList (Str[] items)
  {
    items.each |Str item, Int index|
    {
      echo ("$index: $item")
    }
  }

  public static Str getChoice (Str[] items)
  {
    selection := -1
    while (selection == -1)
    {
      displayList (items)
      Env.cur.out.print ("Select: ").flush
      input := Int.fromStr(Env.cur.in.readLine, 10, false)
      if (input != null)
      {
        if (input >= 0 && input < items.size)
        {
          selection = input
        }
      }
      echo ("Try again")
    }
    return items[selection]
  }

  public static Void main ()
  {
    choice := getChoice (["fee fie", "huff and puff", "mirror mirror", "tick tock"])
    echo ("You chose: $choice")
  }
}


\ Rosetta Code Menu Idiomatic Forth

\ vector table compiler
: CASE:  ( -- ) CREATE ;
: |      ( -- <text>)  '  ,  ;  IMMEDIATE
: ;CASE  ( -- ) DOES>  SWAP CELLS + @ EXECUTE ;

: NIL      ( -- addr len) S" " ;
: FEE      ( -- addr len) S" fee fie" ;
: HUFF     ( -- addr len) S" huff and puff" ;
: MIRROR   ( -- addr len) S" mirror mirror" ;
: TICKTOCK ( -- addr len) S" tick tock" ;

CASE: SELECT ( n -- addr len)
     | NIL | FEE | HUFF | MIRROR | TICKTOCK
;CASE

CHAR 1 CONSTANT '1'
CHAR 4 CONSTANT '4'
: BETWEEN ( n low hi -- ?)  1+ WITHIN ;

: MENU ( addr len -- addr len )
       DUP 0=
       IF
          2DROP  NIL  EXIT
       ELSE
          BEGIN
             CR
             CR 2DUP 3 SPACES   TYPE
             CR   ." 1 " 1 SELECT TYPE
             CR   ." 2 " 2 SELECT TYPE
             CR   ." 3 " 3 SELECT TYPE
             CR   ." 4 " 4 SELECT TYPE
             CR ." Choice: " KEY DUP EMIT
             DUP '1' '4' BETWEEN 0=
          WHILE
              DROP
          REPEAT
          -ROT 2DROP    \ drop input string
          CR [CHAR] 0 -  SELECT
       THEN
;


!a=./f && make $a && OMP_NUM_THREADS=2 $a
!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o f

      module menu
      public :: selector
      contains

      function selector(title,options) result(choice)
      character(len=*),intent(in) :: title
      character(len=*),dimension(:),intent(in) :: options
      character(len=len(options)) :: choice
      integer :: i,ichoose,ios,n

      choice = ""

      n = size(options)
      if (n > 0) then
        do
          print "(a)",title
          print "(i8,"", "",a)",(i,options(i),i=1,n)
          read (*,fmt="(i8)",iostat=ios) ichoose

          if (ios == -1) exit ! EOF error
          if (ios /= 0) cycle ! other error
          if (ichoose < 1) cycle
          if (ichoose > n) cycle ! out-of-bounds

          choice = options(ichoose)
          exit
        end do
      end if
      end function selector
      end module menu

      program menu_demo
      use menu
      character(len=14),dimension(:),allocatable :: zero_items,fairytale
      character(len=len(zero_items)) :: s

      !! empty list demo
      allocate(zero_items(0))
      print "(a)","input items:",zero_items
      s = selector('Choose from the empty list',zero_items)
      print "(a)","returned:",s
      if (s == "") print "(a)","(an empty string)"

      !! Fairy tale demo
      allocate(fairytale(4))
      fairytale = (/'fee fie       ','huff and puff ', &
        'mirror mirror ','tick tock     '/)
      print "(a)","input items:",fairytale
      s = selector('Choose a fairy tale',fairytale)
      print "(a)","returned: ",s
      if (s == "") print "(a)","(an empty string)"

      end program menu_demo


dim as string menu(1 to 4)={ "fee fie", "huff and puff", "mirror mirror", "tick tock" }

function menu_select( m() as string ) as string
    dim as integer i, vc = 0
    dim as string c
    while vc<1 or vc > ubound(m)
        cls
        for i = 1 to ubound(m)
            print i;"  ";m(i)
        next i
        print

        input "Choice? ", c
        vc = val(c)
    wend
    return m(vc)
end function

print menu_select( menu() )


Public Sub Main()

    Dim asMenu As String[] = ["fee fie", "huff And puff", "mirror mirror", "tick tock"]
    Dim sValuePrompt As String = "Please select one of the above numbers> "
    Dim sChoice As String
    Dim sFeedbackFormat As String = "You have chosen '&1'\r\n"

    sChoice = Menu(asMenu, sValuePrompt)
    If sChoice = "" Then
        Print "menu returned an empty string"
    Else
        Print Subst(sFeedbackFormat, sChoice)
    Endif

End

Private Function Menu(asChoices As String[], sPrompt As String) As String

    Dim sReturnValue As String = ""
    Dim sMenuLineFormat As String = "&1) &2"
    Dim sAnswer As String
    Dim iAnswer As Integer
    Dim iIndex As Integer = 0
    Dim sMenuItem As String

    If Not IsNull(asChoices) Then
        If asChoices.Count > 0 Then
            Do
                For iIndex = 0 To asChoices.Max
                    sMenuItem = asChoices[iIndex]
                    Print Subst(sMenuLineFormat, iIndex, sMenuItem)
                Next

                Print sPrompt
                Input sAnswer

                If IsNumber(sAnswer) Then
                    iAnswer = sAnswer
                    If (0 <= iAnswer) And (iAnswer <= asChoices.Max) Then
                        sReturnValue = asChoices[iAnswer]
                        Break
                    Endif
                Endif
            Loop
        Endif
    Endif

    Return sReturnValue

End


package main

import "fmt"

func menu(choices []string, prompt string) string {
    if len(choices) == 0 {
        return ""
    }
    var c int
    for {
        fmt.Println("")
        for i, s := range choices {
            fmt.Printf("%d.  %s\n", i+1, s)
        }
        fmt.Print(prompt)
        _, err := fmt.Scanln(&c)

        if err == nil && c > 0 && c <= len(choices) {
            break
        }
    }
    return choices[c-1]
}

func main() {
    pick := menu(nil, "No prompt")
    fmt.Printf("No choices, result = %q\n", pick)

    choices := []string{
        "fee fie",
        "huff and puff",
        "mirror mirror",
        "tick tock",
    }
    pick = menu(choices, "Enter number: ")
    fmt.Printf("You picked %q\n", pick)
}


10 DATA "Fee fie", "Huff and Puff", "Mirror mirror", "Tick tock"
20 VC = 0
30 DIM M$(3)
40 FOR I = 0 TO 3
50 READ M$(I)
60 NEXT I
70 CLS
80 FOR I = 0 TO 3
90 PRINT I+1;"   ";M$(I)
100 NEXT I
110 PRINT
120 INPUT "Choice? ", C$
130 VC = VAL(C$)
140 IF VC<1 OR VC>4 THEN GOTO 70
150 PRINT "You picked ", M$(VC-1)
160 END


module RosettaSelect where

import Data.Maybe (listToMaybe)
import Control.Monad (guard)

select :: [String] -> IO String
select []   = return ""
select menu = do
  putStr $ showMenu menu
  putStr "Choose an item: "
  choice <- getLine
  maybe (select menu) return $ choose menu choice

showMenu :: [String] -> String
showMenu menu = unlines [show n ++ ") " ++ item | (n, item) <- zip [1..] menu]

choose :: [String] -> String -> Maybe String
choose menu choice = do
  n <- maybeRead choice
  guard $ n > 0
  listToMaybe $ drop (n-1) menu

maybeRead :: Read a => String -> Maybe a
maybeRead = fmap fst . listToMaybe . filter (null . snd) . reads


CHARACTER list = "fee fie,huff and puff,mirror mirror,tick tock,", answer*20

   POP(Menu=list, SelTxt=answer)

SUBROUTINE list ! callback procedure must have same name as menu argument
 ! Subroutine with no arguments: all objects are global
 ! The global variable $$ returns the selected list index
   WRITE(Messagebox, Name) answer, $$
END


## menu.icn : rewrite of the faulty version on Rosetta Code site 24/4/2021

procedure main()

L := ["fee fie", "huff and puff", "mirror mirror", "tick tock"]
K := ["hidie hi", "hidie ho", "mirror mirror on the Wall", "tick tock tick tok"]
Z := []

 choice := choose_from_menu(L)      # call using menu L
 write("Returned value =", choice)
 choice := choose_from_menu(K)      # call using menu K
 write("Returned value =", choice)
 choice := choose_from_menu(Z)      # call using empty list
 write("Returned value =", choice)

end ## of main
# --------- subroutines below ---------------------------------

procedure choose_from_menu(X)

 displaymenu(X)
repeat {
   writes("Choose a number from the menu above: ")
   a := read()
   if a == "" then return(a)   ## no selection

  write("You selected ",a)
  if numeric(a) then {
   if integer(a) <= 0 | integer(a) > *X  then displaymenu(X) else
      {                    ## check entered option in range
        write(a, " ==> ",X[a])
      return ( string(a))
	 }
	}
  else displaymenu(X)
   }

end ## choose_from_menu(X)

procedure displaymenu(X)
	every i := 1 to *X do
		write(i,") ",X[i])    ## dispay menu options

end ## displaymenu(X)


CHOICES =: ];._2 'fee fie;huff and puff;mirror mirror;tick tock;'
PROMPT =: 'Which is from the three pigs? '

showMenu =: [email protected]:(,"1~ (' ' ,.~ 3 ": [email protected]:(1 ,~ #)))
read_stdin =: 1!:1@:1:

menu =: '? '&$: :(4 : 0)
 NB. use:  [prompt] menu choice_array
 CHOICES =. y
 if. 0 = # CHOICES do. return. end.
 PROMPT =. x
 whilst. RESULT [email protected]:e. i. # CHOICES do.
  showMenu CHOICES
  smoutput PROMPT
  RESULT =. _1 ". read_stdin''
 end.
 RESULT {:: CHOICES
)


public static String select(List<String> list, String prompt){
    if(list.size() == 0) return "";
    Scanner sc = new Scanner(System.in);
    String ret = null;
    do{
        for(int i=0;i<list.size();i++){
            System.out.println(i + ": "+list.get(i));
        }
        System.out.print(prompt);
        int index = sc.nextInt();
        if(index >= 0 && index < list.size()){
            ret = list.get(index);
        }
    }while(ret == null);
    return ret;
}


const readline = require('readline');

async function menuSelect(question, choices) {
  if (choices.length === 0) return '';

  const prompt = choices.reduce((promptPart, choice, i) => {
    return promptPart += `${i + 1}. ${choice}\n`;
  }, '');

  let inputChoice = -1;
  while (inputChoice < 1 || inputChoice > choices.length) {
    inputChoice = await getSelection(`\n${prompt}${question}: `);
  }

  return choices[inputChoice - 1];
}

function getSelection(prompt) {
  return new Promise((resolve) => {
    const lr = readline.createInterface({
      input: process.stdin,
      output: process.stdout
    });

    lr.question(prompt, (response) => {
      lr.close();
      resolve(parseInt(response) || -1);
    });
  });
}

const choices = ['fee fie', 'huff and puff', 'mirror mirror', 'tick tock'];
const question = 'Which is from the three pigs?';
menuSelect(question, choices).then((answer) => {
  console.log(`\nYou chose ${answer}`);
});


def choice:
  def read(prompt; max):
    def __read__:
      prompt,
      ( input as $input
        | if ($input|type) == "number" and 0 < $input and $input <= max then $input
          else __read__
          end);
    __read__;

  if length == 0 then ""
  else
  . as $in
  | ("Enter your choice:\n" +
     (reduce range(0; length) as $i (""; . + "\($i + 1): \($in[$i])\n")) ) as $prompt
  | read($prompt; length) as $read
  | if ($read|type) == "string" then $read
    else "Thank you for selecting \($in[$read-1])" end
  end ;


using Printf

function _menu(items)
    for (ind, item) in enumerate(items)
        @printf "  %2i) %s\n" ind item
    end
end

_ok(::Any,::Any) = false
function _ok(reply::AbstractString, itemcount)
    n = tryparse(Int, reply)
    return isnull(n) || 0 ≤ get(n) ≤ itemcount
end

"Prompt to select an item from the items"
function _selector(items, prompt::AbstractString)
    isempty(items) && return ""
    reply = -1
    itemcount = length(items)
    while !_ok(reply, itemcount)
        _menu(items)
        print(prompt)
        reply = strip(readline(STDIN))
    end
    return items[parse(Int, reply)]
end

items = ["fee fie", "huff and puff", "mirror mirror", "tick tock"]
item = _selector(items, "Which is from the three pigs: ")
println("You chose: ", item)


// version 1.1.2

fun menu(list: List<String>): String {
    if (list.isEmpty()) return ""
    val n = list.size
    while (true) {
        println("\n   M E N U\n")
        for (i in 0 until n) println("${i + 1}: ${list[i]}")
        print("\nEnter your choice 1 - $n : ")
        val index = readLine()!!.toIntOrNull()
        if (index == null || index !in 1..n) continue
        return list[index - 1]
    }
}

fun main(args: Array<String>) {
    val list = listOf(
        "fee fie",
        "huff and puff",
        "mirror mirror",
        "tick tock"
    )
    val choice = menu(list)
    println("\nYou chose : $choice")
}


val .select = f(.entries) {
    if not isArray(.entries): throw "invalid args"
    if len(.entries) == 0: return ZLS

    # print the menu
    writeln join "\n", map(f $"\.i:2;: \.e;", .entries, 1..len .entries)

    val .idx = toNumber read(
        "Select entry #: ",
        f(.x) {
            if not matching(RE/^[0-9]+$/, .x): return false
            val .y = toNumber .x
            .y > 0 and .y <= len(.entries)
        },
        "invalid selection\n", -1,
    )

    .entries[.idx]
}

writeln .select(["fee fie", "eat pi", "huff and puff", "tick tock"])