Cut a rectangle

A given rectangle is made from ''m'' x ''n'' squares. If ''m'' and ''n'' are not both odd, then it is possible to cut a path through the rectangle along the square edges such that the rectangle splits into two connected pieces with the same shape (after rotating one of the pieces by 180deg). All such paths for 2 x 2 and 4 x 3 rectangles are shown below.

[[file:rect-cut.svg]]

Write a program that calculates the number of different ways to cut an ''m'' x ''n'' rectangle.  Optionally, show each of the cuts.

Possibly related task: [[Maze generation]] for depth-first search.

Solution:
function array1D(w, d)
    local t = {}
    for i=1,w do
        table.insert(t, d)
    end
    return t
end

function array2D(h, w, d)
    local t = {}
    for i=1,h do
        table.insert(t, array1D(w, d))
    end
    return t
end

function push(s, v)
    s[#s + 1] = v
end

function pop(s)
    return table.remove(s, #s)
end

function empty(s)
    return #s == 0
end

DIRS = {
    {0, -1},
    {-1, 0},
    {0, 1},
    {1, 0}
}

function printResult(aa)
    for i,u in pairs(aa) do
        io.write("[")
        for j,v in pairs(u) do
            if j > 1 then
                io.write(", ")
            end
            io.write(v)
        end
        print("]")
    end
end

function cutRectangle(w, h)
    if w % 2 == 1 and h % 2 == 1 then
        return nil
    end

    local grid = array2D(h, w, 0)
    local stack = {}

    local half = math.floor((w * h) / 2)
    local bits = 2 ^ half - 1

    while bits > 0 do
        for i=1,half do
            local r = math.floor((i - 1) / w)
            local c = (i - 1) % w
            if (bits & (1 << (i - 1))) ~= 0 then
                grid[r + 1][c + 1] = 1
            else
                grid[r + 1][c + 1] = 0
            end
            grid[h - r][w - c] = 1 - grid[r + 1][c + 1]
        end

        push(stack, 0)
        grid[1][1] = 2
        local count = 1
        while not empty(stack) do
            local pos = pop(stack)

            local r = math.floor(pos / w)
            local c = pos % w

            for i,dir in pairs(DIRS) do
                local nextR = r + dir[1]
                local nextC = c + dir[2]

                if nextR >= 0 and nextR < h and nextC >= 0 and nextC < w then
                    if grid[nextR + 1][nextC + 1] == 1 then
                        push(stack, nextR * w + nextC)
                        grid[nextR + 1][nextC + 1] = 2
                        count = count + 1
                    end
                end
            end
        end
        if count == half then
            printResult(grid)
            print()
        end

        -- loop end
        bits = bits - 2
    end
end

cutRectangle(2, 2)
cutRectangle(4, 3)


Damm algorithm

The '''Damm''' algorithm is a checksum algorithm which detects all single digit errors and adjacent transposition errors.

The algorithm is named after H. Michael Damm.

;Task:
Verify the checksum, stored as last digit of an input.

Solution:
local tab = {
    {0,3,1,7,5,9,8,6,4,2}, {7,0,9,2,1,5,4,8,6,3},
    {4,2,0,6,8,7,1,3,5,9}, {1,7,5,0,9,8,3,4,2,6},
    {6,1,2,3,0,4,5,9,7,8}, {3,6,7,4,2,0,9,5,8,1},
    {5,8,6,9,7,2,0,1,3,4}, {8,9,4,5,3,6,2,0,1,7},
    {9,4,3,8,6,1,7,2,0,5}, {2,5,8,1,4,3,6,7,9,0}
}
function check( n )
    local idx, a = 0, tonumber( n:sub( 1, 1 ) )
    for i = 1, #n do
        a = tonumber( n:sub( i, i ) )
        if a == nil then return false end
        idx = tab[idx + 1][a + 1]
    end
    return idx == 0
end
local n, r
while( true ) do
    io.write( "Enter the number to check: " )
    n = io.read(); if n == "0" then break end
    r = check( n ); io.write( n, " is " )
    if not r then io.write( "in" ) end
    io.write( "valid!\n" )
end


De Bruijn sequences

{{DISPLAYTITLE:de Bruijn sequences}}
The sequences are named after the Dutch mathematician   Nicolaas Govert de Bruijn.

A note on Dutch capitalization:   Nicolaas' last name is   '''de Bruijn''',   the   '''de'''   isn't normally capitalized
unless it's the first word in a sentence.   Rosetta Code (more or less by default or by fiat) requires the first word in the task name to be
capitalized.

In combinatorial mathematics,   a   '''de Bruijn sequence'''   of order    ''n''    on
a    size-''k''    alphabet (computer science)    ''A''    is a cyclic sequence in which every
possible    length-''n''    string (computer science, formal theory)   on    ''A''    occurs
exactly once as a contiguous substring.

Such a sequence is denoted by    ''B''(''k'', ''n'')    and has
length   ''k''''n'',   which is also the number of distinct substrings of
length   ''n''   on   ''A'';
de Bruijn sequences are therefore optimally short.

There are:
                          (k!)k(n-1)   /   kn
distinct de Bruijn sequences    ''B''(''k'', ''n'').

;Task:
For this Rosetta Code task,   a   '''de Bruijn'''   sequence is to be generated that can be used to shorten a brute-force attack on
a   PIN-like   code lock that does not have an "enter"
key and accepts the last    ''n''    digits entered.

Note:   automated teller machines (ATMs)   used to work like
this,   but their software has been updated to not allow a brute-force attack.

;Example:
A   digital door lock   with a 4-digit code would
have ''B'' (10, 4) solutions,   with a length of   '''10,000'''   (digits).

Therefore, only at most     '''10,000 + 3'''     (as the solutions are cyclic or ''wrap-around'')   presses are needed to
open the lock.

Trying all 4-digit codes separately would require   '''4 x 10,000'''   or   '''40,000'''   presses.

;Task requirements:
:*   Generate a de Bruijn sequence for a 4-digit (decimal) PIN code.
:::*   Show the length of the generated de Bruijn sequence.
:::*   (There are many possible de Bruijn sequences that solve this task,   one solution is shown on the ''discussion'' page).
:::*   Show the first and last   '''130'''   digits of the de Bruijn sequence.
:*   Verify that all four-digit (decimal)   '''1,000'''   PIN codes are contained within the de Bruijn sequence.
:::*   0000, 0001, 0002, 0003,   ...   9996, 9997, 9998, 9999   (note the leading zeros).
:*   Reverse the de Bruijn sequence.
:*   Again, perform the (above) verification test.
:*   Replace the 4,444th digit with a period (.) in the original de Bruijn sequence.
:::*   Perform the verification test (again).   There should be four PIN codes missing.

(The last requirement is to ensure that the verification tests performs correctly.   The verification processes should list
any and all missing PIN codes.)

Show all output here, on this page.

;References:
:*   Wikipedia           entry:   de Bruijn sequence.
:*   MathWorld           entry:   de Bruijn sequence.
:*   An  OEIS  entry:   A166315 lexicographically earliest binary de Bruijn sequences, B(2,n)     --- Not B(10,4),   but possibly relevant.

Solution:
function tprint(tbl)
    for i,v in pairs(tbl) do
        print(v)
    end
end

function deBruijn(k, n)
    local a = {}
    for i=1, k*n do
        table.insert(a, 0)
    end

    local seq = {}
    function db(t, p)
        if t > n then
            if n % p == 0 then
                for i=1, p do
                    table.insert(seq, a[i + 1])
                end
            end
        else
            a[t + 1] = a[t - p + 1]
            db(t + 1, p)

            local j = a[t - p + 1] + 1
            while j < k do
                a[t + 1] = j % 256
                db(t + 1, t)
                j = j + 1
            end
        end
    end

    db(1, 1)

    local buf = ""
    for i,v in pairs(seq) do
        buf = buf .. tostring(v)
    end
    return buf .. buf:sub(1, n - 1)
end

function allDigits(s)
    return s:match('[0-9]+') == s
end

function validate(db)
    local le = string.len(db)
    local found = {}
    local errs = {}

    for i=1, 10000 do
        table.insert(found, 0)
    end

    -- Check all strings of 4 consecutive digits within 'db'
    -- to see if all 10,000 combinations occur without duplication.
    for i=1, le - 3 do
        local s = db:sub(i, i + 3)
        if allDigits(s) then
            local n = tonumber(s)
            found[n + 1] = found[n + 1] + 1
        end
    end

    local count = 0
    for i=1, 10000 do
        if found[i] == 0 then
            table.insert(errs, "    PIN number " .. (i - 1) .. " missing")
            count = count + 1
        elseif found[i] > 1 then
            table.insert(errs, "    PIN number " .. (i - 1) .. " occurs " .. found[i] .. " times")
            count = count + 1
        end
    end

    if count == 0 then
        print("  No errors found")
    else
        tprint(errs)
    end
end

function main()
    local db = deBruijn(10,4)

    print("The length of the de Bruijn sequence is " .. string.len(db))
    print()

    io.write("The first 130 digits of the de Bruijn sequence are: ")
    print(db:sub(0, 130))
    print()

    io.write("The last 130 digits of the de Bruijn sequence are: ")
    print(db:sub(-130))
    print()

    print("Validating the de Bruijn sequence:")
    validate(db)
    print()

    print("Validating the reversed de Bruijn sequence:")
    validate(db:reverse())
    print()

    db = db:sub(1,4443) .. "." .. db:sub(4445)
    print("Validating the overlaid de Bruijn sequence:")
    validate(db)
    print()
end

main()


Deepcopy

Demonstrate how to copy data structures containing complex heterogeneous and cyclic semantics.

This is often referred to as deep copying, and is normally required where structures are mutable and to ensure that independent copies can be manipulated without side-effects.

If this facility is not built into the language, it is permissible to use functions from a common library, or a coded procedure.

The task should show:

* Relevant semantics of structures, such as their homogeneous or heterogeneous properties, or containment of (self- or mutual-reference) cycles.

* Any limitations of the method.

* That the structure and its copy are different.

* Suitable links to external documentation for common libraries.

Solution:
function _deepcopy(o, tables)

  if type(o) ~= 'table' then
    return o
  end

  if tables[o] ~= nil then
    return tables[o]
  end

  local new_o = {}
  tables[o] = new_o

  for k, v in next, o, nil do
    local new_k = _deepcopy(k, tables)
    local new_v = _deepcopy(v, tables)
    new_o[new_k] = new_v
  end

  return new_o
end

function deepcopy(o)
  return _deepcopy(o, {})
end


Department numbers

There is a highly organized city that has decided to assign a number to each of their departments:
::*   police department
::*   sanitation department
::*   fire department

Each department can have a number between   '''1'''   and   '''7'''   (inclusive).

The three department numbers are to be unique (different from each other) and must add up to   '''12'''.

The Chief of the Police doesn't like odd numbers and wants to have an even number for his department.

;Task:
Write a computer program which outputs all valid combinations.

Possible output   (for the 1st and 14th solutions):

  --police--  --sanitation--  --fire--
      2             3            7
      6             5            1

Solution:
print( "Fire", "Police", "Sanitation" )
sol = 0
for f = 1, 7 do
    for p = 1, 7 do
        for s = 1, 7 do
            if s + p + f == 12 and p % 2 == 0 and f ~= p and f ~= s and p ~= s then
                print( f, p, s ); sol = sol + 1
            end
        end
    end
end
print( string.format( "\n%d solutions found", sol ) )


Descending primes

Generate and show all primes with strictly descending decimal digits.

;See also
;* OEIS:A052014 - Primes with distinct digits in descending order

;Related:
*[[Ascending primes]]

Solution:
local function is_prime(n)
  if n < 2 then return false end
  if n % 2 == 0 then return n==2 end
  if n % 3 == 0 then return n==3 end
  for f = 5, n^0.5, 6 do
    if n%f==0 or n%(f+2)==0 then return false end
  end
  return true
end

local function descending_primes()
  local digits, candidates, primes = {9,8,7,6,5,4,3,2,1}, {0}, {}
  for i = 1, #digits do
    for j = 1, #candidates do
      local value = candidates[j] * 10 + digits[i]
      if is_prime(value) then primes[#primes+1] = value end
      candidates[#candidates+1] = value
    end
  end
  table.sort(primes)
  return primes
end

print(table.concat(descending_primes(), ", "))


Detect division by zero

Write a function to detect a   ''divide by zero error''   without checking if the denominator is zero.

Solution:
local function div(a,b)
  if b == 0 then error() end
  return a/b
end


Determinant and permanent

permanent of the matrix.

The determinant is given by
:: \det(A) = \sum_\sigma\sgn(\sigma)\prod_{i=1}^n M_{i,\sigma_i}
while the permanent is given by
::  \operatorname{perm}(A)=\sum_\sigma\prod_{i=1}^n M_{i,\sigma_i}
In both cases the sum is over the permutations \sigma of the permutations of 1, 2, ..., ''n''. (A permutation's sign is 1 if there are an even number of inversions and -1 otherwise; see parity of a permutation.)

More efficient algorithms for the determinant are known: [[LU decomposition]], see for example [[wp:LU decomposition#Computing the determinant]]. Efficient methods for calculating the permanent are not known.

;Related task:
* [[Permutations by swapping]]

Solution:
-- Johnson–Trotter permutations generator
_JT={}
function JT(dim)
  local n={ values={}, positions={}, directions={}, sign=1 }
  setmetatable(n,{__index=_JT})
  for i=1,dim do
    n.values[i]=i
    n.positions[i]=i
    n.directions[i]=-1
  end
  return n
end

function _JT:largestMobile()
  for i=#self.values,1,-1 do
    local loc=self.positions[i]+self.directions[i]
    if loc >= 1 and loc <= #self.values and self.values[loc] < i then
      return i
    end
  end
  return 0
end

function _JT:next()
  local r=self:largestMobile()
  if r==0 then return false end
  local rloc=self.positions[r]
  local lloc=rloc+self.directions[r]
  local l=self.values[lloc]
  self.values[lloc],self.values[rloc] = self.values[rloc],self.values[lloc]
  self.positions[l],self.positions[r] = self.positions[r],self.positions[l]
  self.sign=-self.sign
  for i=r+1,#self.directions do self.directions[i]=-self.directions[i] end
  return true
end

-- matrix class

_MTX={}
function MTX(matrix)
  setmetatable(matrix,{__index=_MTX})
  matrix.rows=#matrix
  matrix.cols=#matrix[1]
  return matrix
end

function _MTX:dump()
  for _,r in ipairs(self) do
    print(unpack(r))
  end
end

function _MTX:perm() return self:det(1) end
function _MTX:det(perm)
  local det=0
  local jt=JT(self.cols)
  repeat
    local pi=perm or jt.sign
    for i,v in ipairs(jt.values) do
      pi=pi*self[i][v]
    end
    det=det+pi
  until not jt:next()
  return det
end

-- test

matrix=MTX
{
  { 7,  2, -2,  4},
  { 4,  4,  1,  7},
  {11, -8,  9, 10},
  {10,  5, 12, 13}
}
matrix:dump();
print("det:",matrix:det(), "permanent:",matrix:perm(),"\n")

matrix2=MTX
{
  {-2, 2,-3},
  {-1, 1, 3},
  { 2, 0,-1}
}
matrix2:dump();
print("det:",matrix2:det(), "permanent:",matrix2:perm())


Determine if a string has all the same characters

Given a character string   (which may be empty, or have a length of zero characters):
::*   create a function/procedure/routine to:
::::*    determine if all the characters in the string are the same
::::*    indicate if or which character is different from the previous character
::*   display each string and its length   (as the strings are being examined)
::*   a zero-length (empty) string shall be considered as all the same character(s)
::*   process the strings from left-to-right
::*   if       all the same character,   display a message saying such
::*   if                  not all the same character,   then:
::::*    display a message saying such
::::*    display what character is different
::::*    only the 1st different character need be displayed
::::*    display where the different character is in the string
::::*    the above messages can be part of a single message
::::*    display the hexadecimal value of the different character

Use (at least) these seven test values   (strings):
:::*   a string of length   0   (an empty string)
:::*   a string of length   3   which contains three blanks
:::*   a string of length   1   which contains:   '''2'''
:::*   a string of length   3   which contains:   '''333'''
:::*   a string of length   3   which contains:   '''.55'''
:::*   a string of length   6   which contains:   '''tttTTT'''
:::*   a string of length   9   with a blank in the middle:   '''4444   444k'''

Show all output here on this page.

Solution:
function analyze(s)
    print(string.format("Examining [%s] which has a length of %d:", s, string.len(s)))
    if string.len(s) > 1 then
        local last = string.byte(string.sub(s,1,1))
        for i=1,string.len(s) do
            local c = string.byte(string.sub(s,i,i))
            if last ~= c then
                print("    Not all characters in the string are the same.")
                print(string.format("    '%s' (0x%x) is different at position %d", string.sub(s,i,i), c, i - 1))
                return
            end
        end
    end
    print("    All characters in the string are the same.")
end

function main()
    analyze("")
    analyze("   ")
    analyze("2")
    analyze("333")
    analyze(".55")
    analyze("tttTTT")
    analyze("4444 444k")
end

main()


Determine if a string has all unique characters

Given a character string   (which may be empty, or have a length of zero characters):
::*   create a function/procedure/routine to:
::::*    determine if all the characters in the string are unique
::::*    indicate if or which character is duplicated and where
::*   display each string and its length   (as the strings are being examined)
::*   a zero-length (empty) string shall be considered as unique
::*   process the strings from left-to-right
::*   if       unique,   display a message saying such
::*   if                  not unique,   then:
::::*    display a message saying such
::::*    display what character is duplicated
::::*    only the 1st non-unique character need be displayed
::::*    display where "both" duplicated characters are in the string
::::*    the above messages can be part of a single message
::::*    display the hexadecimal value of the duplicated character

Use (at least) these five test values   (strings):
:::*   a string of length     0   (an empty string)
:::*   a string of length     1   which is a single period   ('''.''')
:::*   a string of length     6   which contains:   '''abcABC'''
:::*   a string of length     7   which contains a blank in the middle:   '''XYZ  ZYX'''
:::*   a string of length         36   which   ''doesn't''   contain the letter "oh":
::::::::  '''1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ'''

Show all output here on this page.

Solution:
local find, format = string.find, string.format
local function printf(fmt, ...) print(format(fmt,...)) end

local pattern = '(.).-%1' -- '(.)' .. '.-' .. '%1'

function report_dup_char(subject)
    local pos1, pos2, char = find(subject, pattern)

    local prefix = format('"%s" (%d)', subject, #subject)
    if pos1 then
        local byte = char:byte()
        printf("%s: '%s' (0x%02x) duplicates at %d, %d", prefix, char, byte, pos1, pos2)
    else
        printf("%s: no duplicates", prefix)
    end
end

local show = report_dup_char
show('coccyx')
show('')
show('.')
show('abcABC')
show('XYZ ZYX')
show('1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ')


Determine if a string is collapsible

Determine if a character string is   ''collapsible''.

And if so,   collapse the string   (by removing   ''immediately repeated''   characters).

If a character string has   ''immediately repeated''   character(s),   the repeated characters are to be
deleted (removed),   but not the primary (1st) character(s).

An   ''immediately repeated''   character is any character that is   immediately   followed by an
identical character (or characters).   Another word choice could've been   ''duplicated character'',   but that
might have ruled out   (to some readers)   triplicated characters   ***   or more.

{This Rosetta Code task was inspired by a newly introduced   (as of around November 2019)   '''PL/I'''   BIF:   '''collapse'''.}

;Examples:
In the following character string:

  The better the 4-wheel drive, the further you'll be from help when ya get stuck!

Only the 2nd   '''t''',   '''e''', and   '''l'''   are repeated characters,   indicated
by underscores (above),   even though they (those characters) appear elsewhere in the character string.

So, after ''collapsing'' the string, the result would be:

  The beter the 4-whel drive, the further you'l be from help when ya get stuck!

Another example:
In the following character string:

  headmistressship

The "collapsed" string would be:

  headmistreship

;Task:
Write a subroutine/function/procedure/routine***   to
locate   ''repeated''   characters and   ''collapse''   (delete)   them from the character
string.   The character string can be processed from either direction.

Show all output here, on this page:
:*   the   original string and its length
:*   the       resultant string and its length
:*   the above strings should be "bracketed" with   '''<<<'''   and   '''>>>'''   (to delineate blanks)
;*   <<<<<<Guillemets may be used instead for "bracketing" for the more artistic programmers,   shown used here>>>>>>

Use (at least) the following five strings,   all strings are length seventy-two (characters, including blanks),   except
the 1st string:

  string
  number
         ++
    1    |+-----------------------------------------------------------------------+   <######  a null string  (length zero)
    2    |"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln |
    3    |..1111111111111111111111111111111111111111111111111111111111111117777888|
    4    |I never give 'em hell, I just tell the truth, and they think it's hell. |
    5    |                                                    --- Harry S Truman  |   <######  has many repeated blanks
         +------------------------------------------------------------------------+

Solution:
function collapse(s)
    local ns = ""
    local last = nil
    for c in s:gmatch"." do
        if last then
            if last ~= c then
                ns = ns .. c
            end
            last = c
        else
            ns = ns .. c
            last = c
        end
    end
    return ns
end

function test(s)
    print("old: " .. s:len() .. " <<<" .. s .. ">>>")
    local a = collapse(s)
    print("new: " .. a:len() .. " <<<" .. a .. ">>>")
end

function main()
    test("")
    test("The better the 4-wheel drive, the further you'll be from help when ya get stuck!")
    test("headmistressship")
    test("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ")
    test("..1111111111111111111111111111111111111111111111111111111111111117777888")
    test("I never give 'em hell, I just tell the truth, and they think it's hell. ")
    test("                                                    --- Harry S Truman  ")
end

main()


Determine if a string is squeezable

Determine if a character string is   ''squeezable''.

And if so,   squeeze the string   (by removing any number of
a   ''specified''   ''immediately repeated''   character).

This task is very similar to the task     '''Determine if a character string is collapsible'''     except
that only a specified character is   ''squeezed''   instead of any character that is ''immediately repeated''.

If a character string has a specified   ''immediately repeated''   character(s),   the repeated characters are to be
deleted (removed),   but not the primary (1st) character(s).

A specified   ''immediately repeated''   character is any specified character that is   immediately
followed by an identical character (or characters).   Another word choice could've been   ''duplicated
character'',   but that might have ruled out   (to some readers)   triplicated characters   ***   or more.

{This Rosetta Code task was inspired by a newly introduced   (as of around
November 2019)   '''PL/I'''   BIF:   '''squeeze'''.}

;Examples:
In the following character string with a specified   ''immediately repeated''   character of   '''e''':

  The better the 4-wheel drive, the further you'll be from help when ya get stuck!

Only the 2nd   '''e'''   is an specified repeated character,   indicated by an underscore
(above),   even though they (the characters) appear elsewhere in the character string.

So, after ''squeezing'' the string, the result would be:

  The better the 4-whel drive, the further you'll be from help when ya get stuck!

Another example:
In the following character string,   using a specified immediately repeated character   '''s''':

  headmistressship

The "squeezed" string would be:

  headmistreship

;Task:
Write a subroutine/function/procedure/routine***   to locate a   ''specified immediately repeated''   character
and   ''squeeze''   (delete)   them from the character string.   The
character string can be processed from either direction.

Show all output here, on this page:
:*   the   specified repeated character   (to be searched for and possibly ''squeezed''):
:*   the   original string and its length
:*   the       resultant string and its length
:*   the above strings should be "bracketed" with   '''<<<'''   and   '''>>>'''   (to delineate blanks)
;*   <<<<<<Guillemets may be used instead for "bracketing" for the more artistic programmers,   shown used here>>>>>>

Use (at least) the following five strings,   all strings are length seventy-two (characters, including blanks),   except
the 1st string:

                                                                                immediately
  string                                                                            repeated
  number                                                                            character
                                                                                ( |   a blank,  a minus,  a seven,  a period)
         ++
    1    |+-----------------------------------------------------------------------+    ' '    <######  a null string  (length zero)
    2    |"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln |    '-'
    3    |..1111111111111111111111111111111111111111111111111111111111111117777888|    '7'
    4    |I never give 'em hell, I just tell the truth, and they think it's hell. |    '.'
    5    |                                                    --- Harry S Truman  |  (below)  <######  has many repeated blanks
         +------------------------------------------------------------------------+     |
                                                                                |
                                                                                |
         For the 5th string  (Truman's signature line),  use each of these  specified immediately  repeated characters:
                                   *  a blank
                                   *  a minus
                                   *  a lowercase  '''r'''

Note:   there should be seven results shown,   one each for the 1st four strings,   and three results for
the 5th string.

Solution:
function squeezable(s, rune)
    print("squeeze: `" .. rune .. "`")
    print("old: <<<" .. s .. ">>>, length = " .. string.len(s))

    local last = nil
    local le = 0
    io.write("new: <<<")
    for c in s:gmatch"." do
        if c ~= last or c ~= rune then
            io.write(c)
            le = le + 1
        end
        last = c
    end
    print(">>>, length = " .. le)

    print()
end

function main()
    squeezable("", ' ');
    squeezable("\"If I were two-faced, would I be wearing this one?\" --- Abraham Lincoln ", '-')
    squeezable("..1111111111111111111111111111111111111111111111111111111111111117777888", '7')
    squeezable("I never give 'em hell, I just tell the truth, and they think it's hell. ", '.')

    local s = "                                                    --- Harry S Truman  "
    squeezable(s, ' ')
    squeezable(s, '-')
    squeezable(s, 'r')
end

main()


Determine if two triangles overlap

Solution:
function det2D(p1,p2,p3)
    return p1.x * (p2.y - p3.y)
         + p2.x * (p3.y - p1.y)
         + p3.x * (p1.y - p2.y)
end

function checkTriWinding(p1,p2,p3,allowReversed)
    local detTri = det2D(p1,p2,p3)
    if detTri < 0.0 then
        if allowReversed then
            local t = p3
            p3 = p2
            p2 = t
        else
            error("triangle has wrong winding direction")
        end
    end
    return nil
end

function boundaryCollideChk(p1,p2,p3,eps)
    return det2D(p1,p2,p3) < eps
end

function boundaryDoesntCollideChk(p1,p2,p3,eps)
    return det2D(p1,p2,p3) <= eps
end

function triTri2D(t1,t2,eps,allowReversed,onBoundary)
    eps = eps or 0.0
    allowReversed = allowReversed or false
    onBoundary = onBoundary or true

    -- triangles must be expressed anti-clockwise
    checkTriWinding(t1[1], t1[2], t1[3], allowReversed)
    checkTriWinding(t2[1], t2[2], t2[3], allowReversed)

    local chkEdge
    if onBoundary then
        -- points on the boundary are considered as colliding
        chkEdge = boundaryCollideChk
    else
        -- points on the boundary are not considered as colliding
        chkEdge = boundaryDoesntCollideChk
    end

    -- for edge E of triangle 1
    for i=0,2 do
        local j = (i+1)%3

        -- check all points of triangle 2 lay on the external side of the edge E.
        -- If they do, the triangles do not collide
        if chkEdge(t1[i+1], t1[j+1], t2[1], eps) and
           chkEdge(t1[i+1], t1[j+1], t2[2], eps) and
           chkEdge(t1[i+1], t1[j+1], t2[3], eps) then
            return false
        end
    end

    -- for edge E of triangle 2
    for i=0,2 do
        local j = (i+1)%3

        -- check all points of triangle 1 lay on the external side of the edge E.
        -- If they do, the triangles do not collide
        if chkEdge(t2[i+1], t2[j+1], t1[1], eps) and
           chkEdge(t2[i+1], t2[j+1], t1[2], eps) and
           chkEdge(t2[i+1], t2[j+1], t1[3], eps) then
            return false
        end
    end

    -- the triangles collide
    return true
end

function formatTri(t)
    return "Triangle: ("..t[1].x..", "..t[1].y
                .."), ("..t[2].x..", "..t[2].y
                .."), ("..t[3].x..", "..t[3].y..")"
end

function overlap(t1,t2,eps,allowReversed,onBoundary)
    if triTri2D(t1,t2,eps,allowReversed,onBoundary) then
        return "overlap\n"
    else
        return "do not overlap\n"
    end
end

-- Main
local t1 = {{x=0,y=0},{x=5,y=0},{x=0,y=5}}
local t2 = {{x=0,y=0},{x=5,y=0},{x=0,y=6}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2))

t1 = {{x=0,y=0},{x=0,y=5},{x=5,y=0}}
t2 = {{x=0,y=0},{x=0,y=5},{x=5,y=0}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2,0.0,true))

t1 = {{x=0,y=0},{x=5,y=0},{x=0,y=5}}
t2 = {{x=-10,y=0},{x=-5,y=0},{x=-1,y=6}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2))

t1 = {{x=0,y=0},{x=5,y=0},{x=2.5,y=5}}
t2 = {{x=0,y=4},{x=2.5,y=-1},{x=5,y=4}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2))

t1 = {{x=0,y=0},{x=1,y=1},{x=0,y=2}}
t2 = {{x=2,y=1},{x=3,y=0},{x=3,y=2}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2))

t1 = {{x=0,y=0},{x=1,y=1},{x=0,y=2}}
t2 = {{x=2,y=1},{x=3,y=-2},{x=3,y=4}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2))

-- Barely touching
t1 = {{x=0,y=0},{x=1,y=0},{x=0,y=1}}
t2 = {{x=1,y=0},{x=2,y=0},{x=1,y=1}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2,0.0,false,true))

-- Barely touching
local t1 = {{x=0,y=0},{x=1,y=0},{x=0,y=1}}
local t2 = {{x=1,y=0},{x=2,y=0},{x=1,y=1}}
print(formatTri(t1).." and")
print(formatTri(t2))
print(overlap(t1,t2,0.0,false,false))


Dice game probabilities

Two players have a set of dice each. The first player has nine dice with four faces each, with numbers one to four. The second player has six normal dice with six faces each, each face has the usual numbers from one to six.

They roll their dice and sum the totals of the faces. The player with the highest total wins (it's a draw if the totals are the same). What's the probability of the first player beating the second player?

Later the two players use a different set of dice each. Now the first player has five dice with ten faces each, and the second player has six dice with seven faces each. Now what's the probability of the first player beating the second player?

This task was adapted from the Project Euler Problem n.205:
https://projecteuler.net/problem=205

Solution:
local function simu(ndice1, nsides1, ndice2, nsides2)
  local function roll(ndice, nsides)
    local result = 0;
    for i = 1, ndice do
      result = result + math.random(nsides)
    end
    return result
  end
  local wins, coms = 0, 1000000
  for i = 1, coms do
    local roll1 = roll(ndice1, nsides1)
    local roll2 = roll(ndice2, nsides2)
    if (roll1 > roll2) then
      wins = wins + 1
    end
  end
  print("simulated:  p1 = "..ndice1.."d"..nsides1..", p2 = "..ndice2.."d"..nsides2..",  prob = "..wins.." / "..coms.." = "..(wins/coms))
end

simu(9, 4, 6, 6)
simu(5, 10, 6, 7)


Digital root

The digital root, X, of a number, n, is calculated:
: find X as the sum of the digits of n
: find a new X by summing the digits of X, repeating until X has only one digit.

The additive persistence is the number of summations required to obtain the single digit.

The task is to calculate the additive persistence and the digital root of a number, e.g.:
:627615 has additive persistence 2 and digital root of 9;
:39390 has additive persistence 2 and digital root of 6;
:588225 has additive persistence 2 and digital root of 3;
:393900588225 has additive persistence 2 and digital root of 9;

The digital root may be calculated in bases other than 10.

;See:
* [[Casting out nines]] for this wiki's use of this procedure.
* [[Digital root/Multiplicative digital root]]
* [[Sum digits of an integer]]
* Digital root sequence on OEIS
* Additive persistence sequence on OEIS
* [[Iterated digits squaring]]

Solution:
function digital_root(n, base)
    p = 0
    while n > 9.5 do
        n = sum_digits(n, base)
        p = p + 1
    end
    return n, p
end

print(digital_root(627615, 10))
print(digital_root(39390, 10))
print(digital_root(588225, 10))
print(digital_root(393900588225, 10))


Disarium numbers

A '''Disarium number''' is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.

;E.G.

'''135''' is a '''Disarium number''':

 11 + 32 + 53 == 1 + 9 + 125 == 135

There are a finite number of '''Disarium numbers'''.

;Task

* Find and display the first 18 '''Disarium numbers'''.

;Stretch

* Find and display all 20 '''Disarium numbers'''.

;See also

;* Geeks for Geeks - Disarium numbers
;* OEIS:A032799 - Numbers n such that n equals the sum of its digits raised to the consecutive powers (1,2,3,...)
;* Related task: Narcissistic decimal number
;* Related task: Own digits power sum  ''Which seems to be the same task as Narcissistic decimal number...''

Solution:
function isDisarium (x)
    local str, sum, digit = tostring(x), 0
    for pos = 1, #str do
        digit = tonumber(str:sub(pos, pos))
        sum = sum + (digit ^ pos)
    end
    return sum == x
end

local count, n = 0, 0
while count < 19 do
    if isDisarium(n) then
        count = count + 1
        io.write(n .. " ")
    end
    n = n + 1
end


Display a linear combination

Display a finite linear combination in an infinite vector basis (e_1, e_2,\ldots).

Write a function that, when given a finite list of scalars (\alpha^1,\alpha^2,\ldots), creates a string representing the linear combination \sum_i\alpha^i e_i in an explicit format often used in mathematics, that is:

:\alpha^{i_1}e_{i_1}\pm|\alpha^{i_2}|e_{i_2}\pm|\alpha^{i_3}|e_{i_3}\pm\ldots

where \alpha^{i_k}\neq 0

The output must comply to the following rules:
*   don't show null terms, unless the whole combination is null.
:::::::  '''e(1)'''     is fine,     '''e(1) + 0*e(3)'''     or     '''e(1) + 0'''     is wrong.
*   don't show scalars when they are equal to one or minus one.
:::::::  '''e(3)'''     is fine,     '''1*e(3)'''     is wrong.
*   don't prefix by a minus sign if it follows a preceding term.   Instead you use subtraction.
:::::::  '''e(4) - e(5)'''     is fine,     '''e(4) + -e(5)'''     is wrong.

Show here output for the following lists of scalars:

 1)    1,  2,  3
 2)    0,  1,  2,  3
 3)    1,  0,  3,  4
 4)    1,  2,  0
 5)    0,  0,  0
 6)    0
 7)    1,  1,  1
 8)   -1, -1, -1
 9)   -1, -2,  0, -3
10)   -1

Solution:
function t2s(t)
    local s = "["
    for i,v in pairs(t) do
        if i > 1 then
            s = s .. ", " .. v
        else
            s = s .. v
        end
    end
    return s .. "]"
end

function linearCombo(c)
    local sb = ""
    for i,n in pairs(c) do
        local skip = false

        if n < 0 then
            if sb:len() == 0 then
                sb = sb .. "-"
            else
                sb = sb .. " - "
            end
        elseif n > 0 then
            if sb:len() ~= 0 then
                sb = sb .. " + "
            end
        else
            skip = true
        end

        if not skip then
            local av = math.abs(n)
            if av ~= 1 then
                sb = sb .. av .. "*"
            end
            sb = sb .. "e(" .. i .. ")"
        end
    end
    if sb:len() == 0 then
        sb = "0"
    end
    return sb
end

function main()
    local combos = {
        {  1,  2,  3},
        {  0,  1,  2,  3 },
        {  1,  0,  3,  4 },
        {  1,  2,  0 },
        {  0,  0,  0 },
        {  0 },
        {  1,  1,  1 },
        { -1, -1, -1 },
        { -1, -2, 0, -3 },
        { -1 }
    }

    for i,c in pairs(combos) do
        local arr = t2s(c)
        print(string.format("%15s -> %s", arr, linearCombo(c)))
    end
end

main()


Diversity prediction theorem

The   ''wisdom of the crowd''   is the collective opinion of a group of individuals rather than that of a single expert.

Wisdom-of-the-crowds research routinely attributes the superiority of crowd averages over individual judgments to the elimination of individual noise,   an explanation that assumes independence of the individual judgments from each other.

Thus the crowd tends to make its best decisions if it is made up of diverse opinions and ideologies.

Scott E. Page introduced the diversity prediction theorem:
: ''The squared error of the collective prediction equals the average squared error minus the predictive diversity''.

Therefore,   when the diversity in a group is large,   the error of the crowd is small.

;Definitions:
::*   Average Individual Error:   Average of the individual squared errors
::*   Collective Error:           Squared error of the collective prediction
::*   Prediction Diversity:       Average squared distance from the individual predictions to the collective prediction
::*   Diversity Prediction Theorem:   ''Given a crowd of predictive models'',     then
::::::   Collective Error   =   Average Individual Error   -   Prediction Diversity

;Task:
For a given   true   value and a number of number of estimates (from a crowd),   show   (here on this page):
:::*   the true value   and   the crowd estimates
:::*   the average error
:::*   the crowd error
:::*   the prediction diversity

Use   (at least)   these two examples:
:::*   a true value of   '''49'''   with crowd estimates of:   ''' 48   47   51'''
:::*   a true value of   '''49'''   with crowd estimates of:   ''' 48   47   51   42'''

;Also see:
:*   Wikipedia entry:   Wisdom of the crowd
:*   University of Michigan: PDF paper         (exists on a web archive,   the ''Wayback Machine'').

Solution:
function square(x)
    return x * x
end

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

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

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

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

main()


Dot product

Create a function/use an in-built function, to compute the   '''dot product''',   also known as the   '''scalar product'''   of two vectors.

If possible, make the vectors of arbitrary length.

As an example, compute the dot product of the vectors:
::::     [1,  3, -5]       and
::::     [4,      -2, -1]

If implementing the dot product of two vectors directly:
:::*   each vector must be the same length
:::*   multiply corresponding terms from each vector
:::*   sum the products   (to produce the answer)

;Related task:
*   [[Vector products]]

Solution:
function dotprod(a, b)
  local ret = 0
  for i = 1, #a do
    ret = ret + a[i] * b[i]
  end
  return ret
end

print(dotprod({1, 3, -5}, {4, -2, 1}))


Draw a clock

Draw a clock.

More specific:
# Draw a time keeping device. It can be a stopwatch, hourglass, sundial, a mouth counting "one thousand and one", anything. Only showing the seconds is required, e.g.: a watch with just a second hand will suffice. However, it must clearly change every second, and the change must cycle every so often (one minute, 30 seconds, etc.) It must be ''drawn''; printing a string of numbers to your terminal doesn't qualify. Both text-based and graphical drawing are OK.
# The clock is unlikely to be used to control space flights, so it needs not be hyper-accurate, but it should be usable, meaning if one can read the seconds off the clock, it must agree with the system clock.
# A clock is rarely (never?) a major application: don't be a CPU hog and poll the system timer every microsecond, use a proper timer/signal/event from your system or language instead. For a bad example, many OpenGL programs update the frame-buffer in a busy loop even if no redraw is needed, which is very undesirable for this task.
# A clock is rarely (never?) a major application: try to keep your code simple and to the point. Don't write something too elaborate or convoluted, instead do whatever is natural, concise and clear in your language.

;Key points
* animate simple object
* timed event
* polling system resources
* code clarity

Solution:
==={{libheader|LÖVE}}===
Several nice clocks in the [http://love2d.org/forums/viewtopic.php?f=5&t=77346 LÖVE-forum]


Draw a rotating cube

Task
Draw a rotating cube.

It should be oriented with one vertex pointing straight up, and its opposite vertex on the main diagonal (the one farthest away) straight down. It can be solid or wire-frame, and you can use ASCII art if your language doesn't have graphical capabilities. Perspective is optional.

;Related tasks
* Draw a cuboid
* write language name in 3D ASCII

Solution:
local abs,atan,cos,floor,pi,sin,sqrt = math.abs,math.atan,math.cos,math.floor,math.pi,math.sin,math.sqrt
local bitmap = {
  init = function(self, w, h, value)
    self.w, self.h, self.pixels = w, h, {}
    for y=1,h do self.pixels[y]={} end
    self:clear(value)
  end,
  clear = function(self, value)
    for y=1,self.h do
      for x=1,self.w do
        self.pixels[y][x] = value or "  "
      end
    end
  end,
  set = function(self, x, y, value)
    x,y = floor(x),floor(y)
    if x>0 and y>0 and x<=self.w and y<=self.h then
      self.pixels[y][x] = value or "#"
    end
  end,
  line = function(self, x1, y1, x2, y2, c)
    x1,y1,x2,y2 = floor(x1),floor(y1),floor(x2),floor(y2)
    local dx, sx = abs(x2-x1), x1<x2 and 1 or -1
    local dy, sy = abs(y2-y1), y1<y2 and 1 or -1
    local err = floor((dx>dy and dx or -dy)/2)
    while(true) do
      self:set(x1, y1, c)
      if (x1==x2 and y1==y2) then break end
      if (err > -dx) then
        err, x1 = err-dy, x1+sx
        if (x1==x2 and y1==y2) then
          self:set(x1, y1, c)
          break
        end
      end
      if (err < dy) then
        err, y1 = err+dx, y1+sy
      end
    end
  end,
  render = function(self)
    for y=1,self.h do
      print(table.concat(self.pixels[y]))
    end
  end,
}
screen = {
  clear = function()
    os.execute("cls") -- or? os.execute("clear"), or? io.write("\027[2J\027[H"), or etc?
  end,
}
local camera = { fl = 2.5 }
local L = 0.5
local cube = {
  verts = { {L,L,L}, {L,-L,L}, {-L,-L,L}, {-L,L,L}, {L,L,-L}, {L,-L,-L}, {-L,-L,-L}, {-L,L,-L} },
  edges = { {1,2}, {2,3}, {3,4}, {4,1}, {5,6}, {6,7}, {7,8}, {8,5}, {1,5}, {2,6}, {3,7}, {4,8} },
  rotate = function(self, rx, ry)
    local cx,sx = cos(rx),sin(rx)
    local cy,sy = cos(ry),sin(ry)
    for i,v in ipairs(self.verts) do
      local x,y,z = v[1],v[2],v[3]
      v[1], v[2], v[3] = x*cx-z*sx, y*cy-x*sx*sy-z*cx*sy, x*sx*cy+y*sy+z*cx*cy
    end
  end,
}
local renderer = {
  render = function(self, shape, camera, bitmap)
    local fl = camera.fl
    local ox, oy = bitmap.w/2, bitmap.h/2
    local mx, my = bitmap.w/2, bitmap.h/2
    local rpverts = {}
    for i,v in ipairs(shape.verts) do
      local x,y,z = v[1],v[2],v[3]
      local px = ox + mx * (fl*x)/(fl-z)
      local py = oy + my * (fl*y)/(fl-z)
      rpverts[i] = { px,py }
    end
    for i,e in ipairs(shape.edges) do
      local v1, v2 = rpverts[e[1]], rpverts[e[2]]
      bitmap:line( v1[1], v1[2], v2[1], v2[2], "██" )
    end
  end
}
--
bitmap:init(40,40)
cube:rotate(pi/4, atan(sqrt(2)))
for i=1,60 do
  cube:rotate(pi/60,0)
  bitmap:clear("··")
  renderer:render(cube, camera, bitmap)
  screen:clear()
  bitmap:render()
end


Draw a sphere

{{requires|Graphics}}

;Task:
Draw a sphere.

The sphere can be represented graphically, or in ASCII art, depending on the language capabilities.

Either static or rotational projection is acceptable for this task.

;Related tasks:
* draw a cuboid
* draw a rotating cube
* write language name in 3D ASCII
* draw a Deathstar

Solution:
require ("math")

shades = {'.', ':', '!', '*', 'o', 'e', '&', '#', '%', '@'}

function normalize (vec)
    len = math.sqrt(vec[1]^2 + vec[2]^2 + vec[3]^2)
    return {vec[1]/len, vec[2]/len, vec[3]/len}
end

light = normalize{30, 30, -50}

function dot (vec1, vec2)
    d = vec1[1]*vec2[1] + vec1[2]*vec2[2] + vec1[3]*vec2[3]
    return d < 0 and -d or 0
end

function draw_sphere (radius, k, ambient)
    for i = math.floor(-radius),-math.floor(-radius) do
        x = i + .5
        local line = ''
        for j = math.floor(-2*radius),-math.floor(-2*radius) do
            y = j / 2 + .5
            if x^2 + y^2 <= radius^2 then
                vec = normalize{x, y, math.sqrt(radius^2 - x^2 - y^2)}
                b = dot(light,vec) ^ k + ambient
                intensity = math.floor ((1 - b) * #shades)
                line = line .. (shades[intensity] or shades[1])
            else
                line = line .. ' '
            end
        end
        print (line)
    end
end

draw_sphere (20, 4, 0.1)
draw_sphere (10, 2, 0.4)


Dutch national flag problem

The Dutch national flag is composed of three coloured bands in the order:
::*   red     (top)
::*   then white,   and
::*   lastly blue   (at the bottom).

The problem posed by Edsger Dijkstra is:
:Given a number of red, blue and white balls in random order, arrange them in the order of the colours in the Dutch national flag.
When the problem was first posed, Dijkstra then went on to successively refine a solution, minimising the number of swaps and the number of times the colour of a ball needed to determined and restricting the balls to end in an array, ...

;Task
# Generate a randomized order of balls ''ensuring that they are not in the order of the Dutch national flag''.
# Sort the balls in a way idiomatic to your language.
# Check the sorted balls ''are'' in the order of the Dutch national flag.

;C.f.:
* Dutch national flag problem
* Probabilistic analysis of algorithms for the Dutch national flag problem by Wei-Mei Chen. (pdf)

Solution:
-- "1. Generate a randomized order of balls.."
math.randomseed(os.time())
N, balls, colors = 10, {}, { "red", "white", "blue" }
for i = 1, N do balls[i] = colors[math.random(#colors)] end
-- "..ensuring that they are not in the order of the Dutch national flag."
order = { red=1, white=2, blue=3 }
function issorted(t)
  for i = 2, #t do
    if order[t[i]] < order[t[i-1]] then return false end
  end
  return true
end
local function shuffle(t)
  for i = #t, 2, -1 do
    local j = math.random(i)
    t[i], t[j] = t[j], t[i]
  end
end
while issorted(balls) do shuffle(balls) end
print("RANDOM:  "..table.concat(balls,","))

-- "2. Sort the balls in a way idiomatic to your language."
table.sort(balls, function(a, b) return order[a] < order[b] end)

-- "3. Check the sorted balls are in the order of the Dutch national flag."
print("SORTED:  "..table.concat(balls,","))
print(issorted(balls) and "Properly sorted." or "IMPROPERLY SORTED!!")


Eban numbers

Definition:
An   '''eban'''   number is a number that has no letter    '''e'''    in it when the number is spelled in English.

Or more literally,   spelled numbers that contain the letter   '''e'''   are banned.

The American version of spelling numbers will be used here   (as opposed to the British).

'''2,000,000,000'''   is two billion,   ''not''   two milliard.

Only numbers less than   '''one sextillion'''   ('''1021''')   will be considered in/for this task.

This will allow optimizations to be used.

;Task:
:::*   show all eban numbers   <=   '''1,000'''   (in a horizontal format),                   and a count
:::*   show all eban numbers between   '''1,000'''   and   '''4,000'''   (inclusive),   and a count
:::*   show a count of all eban numbers up and including            '''10,000'''
:::*   show a count of all eban numbers up and including                '''100,000'''
:::*   show a count of all eban numbers up and including                   '''1,000,000'''
:::*   show a count of all eban numbers up and including                      '''10,000,000'''
:::*   show all output here.

;See also:
:*   The MathWorld entry:    eban numbers.
:*   The OEIS      entry:   A6933,                eban numbers.
:*   [[Number names]].

Solution:
function makeInterval(s,e,p)
    return {start=s, end_=e, print_=p}
end

function main()
    local intervals = {
        makeInterval(   2,       1000, true),
        makeInterval(1000,       4000, true),
        makeInterval(   2,      10000, false),
        makeInterval(   2,    1000000, false),
        makeInterval(   2,   10000000, false),
        makeInterval(   2,  100000000, false),
        makeInterval(   2, 1000000000, false)
    }
    for _,intv in pairs(intervals) do
        if intv.start == 2 then
            print("eban numbers up to and including " .. intv.end_ .. ":")
        else
            print("eban numbers between " .. intv.start .. " and " .. intv.end_ .. " (inclusive)")
        end

        local count = 0
        for i=intv.start,intv.end_,2 do
            local b = math.floor(i / 1000000000)
            local r = i % 1000000000
            local m = math.floor(r / 1000000)
            r = i % 1000000
            local t = math.floor(r / 1000)
            r = r % 1000
            if m >= 30 and m <= 66 then m = m % 10 end
            if t >= 30 and t <= 66 then t = t % 10 end
            if r >= 30 and r <= 66 then r = r % 10 end
            if b == 0 or b == 2 or b == 4 or b == 6 then
                if m == 0 or m == 2 or m == 4 or m == 6 then
                    if t == 0 or t == 2 or t == 4 or t == 6 then
                        if r == 0 or r == 2 or r == 4 or r == 6 then
                            if intv.print_ then io.write(i .. " ") end
                            count = count + 1
                        end
                    end
                end
            end
        end

        if intv.print_ then
            print()
        end
        print("count = " .. count)
        print()
    end
end

main()


Egyptian division

Egyptian division is a method of dividing integers using addition and
doubling that is similar to the algorithm of [[Ethiopian multiplication]]

'''Algorithm:'''

Given two numbers where the '''dividend''' is to be divided by the '''divisor''':

# Start the construction of a table of two columns: '''powers_of_2''', and '''doublings'''; by a first row of a 1 (i.e. 2^0) in the first column and 1 times the divisor in the first row second column.
# Create the second row with columns of 2 (i.e 2^1), and 2 * divisor in order.
# Continue with successive i'th rows of 2^i and 2^i * divisor.
# Stop adding rows, and keep only those rows, where 2^i * divisor is less than or equal to the dividend.
# We now assemble two separate sums that both start as zero, called here '''answer''' and '''accumulator'''
# Consider each row of the table, in the ''reverse'' order of its construction.
# If the current value of the accumulator added to the doublings cell would be less than or equal to the dividend then add it to the accumulator, as well as adding the powers_of_2 cell value to the answer.
# When the first row has been considered as above, then the integer division of dividend by divisor is given by answer. (And the remainder is given by the absolute value of accumulator - dividend).

'''Example: 580 / 34'''

''' Table creation: '''

::: {| class="wikitable"
! powers_of_2
! doublings
|-
| 1
| 34
|-
| 2
| 68
|-
| 4
| 136
|-
| 8
| 272
|-
| 16
| 544
|}

''' Initialization of sums: '''

::: {| class="wikitable"
! powers_of_2
! doublings
! answer
! accumulator
|-
| 1
| 34
|

|

|-
| 2
| 68
|

|

|-
| 4
| 136
|

|

|-
| 8
| 272
|

|

|-
| 16
| 544
|

|

|-
|
|
| 0
| 0
|}

''' Considering table rows, bottom-up: '''

When a row is considered it is shown crossed out if it is not accumulated, or '''bold''' if the row causes summations.

::: {| class="wikitable"
! powers_of_2
! doublings
! answer
! accumulator
|-
| 1
| 34
|

|

|-
| 2
| 68
|

|

|-
| 4
| 136
|

|

|-
| 8
| 272
|

|

|-
| '''16'''
| '''544'''
| 16
| 544
|}

::: {| class="wikitable"
! powers_of_2
! doublings
! answer
! accumulator
|-
| 1
| 34
|

|

|-
| 2
| 68
|

|

|-
| 4
| 136
|

|

|-
| 8
| 272
| 16
| 544
|-
| '''16'''
| '''544'''
|

|

|}

::: {| class="wikitable"
! powers_of_2
! doublings
! answer
! accumulator
|-
| 1
| 34
|

|

|-
| 2
| 68
|

|

|-
| 4
| 136
| 16
| 544
|-
| 8
| 272
|

|

|-
| '''16'''
| '''544'''
|

|

|}

::: {| class="wikitable"
! powers_of_2
! doublings
! answer
! accumulator
|-
| 1
| 34
|

|

|-
| 2
| 68
| 16
| 544
|-
| 4
| 136
|

|

|-
| 8
| 272
|

|

|-
| '''16'''
| '''544'''
|

|

|}

::: {| class="wikitable"
! powers_of_2
! doublings
! answer
! accumulator
|-
| '''1'''
| '''34'''
| 17
| 578
|-
| 2
| 68
|

|

|-
| 4
| 136
|

|

|-
| 8
| 272
|

|

|-
| '''16'''
| '''544'''
|

|

|}

;Answer:
So 580 divided by 34 using the Egyptian method is '''17''' remainder (578 - 580) or '''2'''.

;Task:
The task is to create a function that does Egyptian division. The function should
closely follow the description above in using a list/array of powers of two, and
another of doublings.

* Functions should be clear interpretations of the algorithm.
* Use the function to divide 580 by 34 and show the answer '''here, on this page'''.

;Related tasks:
:*   Egyptian fractions

;References:
:*   Egyptian Number System

Solution:
function egyptian_divmod(dividend,divisor)
    local pwrs, dbls = {1}, {divisor}
    while dbls[#dbls] <= dividend do
        table.insert(pwrs, pwrs[#pwrs] * 2)
        table.insert(dbls, pwrs[#pwrs] * divisor)
    end
    local ans, accum = 0, 0

    for i=#pwrs-1,1,-1 do
        if accum + dbls[i] <= dividend then
            accum = accum + dbls[i]
            ans = ans + pwrs[i]
        end
    end

    return ans, math.abs(accum - dividend)
end

local i, j = 580, 34
local d, m = egyptian_divmod(i, j)
print(i.." divided by "..j.." using the Egyptian method is "..d.." remainder "..m)


Elementary cellular automaton

An '''cellular automaton where there are two possible states (labeled 0 and 1) and the rule to determine the state of a cell in the next generation depends only on the current state of the cell and its two immediate neighbors.  Those three values can be encoded with three bits.

The rules of evolution are then encoded with eight bits indicating the outcome of each of the eight possibilities 111, 110, 101, 100, 011, 010, 001 and 000 in this order.  Thus for instance the rule 13 means that a state is updated to 1 only in the cases 011, 010 and 000, since 13 in binary is 0b00001101.

;Task:
Create a subroutine, program or function that allows to create and visualize the evolution of any of the 256 possible elementary cellular automaton of arbitrary space length and for any given initial state.  You can demonstrate your solution with any automaton of your choice.

The space state should ''wrap'':  this means that the left-most cell should be considered as the right neighbor of the right-most cell, and reciprocally.

This task is basically a generalization of [[one-dimensional cellular automata]].

;See also
* Cellular automata (natureofcode.com)

Solution:
local CA = {
  state = "..............................#..............................",
  bstr = { [0]="...", "..#", ".#.", ".##", "#..", "#.#", "##.", "###" },
  new = function(self, rule)
    local inst = setmetatable({rule=rule}, self)
    for b = 0,7 do
      inst[inst.bstr[b]] = rule%2==0 and "." or "#"
      rule = math.floor(rule/2)
    end
    return inst
  end,
  evolve = function(self)
    local n, state, newstate = #self.state, self.state, ""
    for i = 1,n do
      local nbhd = state:sub((i+n-2)%n+1,(i+n-2)%n+1) .. state:sub(i,i) .. state:sub(i%n+1,i%n+1)
      newstate = newstate .. self[nbhd]
    end
    self.state = newstate
  end,
}
CA.__index = CA
ca = { CA:new(18), CA:new(30), CA:new(73), CA:new(129) }
for i = 1, 63 do
  print(string.format("%-66s%-66s%-66s%-61s", ca[1].state, ca[2].state, ca[3].state, ca[4].state))
  for j = 1, 4 do ca[j]:evolve() end
end


Empty directory

Starting with a path to some directory, determine whether the directory is empty.

An empty directory contains no files nor subdirectories.
With [[Unix]] or [[Windows]] systems, every directory contains an entry for "." and almost every directory contains ".." (except for a root directory); an empty directory contains no other entries.

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

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


Empty string

Languages may have features for dealing specifically with empty strings
(those containing no characters).

;Task:
::*   Demonstrate how to assign an empty string to a variable.
::*   Demonstrate how to check that a string is empty.
::*   Demonstrate how to check that a string is not empty.

Solution:
-- create an empty string 3 different ways
str = ""
str = ''
str = [[]]

-- test for empty string
if str == "" then
  print "The string is empty"
end

-- test for nonempty string
if str ~= "" then
  print "The string is not empty"
end

-- several different ways to check the string's length
if string.len(str) == 0 then
  print "The library function says the string is empty."
end
if str:len() == 0 then
  print "The method call says the string is empty."
end
if #str == 0 then
  print "The unary operator says the string is empty."
end


Entropy/Narcissist

Write a computer program that computes and shows its own   [[entropy]].

;Related Tasks:
:*   [[Fibonacci_word]]
:*   [[Entropy]]

Solution:
function getFile (filename)
    local inFile = io.open(filename, "r")
    local fileContent = inFile:read("*all")
    inFile:close()
    return fileContent
end

function log2 (x) return math.log(x) / math.log(2) end

function entropy (X)
    local N, count, sum, i = X:len(), {}, 0
    for char = 1, N do
        i = X:sub(char, char)
        if count[i] then
            count[i] = count[i] + 1
        else
            count[i] = 1
        end
    end
    for n_i, count_i in pairs(count) do
        sum = sum + count_i / N * log2(count_i / N)
    end
    return -sum
end

print(entropy(getFile(arg[0])))


Equilibrium index

An equilibrium index of a sequence is an index into the sequence such that the sum of elements at lower indices is equal to the sum of elements at higher indices.

For example, in a sequence   A:

:::::   A_0 = -7
:::::   A_1 =  1
:::::   A_2 =  5
:::::   A_3 =  2
:::::   A_4 = -4
:::::   A_5 =  3
:::::   A_6 =  0

3   is an equilibrium index, because:

:::::   A_0 + A_1 + A_2 = A_4 + A_5 + A_6

6   is also an equilibrium index, because:

:::::   A_0 + A_1 + A_2 + A_3 + A_4 + A_5 = 0

(sum of zero elements is zero)

7   is not an equilibrium index, because it is not a valid index of sequence A.

;Task;
Write a function that, given a sequence, returns its equilibrium indices (if any).

Assume that the sequence may be very long.

Solution:
function array_sum(t)
   assert(type(t) == "table", "t must be a table!")
   local sum = 0
   for i=1, #t do sum = sum + t[i] end
   return sum
end

function equilibrium_index(t)
   assert(type(t) == "table", "t must be a table!")
   local left, right, ret = 0, array_sum(t), -1
   for i,j in pairs(t) do
      right = right - j
      if left == right then
	 ret = i
	 break
      end
      left = left + j
   end
   return ret
end

print(equilibrium_index({-7, 1, 5, 2, -4, 3, 0}))


Esthetic numbers

An '''esthetic number''' is a positive integer where every adjacent digit differs from its neighbour by 1.

;E.G.

:* '''12''' is an esthetic number. One and two differ by 1.

:* '''5654''' is an esthetic number. Each digit is exactly 1 away from its neighbour.

:* '''890''' is '''not''' an esthetic number. Nine and zero differ by 9.

These examples are nominally in base 10 but the concept extends easily to numbers in other bases. Traditionally, single digit numbers ''are'' included in esthetic numbers; zero may or may not be. For our purposes, for this task, do not include zero (0) as an esthetic number. Do not include numbers with leading zeros.

Esthetic numbers are also sometimes referred to as stepping numbers.

;Task

:* Write a routine (function, procedure, whatever) to find esthetic numbers in a given base.

:* Use that routine to find esthetic numbers in bases '''2''' through '''16''' and display, here on this page, the esthectic numbers from index '''(base x 4)''' through index '''(base x 6)''', inclusive. (E.G. for base 2: 8th through 12th, for base 6: 24th through 36th, etc.)

:* Find and display, here on this page, the '''base 10''' esthetic numbers with a magnitude between '''1000''' and '''9999'''.

:* Stretch: Find and display, here on this page, the '''base 10''' esthetic numbers with a magnitude between '''1.0e8''' and '''1.3e8'''.

;Related task:
*   numbers with equal rises and falls

;See also:
:;*OEIS A033075 - Positive numbers n such that all pairs of consecutive decimal digits differ by 1
:;*Numbers Aplenty - Esthetic numbers
:;*Geeks for Geeks - Stepping numbers

Solution:
function to(n, b)
    local BASE = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    if n == 0 then
        return "0"
    end

    local ss = ""
    while n > 0 do
        local idx = (n % b) + 1
        n = math.floor(n / b)
        ss = ss .. BASE:sub(idx, idx)
    end
    return string.reverse(ss)
end

function isEsthetic(n, b)
    function uabs(a, b)
        if a < b then
            return b - a
        end
        return a - b
    end

    if n == 0 then
        return false
    end
    local i = n % b
    n = math.floor(n / b)
    while n > 0 do
        local j = n % b
        if uabs(i, j) ~= 1 then
            return false
        end
        n = math.floor(n / b)
        i = j
    end
    return true
end

function listEsths(n, n2, m, m2, perLine, all)
    local esths = {}
    function dfs(n, m, i)
        if i >= n and i <= m then
            table.insert(esths, i)
        end
        if i == 0 or i > m then
            return
        end
        local d = i % 10
        local i1 = 10 * i + d - 1
        local i2 = i1 + 2
        if d == 0 then
            dfs(n, m, i2)
        elseif d == 9 then
            dfs(n, m, i1)
        else
            dfs(n, m, i1)
            dfs(n, m, i2)
        end
    end

    for i=0,9 do
        dfs(n2, m2, i)
    end
    local le = #esths
    print(string.format("Base 10: %s esthetic numbers between %s and %s:", le, math.floor(n), math.floor(m)))
    if all then
        for c,esth in pairs(esths) do
            io.write(esth.." ")
            if c % perLine == 0 then
                print()
            end
        end
        print()
    else
        for i=1,perLine do
            io.write(esths[i] .. " ")
        end
        print("\n............")
        for i = le - perLine + 1, le do
            io.write(esths[i] .. " ")
        end
        print()
    end
    print()
end

for b=2,16 do
    print(string.format("Base %d: %dth to %dth esthetic numbers:", b, 4 * b, 6 * b))
    local n = 1
    local c = 0
    while c < 6 * b do
        if isEsthetic(n, b) then
            c = c + 1
            if c >= 4 * b then
                io.write(to(n, b).." ")
            end
        end
        n = n + 1
    end
    print()
end
print()

-- the following all use the obvious range limitations for the numbers in question
listEsths(1000, 1010, 9999, 9898, 16, true)
listEsths(1e8, 101010101, 13 * 1e7, 123456789, 9, true)
listEsths(1e11, 101010101010, 13 * 1e10, 123456789898, 7, false)
listEsths(1e14, 101010101010101, 13 * 1e13, 123456789898989, 5, false)
listEsths(1e17, 101010101010101010, 13 * 1e16, 123456789898989898, 4, false)


Euler's identity

{{Wikipedia|Euler's_identity}}

In mathematics, ''Euler's identity'' is the equality:

                ei\pi + 1 = 0

where

    e is Euler's number, the base of natural logarithms,
    ''i'' is the imaginary unit, which satisfies ''i''2 = -1, and
    \pi is pi, the ratio of the circumference of a circle to its diameter.

Euler's identity is often cited as an example of deep mathematical beauty. Three of the basic arithmetic operations occur exactly once each: addition, multiplication, and exponentiation. The identity also links five fundamental mathematical constants:

    The number 0.
    The number 1.
    The number \pi (\pi = 3.14159+),
    The number e (e = 2.71828+), which occurs widely in mathematical analysis.
    The number ''i'', the imaginary unit of the complex numbers.

;Task
Show in your language that Euler's identity is true. As much as possible and practical, mimic the Euler's identity equation.

Most languages are limited to IEEE 754 floating point calculations so will have some error in the calculation.

If that is the case, or there is some other limitation, show
that ei\pi + 1 is ''approximately'' equal to zero and
show the amount of error in the calculation.

If your language is capable of symbolic calculations, show
that ei\pi + 1 is ''exactly'' equal to zero for bonus kudos points.

Solution:
local c = {
  new = function(s,r,i) s.__index=s return setmetatable({r=r, i=i}, s) end,
  add = function(s,o) return s:new(s.r+o.r, s.i+o.i) end,
  exp = function(s) local e=math.exp(s.r) return s:new(e*math.cos(s.i), e*math.sin(s.i)) end,
  mul = function(s,o) return s:new(s.r*o.r+s.i*o.i, s.r*o.i+s.i*o.r) end
}
local i = c:new(0, 1)
local pi = c:new(math.pi, 0)
local one = c:new(1, 0)
local zero = i:mul(pi):exp():add(one)
print(string.format("e^(i*pi)+1 is approximately zero:  %.18g%+.18gi", zero.r, zero.i))


Euler's sum of powers conjecture

There is a conjecture in mathematics that held for over two hundred years before it was disproved by the finding of a counterexample in 1966 by Lander and Parkin.

This conjecture is called Euler's sum of powers conjecture and can be stated as such:

:At least k positive kth powers are required to sum to a kth power, except for the trivial case of one kth power: yk = yk.

In 1966, Leon J. Lander and Thomas R. Parkin used a brute-force search on a CDC 6600 computer restricting numbers to those less than 250.

The task consists in writing a program to search for an integer solution of x_0^5 + x_1^5 + x_2^5 + x_3^5 = y^5 where all x_i and y are distinct integers between 0 and 250 (exclusive). Show an answer here.

Related tasks are:
* [[Pythagorean quadruples]].
* [[Pythagorean triples]].

Solution:
-- Fast table search (only works if table values are in order)
function binarySearch (t, n)
    local start, stop, mid = 1, #t
    while start < stop do
        mid = math.floor((start + stop) / 2)
        if n == t[mid] then
            return mid
        elseif n < t[mid] then
            stop = mid - 1
        else
            start = mid + 1
        end
    end
    return nil
end

-- Test Euler's sum of powers conjecture
function euler (limit)
    local pow5, sum = {}
    for i = 1, limit do pow5[i] = i^5 end
    for x0 = 1, limit do
        for x1 = 1, x0 do
            for x2 = 1, x1 do
                for x3 = 1, x2 do
                    sum = pow5[x0] + pow5[x1] + pow5[x2] + pow5[x3]
                    if binarySearch(pow5, sum) then
                        print(x0 .. "^5 + " .. x1 .. "^5 + " .. x2 .. "^5 + " .. x3 .. "^5 = " .. sum^(1/5) .. "^5")
                        return true
                    end
                end
            end
        end
    end
    return false
end

-- Main procedure
if euler(249) then
    print("Time taken: " .. os.clock() .. " seconds")
else
    print("Looks like he was right after all...")
end


Even or odd

Test whether an integer is even or odd.

There is more than one way to solve this task:

* Use the even and odd predicates, if the language provides them.
* Check the least significant digit. With binary integers, ''i iff ''i'' is even, or equals 1 iff ''i'' is odd.
* Divide ''i'' by 2. The remainder equals 0 iff ''i'' is even. The remainder equals +1 or -1 iff ''i'' is odd.
* Use modular congruences:
** ''i''  0 (mod 2) iff ''i'' is even.
** ''i''  1 (mod 2) iff ''i'' is odd.

Solution:
-- test for even number
if n % 2 == 0 then
  print "The number is even"
end

-- test for odd number
if not (n % 2 == 0) then
  print "The number is odd"
end


Evolutionary algorithm

Starting with:
* The target string: "METHINKS IT IS LIKE A WEASEL".
* An array of random characters chosen from the set of upper-case letters together with the space, and of the same length as the target string. (Call it the parent).
* A fitness function that computes the 'closeness' of its argument to the target string.
* A mutate function that given a string and a mutation rate returns a copy of the string, with some characters probably mutated.
* While the parent is not yet the target:
:* copy the parent C times, each time allowing some random probability that another character might be substituted using mutate.
:* Assess the fitness of the parent and all the copies to the target and make the most fit string the new parent, discarding the others.
:* repeat until the parent converges, (hopefully), to the target.

;See also:
*   Wikipedia entry:   Weasel algorithm.
*   Wikipedia entry:   Evolutionary algorithm.

Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions

A cursory examination of a few of the solutions reveals that the instructions have not been followed rigorously in some solutions. Specifically,
* While the parent is not yet the target:
:* copy the parent C times, each time allowing some random probability that another character might be substituted using mutate.

Note that some of the the solutions given retain characters in the mutated string that are ''correct'' in the target string. However, the instruction above does not state to retain any of the characters while performing the mutation. Although some may believe to do so is implied from the use of "converges"

 (:* repeat until the parent converges, (hopefully), to the target.

Strictly speaking, the new parent should be selected from the new pool of mutations, and then the new parent used to generate the next set of mutations with parent characters getting retained only by ''not'' being mutated. It then becomes possible that the new set of mutations has no member that is fitter than the parent!

As illustration of this error, the code for 8th has the following remark.

 Create a new string based on the TOS, '''changing randomly any characters which
 don't already match the target''':

''NOTE:'' this has been changed, the 8th version is completely random now

Clearly, this algo will be applying the mutation function only to the parent characters that don't match to the target characters!

To ensure that the new parent is never less fit than the prior parent, both the parent and all of the latest mutations are subjected to the fitness test to select the next parent.

Solution:
local target = "METHINKS IT IS LIKE A WEASEL"
local alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
local c, p = 100, 0.06

local function fitness(s)
	local score = #target
	for i = 1,#target do
		if s:sub(i,i) == target:sub(i,i) then score = score - 1 end
	end
	return score
end

local function mutate(s, rate)
	local result, idx = ""
	for i = 1,#s do
		if math.random() < rate then
			idx = math.random(#alphabet)
			result = result .. alphabet:sub(idx,idx)
		else
			result = result .. s:sub(i,i)
		end
	end
	return result, fitness(result)
end

local function randomString(len)
	local result, idx = ""
	for i = 1,len do
		idx = math.random(#alphabet)
		result = result .. alphabet:sub(idx,idx)
	end
	return result
end

local function printStep(step, s, fit)
	print(string.format("%04d: ", step) .. s .. " [" .. fit .."]")
end

math.randomseed(os.time())
local parent = randomString(#target)
printStep(0, parent, fitness(parent))

local step = 0
while parent ~= target do
	local bestFitness, bestChild, child, fitness = #target + 1
	for i = 1,c do
		child, fitness = mutate(parent, p)
		if fitness < bestFitness then bestFitness, bestChild = fitness, child end
	end
	parent, step = bestChild, step + 1
	printStep(step, parent, bestFitness)
end


Executable library

The general idea behind an executable library is to create a library
that when used as a library does one thing;
but has the ability to be run directly via command line.
Thus the API comes with a CLI in the very same source code file.

'''Task detail'''

* Create a library/module/dll/shared object/... for a programming language that contains a function/method called hailstone that is a function taking a positive integer and returns the [[Hailstone sequence]] for that number.

* The library, when executed directly should satisfy the remaining requirements of the [[Hailstone sequence]] task:
:: 2.  Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
:: 3.  Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.

* Create a second executable to calculate the following:
** Use the library's hailstone function, in the standard manner, (or document how this use deviates from standard use of a library), together with extra code in this executable, to find the hailstone length returned most often for 1 <= n < 100,000.

* Explain any extra setup/run steps needed to complete the task.

'''Notes:'''
* It is assumed that for a language that overwhelmingly ships in a compiled form, such as C, the library must also be an executable and the compiled user of that library is to do so without changing the compiled library. I.e. the compile tool-chain is assumed ''not'' to be present in the runtime environment.
* Interpreters are present in the runtime environment.

Solution:
#!/usr/bin/env luajit
bit32=bit32 or bit
local lib={
	hailstone=function(n)
		local seq={n}
		while n>1 do
			n=bit32.band(n,1)==1 and 3*n+1 or n/2
			seq[#seq+1]=n
		end
		return seq
	end
}

if arg[0] and arg[0]:match("hailstone.lua") then
	local function printf(fmt, ...) io.write(string.format(fmt, ...)) end
	local seq=lib.hailstone(27)
	printf("27 has %d numbers in sequence:\n",#seq)
	for _,i in ipairs(seq) do
		printf("%d ", i)
	end
	printf("\n")
else
	return lib
end


Execute Brain****

Brainf***}}
RCBF is a set of [[Brainf*** compilers and interpreters written for Rosetta Code in a variety of languages.

Below are links to each of the versions of RCBF.

An implementation need only properly implement the following instructions:
{| class="wikitable"
!Command
!Description
|-
| style="text-align:center"| > || Move the pointer to the right
|-
| style="text-align:center"| < || Move the pointer to the left
|-
| style="text-align:center"| + || Increment the memory cell under the pointer
|-
| style="text-align:center"| - || Decrement the memory cell under the pointer
|-
| style="text-align:center"| . || Output the character signified by the cell at the pointer
|-
| style="text-align:center"| , || Input a character and store it in the cell at the pointer
|-
| style="text-align:center"| [ || Jump past the matching ] if the cell under the pointer is 0
|-
| style="text-align:center"| ] || Jump back to the matching [ if the cell under the pointer is nonzero
|}
Any cell size is allowed,   EOF    (End-O-File)   support is optional, as is whether you have bounded or unbounded memory.

Solution:
local funs = {
['>'] = 'ptr = ptr + 1; ',
['<'] = 'ptr = ptr - 1; ',
['+'] = 'mem[ptr] = mem[ptr] + 1; ',
['-'] = 'mem[ptr] = mem[ptr] - 1; ',
['['] = 'while mem[ptr] ~= 0 do ',
[']'] = 'end; ',
['.'] = 'io.write(string.char(mem[ptr])); ',
[','] = 'mem[ptr] = (io.read(1) or "\\0"):byte(); ',
}

local prog = [[
  local mem = setmetatable({}, { __index = function() return 0 end})
  local ptr = 1
]]

local source = io.read('*all')

for p = 1, #source do
  local snippet = funs[source:sub(p,p)]
  if snippet then prog = prog .. snippet end
end

load(prog)()


Execute Computer/Zero

Computer/zero Assembly}}

;Task:
Create a [[Computer/zero Assembly emulator. You may consider this webpage as a reference implementation. Output the results of the sample programs "2+2" and "7*8" found there.

:*   The virtual machine "bytecode" needs to be able to modify itself (or at least act as though it can) while the virtual machine is running, to be consistent with the reference implementation.
:*   For output, it is sufficient to have the implementation of the STP opcode return the accumulator to your actual language, and then use your standard printing routines to output it.

;Bonus Points: Run all 5 sample programs at the aforementioned website and output their results.

Solution:
vmz = {
  pc = 0,
  acc = 0,
  mem = { [0]=0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0 },
  b2oa = function(byte) return math.floor(byte / 32), byte % 32 end,
  boot = function(self) self.pc, self.acc = 0, 0 for pc=0,31 do self.mem[pc]=0 end return self end,
  load = function(self, bytes) for pc = 0, 31 do self.mem[pc]=bytes[pc] or 0 end return self end,
  clam = function(n) if n<0 then n=n+256 elseif n>255 then n=n-256 end return n end,
  opfn = {[0]=
    function(self,addr) self.pc=self.pc+1 return true end, -- NOP
    function(self,addr) self.acc=self.mem[addr] self.pc=self.pc+1 return true end, -- LDA
    function(self,addr) self.mem[addr]=self.acc self.pc=self.pc+1 return true end, -- STA
    function(self,addr) self.acc=self.clam(self.acc+self.mem[addr]) self.pc=self.pc+1 return true end, -- ADD
    function(self,addr) self.acc=self.clam(self.acc-self.mem[addr]) self.pc=self.pc+1 return true end, -- SUB
    function(self,addr) if (self.acc==0) then self.pc=addr else self.pc=self.pc+1 end return true end, -- BRZ
    function(self,addr) self.pc=addr return true end, -- JMP
    function(self,addr) self.pc=self.pc+1 return false end, -- STP
  },
  step = function(self)
    local oper, addr = self.b2oa(self.mem[self.pc])
    return self.opfn[oper](self,addr)
  end,
  exec = function(self)
    while self.pc < 32 and self:step() do end
    return self
  end,
}
-- object code derived from js sim code
print("2 + 2 = " .. vmz:boot():load({[0]=35,100,224,2,2}):exec().acc)
print("7 x 8 = " .. vmz:boot():load({[0]=44,106,76,43,141,75,168,192,44,224,8,7,0,1}):exec().acc)


Execute HQ9+

Implement a   ''' [[HQ9+]] '''   interpreter or compiler.

Solution:
function runCode( code )
    local acc, lc = 0
    for i = 1, #code do
        lc = code:sub( i, i ):upper()
        if lc == "Q" then print( lc )
        elseif lc == "H" then print( "Hello, World!" )
        elseif lc == "+" then acc = acc + 1
        elseif lc == "9" then
            for j = 99, 1, -1 do
                if j > 1 then
                    print( string.format( "%d bottles of beer on the wall\n%d bottles of beer\nTake one down, pass it around\n%d bottles of beer on the wall\n", j, j, j - 1 ) )
                else
                    print( "1 bottle of beer on the wall\n1 bottle of beer\nTake one down and pass it around\nno more bottles of beer on the wall\n\n"..
                           "No more bottles of beer on the wall\nNo more bottles of beer\n"..
                           "Go to the store and buy some more\n99 bottles of beer on the wall.\n" )
                end
            end
        end
    end
end


Exponentiation order

This task will demonstrate the order of exponentiation   ('''xy''')    when there are multiple exponents.

(Many programming languages,   especially those with extended-precision integer arithmetic,   usually support one of  **, ^, |  or some such for exponentiation.)

;Task requirements
Show the result of a language's evaluation of multiple exponentiation (either as an integer or floating point).

If your language's exponentiation operator is not one of the usual ones, please comment on how to recognize it.

Using whatever operator or syntax your language supports (if any), show the results in three lines (with identification):

::::*   5**3**2
::::*   (5**3)**2
::::*   5**(3**2)

If there are other methods (or formats) of multiple exponentiations, show them as well.

;See also:
* MathWorld entry:   exponentiation

;Related tasks:
*   exponentiation operator
*   arbitrary-precision integers (included)
*   [[Exponentiation with infix operators in (or operating on) the base]]

Solution:
print("5^3^2 = " .. 5^3^2)
print("(5^3)^2 = " .. (5^3)^2)
print("5^(3^2) = " .. 5^(3^2))


Exponentiation with infix operators in (or operating on) the base

(Many programming languages,   especially those with extended-precision integer arithmetic,   usually
support one of  **, ^, |  or some such for exponentiation.)

Some languages treat/honor infix operators when performing exponentiation   (raising
numbers to some power by the language's exponentiation operator,   if the computer
programming language has one).

Other programming languages may make use of the   '''POW'''   or some other BIF
  ('''B'''uilt-'''I'''n '''F'''function),   or some other library service.

If your language's exponentiation operator is not one of the usual ones, please comment on how to recognize it.

This task will deal with the case where there is some form of an   ''infix operator''   operating
in   (or operating on)   the base.

;Example:
A negative five raised to the 3rd power could be specified as:
    -5  ** 3          or as
   -(5) ** 3          or as
   (-5) ** 3          or as something else

(Not all computer programming languages have an exponential operator and/or support these syntax expression(s).

;Task:
:*   compute and display exponentiation with a possible infix operator, whether specified and/or implied/inferred.
:*   Raise the following numbers   (integer or real):
:::*   -5     and
:::*   +5
:*   to the following powers:
:::*   2nd     and
:::*   3rd
:*   using the following expressions   (if applicable in your language):
:::*   -x**p
:::*   -(x)**p
:::*   (-x)**p
:::*   -(x**p)
:*   Show here (on this page) the four (or more) types of symbolic expressions for each number and power.

Try to present the results in the same format/manner as the other programming entries to make any differences apparent.

The variables may be of any type(s) that is/are applicable in your language.

;Related tasks:
*   [[Exponentiation order]]
*   [[Exponentiation operator]]
*   [[Arbitrary-precision integers (included)]]
*   [[Parsing/RPN to infix conversion]]
*   [[Operator precedence]]

;References:
* Wikipedia: Order of operations in Programming languages

Solution:
mathtype = math.type or type -- polyfill <5.3
function test(xs, ps)
  for _,x in ipairs(xs) do
    for _,p in ipairs(ps) do
      print(string.format("%2.f  %7s  %2.f  %7s    %4.f    %4.f    %4.f    %4.f", x, mathtype(x), p, mathtype(p), -x^p, -(x)^p, (-x)^p, -(x^p)))
    end
  end
end
print(" x  type(x)   p  type(p)    -x^p  -(x)^p  (-x)^p  -(x^p)")
print("--  -------  --  -------  ------  ------  ------  ------")
test( {-5.,5.}, {2.,3.} ) -- "float" (or "number" if <5.3)
if math.type then -- if >=5.3
  test( {-5,5}, {2,3} ) -- "integer"
end


Extend your language

{{Control Structures}}Some programming languages allow you to extend the language. While this can be done to a certain degree in most languages (e.g. by using macros), other languages go much further. Most notably in the Forth and Lisp families, programming per se is done by extending the language without any formal distinction between built-in and user-defined elements.

If your language supports it, show how to introduce a new flow control mechanism. A practical and useful example is a four-way branch:

Occasionally, code must be written that depends on ''two'' conditions, resulting in up to four branches (depending on whether both, only the first, only the second, or none of the conditions are "true"). In a C-like language this could look like the following:

   if (condition1isTrue) {
      if (condition2isTrue)
         bothConditionsAreTrue();
      else
         firstConditionIsTrue();
   }
   else if (condition2isTrue)
      secondConditionIsTrue();
   else
      noConditionIsTrue();

Besides being rather cluttered, the statement(s) for 'condition2isTrue' must be written down twice. If 'condition2isTrue' were a lengthy and involved expression, it would be quite unreadable, and the code generated by the compiler might be unnecessarily large.

This can be improved by introducing a new keyword '''if2'''. It is similar to '''if''', but takes two conditional statements instead of one, and up to three 'else' statements. One proposal (in pseudo-C syntax) might be:

   if2 (condition1isTrue) (condition2isTrue)
      bothConditionsAreTrue();
   else1
      firstConditionIsTrue();
   else2
      secondConditionIsTrue();
   else
      noConditionIsTrue();

Pick the syntax which suits your language. The keywords 'else1' and 'else2' are just examples. The new conditional expression should look, nest and behave analogously to the language's built-in 'if' statement.

Solution:
-- Extend your language, in Lua, 6/17/2020 db
-- not to be taken seriously, ridiculous, impractical, esoteric, obscure, arcane ... but it works

-------------------
-- IMPLEMENTATION:
-------------------

function if2(cond1, cond2)
  return function(code)
    code = code:gsub("then2", "[3]=load[[")
    code = code:gsub("else1", "]],[2]=load[[")
    code = code:gsub("else2", "]],[1]=load[[")
    code = code:gsub("neither", "]],[0]=load[[")
    code = "return {" .. code .. "]]}"
    local block, err = load(code)
    if (err) then error("syntax error in if2 statement: "..err) end
    local tab = block()
    tab[(cond1 and 2 or 0) + (cond2 and 1 or 0)]()
  end
end

----------
-- TESTS:
----------

for i = 1, 2 do
  for j = 1, 2 do
    print("i="..i.." j="..j)

    if2 ( i==1, j==1 )[[ then2
      print("both conditions are true")
    else1
      print("first is true, second is false")
    else2
      print("first is false, second is true")
    neither
      print("both conditions are false")
    ]]

  end
end


Extreme floating point values

The IEEE floating point specification defines certain 'extreme' floating point values such as minus zero, -0.0, a value distinct from plus zero; not a number, NaN; and plus and minus infinity.

The task is to use expressions involving other 'normal' floating point values in your language to calculate these, (and maybe other), extreme floating point values in your language and assign them to variables.

Print the values of these variables if possible; and show some arithmetic with these values and variables.

If your language can directly enter these extreme floating point values then show it.

;See also:
*   What Every Computer Scientist Should Know About Floating-Point Arithmetic

;Related tasks:
*   [[Infinity]]
*   [[Detect division by zero]]
*   [[Literals/Floating point]]

Solution:
local inf=math.huge
local minusInf=-math.huge
local NaN=0/0
local negativeZeroSorta=-1E-240


FASTA format

In FASTA.

A FASTA file can contain several strings, each identified by a name marked by a > (greater than) character at the beginning of the line.

;Task:
Write a program that reads a FASTA file such as:

>Rosetta_Example_1
THERECANBENOSPACE
>Rosetta_Example_2
THERECANBESEVERAL
LINESBUTTHEYALLMUST
BECONCATENATED

Solution:
local file = io.open("input.txt","r")
local data = file:read("*a")
file:close()

local output = {}
local key = nil

-- iterate through lines
for line in data:gmatch("(.-)\r?\n") do
	if line:match("%s") then
		error("line contained space")
	elseif line:sub(1,1) == ">" then
		key = line:sub(2)
		-- if key already exists, append to the previous input
		output[key] = output[key] or ""
	elseif key ~= nil then
		output[key] = output[key] .. line
	end
end

-- print result
for k,v in pairs(output) do
	print(k..": "..v)
end


Faces from a mesh

A mesh defining a surface has uniquely numbered vertices, and named,
simple-polygonal faces described usually by an ordered list of edge numbers
going around the face,

For example:
External image of two faces
Rough textual version without edges:

      1
                        17
 7   A
             B

       11
                  23

* A is the triangle (1, 11, 7), or equally (7, 11, 1), going anti-clockwise, or
any of all the rotations of those ordered vertices.
      1

 7   A

       11

* B is the four-sided face (1, 17, 23, 11), or equally (23, 17, 1, 11) or any
of their rotations.
1
                  17

       B

 11
            23

Let's call the above the '''perimeter format''' as it traces around the perimeter.

;A second format:
A separate algorithm returns polygonal faces consisting of a face name and an unordered
set of edge definitions for each face.
* A single edge is described by the vertex numbers at its two ends, always in
ascending order.
* All edges for the face are given, but in an undefined order.

For example face A could be described by the edges (1, 11), (7, 11), and (1, 7)
(The  order of each vertex number in an edge is ascending, but the order in
which the edges are stated is arbitrary).

Similarly face B could be described by the edges (11, 23), (1, 17), (17, 23),
and (1, 11) in arbitrary order of the edges.

Let's call this second format the '''edge format'''.

;Task:
'''1.''' Write a routine to check if two perimeter formatted faces have the same perimeter.  Use it to check if the following pairs of perimeters are the same:
 Q: (8, 1, 3)
 R: (1, 3, 8)

 U: (18, 8, 14, 10, 12, 17, 19)
 V: (8, 14, 10, 12, 17, 19, 18)

'''2.''' Write a routine and use it to transform the following faces from edge to perimeter format.
 E: {(1, 11), (7, 11), (1, 7)}
 F: {(11, 23), (1, 17), (17, 23), (1, 11)}
 G: {(8, 14), (17, 19), (10, 12), (10, 14), (12, 17), (8, 18), (18, 19)}
 H: {(1, 3), (9, 11), (3, 11), (1, 11)}

Show your output here.

Solution:
-- support
function T(t) return setmetatable(t, {__index=table}) end
table.eql = function(t,u) if #t~=#u then return false end for i=1,#t do if t[i]~=u[i] then return false end end return true end
table.rol = function(t,n) local s=T{} for i=1,#t do s[i]=t[(i+n-1)%#t+1] end return s end
table.rev = function(t) local s=T{} for i=1,#t do s[#t-i+1]=t[i] end return s end

-- 1
function pfeq(pf1, pf2)
  if #pf1 ~= #pf2 then return false end -- easy case
  for w = 0,1 do -- exhaustive cases
    local pfw = pf1 -- w:winding
    if w==1 then pfw=pfw:rev() end
    for r = 0,#pfw do
      local pfr = pfw -- r:rotate
      if r>0 then pfr=pfr:rol(r) end
      if pf2:eql(pfr) then return true end
    end
  end
  return false
end

Q = T{8, 1, 3}
R = T{1, 3, 8}
U = T{18, 8, 14, 10, 12, 17, 19}
V = T{8, 14, 10, 12, 17, 19, 18}
print("pfeq(Q,R): ", pfeq(Q, R))
print("pfeq(U,V): ", pfeq(U, V))

-- 2
function ef2pf(ef)
  local pf, hse = T{}, T{} -- hse:hash of sorted edges
  for i,e in ipairs(ef) do table.sort(e) hse[e]=e end
  local function nexte(e)
    if not e then return ef[1] end
    for k,v in pairs(hse) do
      if e[2]==v[1] then return v end
      if e[2]==v[2] then v[1],v[2]=v[2],v[1] return v end
    end
  end
  local e = nexte()
  while e do
    pf[#pf+1] = e[1]
    hse[e] = nil
    e = nexte(e)
  end
  if #pf ~= #ef then pf=T{"failed to convert edge format to perimeter format"} end
  return pf
end

E = {{1, 11}, {7, 11}, {1, 7}}
F = {{11, 23}, {1, 17}, {17, 23}, {1, 11}}
G = {{8, 14}, {17, 19}, {10, 12}, {10, 14}, {12, 17}, {8, 18}, {18, 19}}
H = {{1, 3}, {9, 11}, {3, 11}, {1, 11}}
print("ef2pf(E): ", ef2pf(E):concat(","))
print("ef2pf(F): ", ef2pf(F):concat(","))
print("ef2pf(G): ", ef2pf(G):concat(","))
print("ef2pf(H): ", ef2pf(H):concat(","))


Fairshare between two and more

The [[Thue-Morse]] sequence is a sequence of ones and zeros that if two people
take turns in the given order, the first persons turn for every '0' in the
sequence, the second for every '1'; then this is shown to give a fairer, more
equitable sharing of resources. (Football penalty shoot-outs for example, might
not favour the team that goes first as much if the penalty takers take turns
according to the Thue-Morse sequence and took 2^n penalties)

The Thue-Morse sequence of ones-and-zeroes can be generated by:
:''"When counting in binary, the digit sum modulo 2 is the Thue-Morse sequence"''

;Sharing fairly between two or more:
Use this method:
:''When counting base '''b''', the digit sum modulo '''b''' is the Thue-Morse sequence of fairer sharing between '''b''' people.''

;Task
Counting from zero;   using a function/method/routine to express an integer count in base '''b''',
sum the digits modulo '''b''' to produce the next member of the Thue-Morse fairshare series for '''b''' people.

Show the first 25 terms of the fairshare sequence:
:*   For two people:
:*   For three people
:*   For five people
:*   For eleven people

;Related tasks:
:*   [[Non-decimal radices/Convert]]
:*   [[Thue-Morse]]

;See also:
:*   A010060, A053838, A053840: The On-Line Encyclopedia of Integer Sequences(r) (OEIS(r))

Solution:
function turn(base, n)
    local sum = 0
    while n ~= 0 do
        local re = n % base
        n = math.floor(n / base)
        sum = sum + re
    end
    return sum % base
end

function fairShare(base, count)
    io.write(string.format("Base %2d:", base))
    for i=1,count do
        local t = turn(base, i - 1)
        io.write(string.format(" %2d", t))
    end
    print()
end

function turnCount(base, count)
    local cnt = {}

    for i=1,base do
        cnt[i - 1] = 0
    end

    for i=1,count do
        local t = turn(base, i - 1)
        if cnt[t] ~= nil then
            cnt[t] = cnt[t] + 1
        else
            cnt[t] = 1
        end
    end

    local minTurn = count
    local maxTurn = -count
    local portion = 0
    for _,num in pairs(cnt) do
        if num > 0 then
            portion = portion + 1
        end
        if num < minTurn then
            minTurn = num
        end
        if maxTurn < num then
            maxTurn = num
        end
    end

    io.write(string.format("  With %d people: ", base))
    if minTurn == 0 then
        print(string.format("Only %d have a turn", portion))
    elseif minTurn == maxTurn then
        print(minTurn)
    else
        print(minTurn .. " or " .. maxTurn)
    end
end

function main()
    fairShare(2, 25)
    fairShare(3, 25)
    fairShare(5, 25)
    fairShare(11, 25)

    print("How many times does each get a turn in 50000 iterations?")
    turnCount(191, 50000)
    turnCount(1377, 50000)
    turnCount(49999, 50000)
    turnCount(50000, 50000)
    turnCount(50001, 50000)
end

main()


Farey sequence

The   Farey sequence   ''' ''F''n'''   of order   '''n'''   is the sequence of completely reduced fractions between   '''0'''   and   '''1'''   which, when in lowest terms, have denominators less than or equal to   '''n''',   arranged in order of increasing size.

The   ''Farey sequence''   is sometimes incorrectly called a   ''Farey series''.

Each Farey sequence:
:::*   starts with the value   '''0'''   (zero),   denoted by the fraction      \frac{0}{1}
:::*   ends with the value   '''1'''   (unity),   denoted by the fraction    \frac{1}{1}.

The Farey sequences of orders   '''1'''   to   '''5'''   are:

:::: {\bf\it{F}}_1 = \frac{0}{1}, \frac{1}{1}
:
:::: {\bf\it{F}}_2 = \frac{0}{1}, \frac{1}{2}, \frac{1}{1}
:
:::: {\bf\it{F}}_3 = \frac{0}{1}, \frac{1}{3}, \frac{1}{2}, \frac{2}{3}, \frac{1}{1}
:
:::: {\bf\it{F}}_4 = \frac{0}{1}, \frac{1}{4}, \frac{1}{3}, \frac{1}{2}, \frac{2}{3}, \frac{3}{4}, \frac{1}{1}
:
:::: {\bf\it{F}}_5 = \frac{0}{1}, \frac{1}{5}, \frac{1}{4}, \frac{1}{3}, \frac{2}{5}, \frac{1}{2}, \frac{3}{5}, \frac{2}{3}, \frac{3}{4}, \frac{4}{5}, \frac{1}{1}

;Task
*   Compute and show the Farey sequence for orders   '''1'''   through   '''11'''   (inclusive).
*   Compute and display the   ''number''   of fractions in the Farey sequence for order   '''100'''   through   '''1,000'''   (inclusive)   by hundreds.
*   Show the fractions as    '''n/d'''    (using the solidus [or slash] to separate the numerator from the denominator).

The length   (the number of fractions)   of a Farey sequence asymptotically approaches:

:::::::::::  3 x n2   /   \pi2

;See also:
*    OEIS sequence           A006842 numerators of Farey series of order 1, 2, ***
*    OEIS sequence           A006843 denominators of Farey series of order 1, 2, ***
*    OEIS sequence           A005728 number of fractions in Farey series of order n
*   MathWorld entry          Farey sequence
*   Wikipedia   entry   Farey sequence

Solution:
-- Return farey sequence of order n
function farey (n)
    local a, b, c, d, k = 0, 1, 1, n
    local farTab = {{a, b}}
    while c <= n do
        k = math.floor((n + b) / d)
        a, b, c, d = c, d, k * c - a, k * d - b
        table.insert(farTab, {a, b})
    end
    return farTab
end

-- Main procedure
for i = 1, 11 do
    io.write(i .. ": ")
    for _, frac in pairs(farey(i)) do io.write(frac[1] .. "/" .. frac[2] .. " ") end
    print()
end
for i = 100, 1000, 100 do print(i .. ": " .. #farey(i) .. " items") end