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 string.adjustto = function (str, len) 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.adjustto("abcdef", 4) == "abcd") assert(string.adjustto("abcdef", 8) == "abcdef ") 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") -- See also: (find-angg ".emacs.templates" "class") 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") cton = function (c) return tonumber(c, 36) end 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: