Warning: this is an htmlized version! The original is here, and the conversion rules are here.
-- canvas2.lua
-- Eduardo Ochs, 2010dec28
-- This file: (find-angg "LUA/canvas2.lua")
--    http://angg.twu.net/LUA/canvas2.lua
--    http://angg.twu.net/LUA/canvas2.lua.html

-- «.Class»	(to "Class")

-- (find-es "lua5" "setvbuf")
io.stdout:setvbuf("no")  -- sync errors

-- Basic functions.

string.trim = function (str)
local nspaces = string.reverse(str):match("[ \t]*()") - 1
return string.sub(str, 1, #str - nspaces)
end
str = string.sub(str, 1, len)
if #str < len then str = str .. string.rep(" ", len - #str) end
return str
end
string.replace = function (str, other, pos)
local left = string.sub(str, 1, pos - 1)
if #left < pos - 1 then left = left .. string.rep(" ", pos - #left - 1) end
local right = string.sub(str, pos + #other)
return left .. other .. right
end
table.transpose = function (T)
local TT = {}
for k,v in pairs(T) do TT[v] = k end
return TT
end
table.swaps = function (T, swaps)
if swaps then
for _,ab in ipairs(swaps) do
local a, b = ab[1], ab[2]
T[a], T[b] = T[b], T[a]
end
end
return T
end
table.size = function (T)
for i=1,10000000 do if T[i] == nil then return i-1 end end
end
table.negsize = function (T)
if not T[1] then return nil end
for i=1,-10000000,-1 do if T[i] == nil then return i+1 end end
end
table.assert = function (T, n, filler)
if n >= 1 then
for i=1,n do T[i] = T[i] or filler end
else
for i=1,n,-1 do T[i] = T[i] or filler end
end
end
table.replace1 = function (T, str, x, y)
table.assert(T, y, "")
T[y] = string.replace(T[y], str, x)
return T
end
table.replacemany = function (T, otherT, x, y)
for i=table.negsize(otherT),table.size(otherT) do
table.replace1(T, otherT[i], x, i+(y or 1)-1)
end
return T
end

string.tocanvas = function (str, initialy)
local T = {}
for i,li in ipairs(splitlines(str)) do
table.replace1(T, li, 1, i+(initialy or 1)-1)
end
return T
end
canvastostring = function (T)
return table.concat(T, "\n", table.negsize(T), table.size(T))
end

-- Tests for the basic functions.

assert(string.trim("abcd  ") == "abcd")
assert(string.trim("abcde") == "abcde")

assert(string.replace("abcdef", "CD", 3) == "abCDef")
assert(string.replace("ab",     "CD", 3) == "abCD")
assert(string.replace("a",      "CD", 3) == "a CD")

assert(table.concat(table.transpose({on=1, tw=2, th=3}), " ") == "on tw th")
assert(table.concat(table.swaps({10, 20, 30, 40}, {{3, 4}})) == "10204030")

A = {[-5]=-50, [-3]=-30, [-2]=-20, [-1]=-10, [0]=0, 10, 20, 30, 40, 50, nil, 70}
assert(table.negsize(A) == -3)
assert(table.size(A)    ==  5)

strA = "-1\n0\n1\n2"
strB = "a\nb\nc"
assert(strA:tocanvas(-1)[-1] == "-1")
assert(canvastostring(strA:tocanvas(-1)) == strA)

CA = strA:tocanvas(-1)
CB = strB:tocanvas(0)
assert(canvastostring(table.replacemany(CA, CB, 3, 1)) == "-1\n0 a\n1 b\n2 c")
CA = strA:tocanvas(-1)
CB = strB:tocanvas(0)
assert(canvastostring(table.replacemany(CA, CB, 2, -1)) == " a\n-b\n0c\n1\n2")

-- «Class»  (to ".Class")
-- A very simple object system.
-- For detailed documentation see:
--   (find-dn6 "eoo.lua")
--   (find-blogme4file "eoo.lua")
-- The metatable of each object points to its class,
-- and classes are callable, and act as creators.
-- New classes can be created with, e.g.:
--   Circle = Class { type = "Circle", __index = {...} }
-- then:
--   Circle {size = 1}
-- sets the metatable of the table {size = 1} to Circle,
-- and returns the table {size = 1} (with its mt modified).

-- Based on: (find-angg "LUA/tostring.lua")

Class = {
type   = "Class",
__call = function (class, o) return setmetatable(o, class) end,
}
setmetatable(Class, Class)

otype = function (o)
local mt = getmetatable(o)
return mt and mt.type or type(o)
end

Canvas = Class {
type    = "Canvas",
__index = {
miny = function (C) return table.negsize(C) end,
maxy = function (C) return table.size(C) end,
width = function (C)
local w = 0
for y=C:miny(),C:maxy() do w = math.max(w, #C[y]) end
return w
end,
tostring = function (C) return canvastostring(C) end,
draw = function (C, obj, x, y)
if type(obj) == "string" then table.replace1(C, obj, x, y)
elseif type(obj) == "table" then table.replacemany(C, obj, x, y)
end
return C
end
},
}

CanvasFrom = function (str, initialy)
return Canvas(string.tocanvas(str, initialy))
end

-- Tests

C = Canvas {[0]="0", "1", "2"}
assert(C:tostring() == "0\n1\n2")
assert(C:miny() == 0)
assert(C:maxy() == 2)
CA, CB = CanvasFrom("0\n1\n2", 0), CanvasFrom("a\nb\nc", 1)
CA, CB = CanvasFrom("0\n1\n2", 0), CanvasFrom("a\nb\nc", 1)
CC     = CA:draw(CB, 4, 1)
assert(CC:tostring() == "0\n1  a\n2  b\n   c")
assert(CC:width()    == 4)

-- The shapes of my DAGs can be described more easily with strings.
-- For example, the "Reh" dag has its four nodes placed like this:
--    1
--   2 3
--   4
-- Its arrows are {{1, 2}, {1, 3}, {2, 4}}, and this can be extracted
-- from the string with the function shapetoarrows, below.
-- Once we have the list of arrows we have a way to calculate the
-- interior of an arbitray subset of {1, 2, 3, 4}, and once we have
-- the interior and binstrings[4] = {"0000", "0001", ...} we can
-- obtain all the open subsets of {1, 2, 3, 4}, by calculating the
-- interior of all the arbitrary subsets.

binstrings = {}
binstrings[1] = {"0", "1"}
for i=2,7 do
binstrings[i] = {}
for _,v in ipairs(binstrings[i-1]) do
table.insert(binstrings[i], v.."0")
table.insert(binstrings[i], v.."1")
end
end
assert(binstrings[6][63] == "111110")

intoshape = function (shape, short)
local f = function (c) return short:sub(cton(c), cton(c)) end
return (shape:gsub("(%w)", f))
end
shapetoarrows = function (shape)
local lines = splitlines(shape)
local arrows = {}
local coords = {}
local f = function (c1, c2)
if c1 and c2  then table.insert(arrows, {c1, c2}) end
end
for y=1,#lines-1 do
for x=1,#lines[y] do
local c  = cton(lines[y]:sub(x, x))
local sw = cton(lines[y+1]:sub(x-1, x-1))
local s  = cton(lines[y+1]:sub(x,   x))
local se = cton(lines[y+1]:sub(x+1, x+1))
f(c, sw)
f(c, s)
f(c, se)
end
end
for y=1,#lines do
for x=1,#lines[y] do
local c  = cton(lines[y]:sub(x, x))
if c then coords[c] = {x, y} end
end
end
return arrows, coords
end
arrowstostring = function (arrows)
return table.concat(map(table.concat, arrows), " ")
end
interior = function (short, arrows)
local T = split(short, ".")
for i=#arrows,1,-1 do
local src, tgt = arrows[i][1], arrows[i][2]
if (not T[src]) or (not T[tgt]) then
PP("Too short!", short, arrows)
end
if T[src] > T[tgt] then T[src] = T[tgt] end
end
return table.concat(T, "")
end
binstrings = {}
binstrings[1] = {"0", "1"}
for i=2,14 do
binstrings[i] = {}
for _,v in ipairs(binstrings[i-1]) do
table.insert(binstrings[i], v.."0")
table.insert(binstrings[i], v.."1")
end
end

-- Tests.

reh_shape = [[
1
2 3
4]]
reh_arrows, reh_coords = shapetoarrows(reh_shape)
assert(intoshape(reh_shape, "abcd") == " a\nb c\nd")
assert(arrowstostring(reh_arrows) == "12 13 24")
assert(interior("1001", reh_arrows) == "0001")
assert(binstrings[6][1]  == "000000")
assert(binstrings[6][63] == "111110")

-- Calculate the topology.

shapenvertices = function (shape)   -- count the digits
return #(string.gsub(shape, "%W", ""))
end
weightof = function (short)         -- count the "1"s
return #(string.gsub(short, "[^1]", ""))
end
opensetsfor = function (shape)
local arrows    = shapetoarrows(shape)
local nvertices = shapenvertices(shape)
local classicaltruthvals = binstrings[nvertices]
local opensets = {}
local rankedopensets = {}
for w=0,nvertices do rankedopensets[w] = {} end
for _,short in ipairs(classicaltruthvals) do
if short == interior(short, arrows) then
table.insert(opensets, short)
table.insert(rankedopensets[weightof(short)], 1, short)
end
end
local ctoopenset, opensettoc = {}, {}
local c = 0
for w=nvertices,0,-1 do
for _,openset in ipairs(rankedopensets[w]) do
c = c + 1
ctoopenset[c] = openset
opensettoc[openset] = c
end
end
return opensets, rankedopensets, ctoopenset, opensettoc
end

-- Tests.
-- (find-sh "lua51 ~/LUA/canvas2.lua")

assert(shapenvertices(reh_shape) == 4)
assert(weightof("1100111"), 5)
reh_opens, reh_ranked, c_to_rehopen, rehopen_to_c = opensetsfor(reh_shape)
assert(table.concat(reh_opens, " ") == "0000 0001 0010 0011 0101 0111 1111")
assert(table.concat(reh_ranked[2], " ") == "0101 0011")

-- Tools for printing Heyting algebras.
-- They don't always print the right diagrams without human intervention...
-- but these tools save a lot of work.

texargs = {[0]="",
"#1",
"#1#2",
"#1#2#3",
"#1#2#3#4",
"#1#2#3#4#5",
"#1#2#3#4#5#6",
"#1#2#3#4#5#6#7",
"#1#2#3#4#5#6#7#8",
"#1#2#3#4#5#6#7#8#9",
}

primesketch = function (shape, xscale, yscale)
local opens, ranked, ctoop, optoc = opensetsfor(shape)
local C = Canvas {""}
for y=0,#ranked do
for x=1,#ranked[y] do
local short = ranked[y][x]
local long = intoshape(shape, short)
local D = CanvasFrom(long)
C:draw(D, (x - 1) * xscale + 1, -y * yscale)
end
end
return C
end
primesketch2 = function (shape, biggershape, xscale, yscale, swaps)
local opens, ranked, ctoopen, opentoc = opensetsfor(shape)
local _, coords = shapetoarrows(biggershape)
ctoopen = table.swaps(ctoopen, swaps)
opentoc = table.transpose(ctoopen)
local C = Canvas {""}
for c,openset in ipairs(ctoopen) do
local xy = coords[c]
local x, y = xy[1], xy[2]
local bigx, bigy = (x - 1) * xscale + 1, (y - 1) * yscale
local D = CanvasFrom(intoshape(shape, openset))
C:draw(D, bigx, bigy)
end
return C
end
Shape = Class {
type    = "Shape",
__index = {
into = function (Sh, short) return intoshape(Sh.sh, short) end,
intoc = function (Sh, short) return CanvasFrom(Sh:into(short)) end,
primesketch = function (Sh, xscale, yscale)
return primesketch(Sh.shape, xscale, yscale)
end,
primesketch2 = function (Sh, BiggerSh, xscale, yscale, swaps)
return primesketch2(Sh.shape, BiggerSh.shape, xscale, yscale, swaps)
end,
printsketch = function(Sh, xscale, yscale)
print("Topology for "..Sh.name.." (sketch, ranked):")
print(Sh:primesketch(xscale, yscale):tostring())
end,
printsketch2 = function(Sh, BiggerSh, xscale, yscale, swaps)
print("Topology for "..Sh.name.." (as "..BiggerSh.name.."):")
print(Sh:primesketch2(BiggerSh, xscale, yscale, swaps):tostring())
end,
texdef = function (Sh, lower)
local out = ""
local printf = function (...) out = out..format(...) end
local w, h = Sh.width, Sh.height
local pw = 6 * w + 2
local ph = 12 * h
local name = Sh.name
local args = texargs[Sh.nvertices]
local plower = (lower or 0) * 12
printf("\\def\\dag%s%s{%%\n", name, args)
printf("  \\dagpicture(%d,%d)(-4,0)[%d]{\n", pw, ph, plower)
for i,xy in ipairs(Sh.coords) do
local x, y = xy[1], xy[2]
local px, py = (x-1)*6, (h-y)*12
printf("    \\dagput(%3d,%3d){$#%d$}\n", px, py, i)
end
printf("  }}\n")
return out
end,
texcomment = function (Sh)
return "% "..Sh.shape:gsub("\n", "\n%% ")
end,
texbhbox = function (Sh)
local testargs = texargs[Sh.nvertices]:gsub("#", "")
return format("%s: $\\bhbox{\\dag%s %s}$", Sh.name, Sh.name, testargs)
end,
textest = function (Sh, lower)
printf("%%\15\n")
printf("%% (eedn4a-bounded)\n")
printf("%s\n", Sh:texdef(lower))
printf("\\edrxcolors\n")
printf("\\def\\bhbox{\\bicolorhbox}\n")
printf("%s\n", Sh:texbhbox())
printf("%%\15\n")
end,
},
}
ShapeFrom = function (name, shape)
local arrows, coords = shapetoarrows(shape)
local nvertices = shapenvertices(shape)
local opens, ranked, ctoopen, opentoc = opensetsfor(shape)
local C = CanvasFrom(shape, 1)
local width, height = C:width(), #C
return Shape {
name = name,
shape = shape,
arrows = arrows,
coords = coords,
opensets = opens,
rankedopensets = ranked,
width = width,
height = height,
nvertices = nvertices,
shape = shape,
}
end

-- Tests.

Reh = ShapeFrom("Reh", [[
1
2 3
4]])

Pot32 = ShapeFrom("Pot32", [[
1
2
3 4
5 6
7]])

-- Reh:printsketch(6, 4)
-- Pot32:printsketch(10, 6)
-- Reh:printsketch2(Pot32, 6, 4)

Lguill = ShapeFrom("Lguill", [[
1 2
3 4
5 6]])

-- PP(Lguill)

Lguill_prime = ShapeFrom("Lguill_prime", [[
1
2 3
4 5
6 7
8 9
A B
C]])

-- Lguill:printsketch(6, 4)
-- Lguill_prime:printsketch(6, 7)
-- Lguill:printsketch2(Lguill_prime, 4, 4)
Lguill:printsketch2(Lguill_prime, 4, 4, {{4, 5}})

-- Lguill = lguill_shape)

--[[
Topology for Lguill (as Lguill_prime):
1 1
1 1
1 1

1 0     0 1
1 1     1 1
1 1     1 1

0 0     0 1
1 1     0 1
1 1     1 1

0 0     0 0
1 0     0 1
1 1     1 1

0 0     0 0
1 0     0 0
1 0     1 1

0 0     0 0
0 0     0 0
1 0     0 1

0 0
0 0
0 0
--]]

-- print(primesketch2(reh_shape, bigpot_shape, 6, 4):tostring())

-- Reh = ShapeFrom("Reh", reh_shape)
-- PP(Reh)
-- print(Reh:primesketch(5, 5):tostring())
-- PP(Lguill)
-- print(Lguill:primesketch(5, 5):tostring())

-- (eejump 10)
-- (eejump 11)

-- Local Variables:
-- coding:  raw-text-unix
-- modes:   (fundamental-mode lua-mode)
-- End: