|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- tcgs.lua: classes for two-column graphs.
-- http://angg.twu.net/dednat6/dednat6/tcgs.lua
-- http://angg.twu.net/dednat6/dednat6/tcgs.lua.html
-- (find-angg "dednat6/dednat6/tcgs.lua")
--
-- This is a hack that I use in the papers of my "Planar Heyting
-- Algebras for Children" series.
--
-- This file supersedes the code for TCGs in:
-- (find-LATEX "edrxpict.lua" "TCG")
-- but it defines classes with different names so that this and the
-- old version can be loaded together (and the migration can be made
-- gradually).
-- «.qmarks-cuts» (to "qmarks-cuts")
-- «.qmarks-cuts-test» (to "qmarks-cuts-test")
-- «.Line» (to "Line")
-- «.Line-test» (to "Line-test")
-- «.TCGSpec» (to "TCGSpec")
-- «.TCGSpec-test» (to "TCGSpec-test")
-- «.TCGDims» (to "TCGDims")
-- «.TCGDims-test» (to "TCGDims-test")
-- «.TCGQ» (to "TCGQ")
-- «.TCGQ-tests» (to "TCGQ-tests")
-- (find-LATEX "edrxtikz.lua" "Line")
-- (find-LATEX "edrxtikz.lua" "Line-test")
require "zhaspecs" -- (find-dn6 "zhaspecs.lua")
require "picture" -- (find-dn6 "picture.lua")
-- _ __ __ _
-- __ _ _ __ ___ __ _ _ __| | _____ / / \ \ ___ _ _| |_ ___
-- / _` | '_ ` _ \ / _` | '__| |/ / __| / /_____\ \ / __| | | | __/ __|
-- | (_| | | | | | | (_| | | | <\__ \ \ \_____/ / | (__| |_| | |_\__ \
-- \__, |_| |_| |_|\__,_|_| |_|\_\___/ \_\ /_/ \___|\__,_|\__|___/
-- |_|
--
-- «qmarks-cuts» (to ".qmarks-cuts")
-- Convert between the formats "qmarks" and "cuts".
-- For example: (".??", "..???") <-> "321/0 0|1|2345".
-- See: (find-es "dednat" "qmarks-to-cuts")
qmarkstocuts = function (leftqmarks, rightqmarks)
local cuts = ""
local add = function (s) cuts = cuts..s end
local leftqm = function (y) return leftqmarks :sub(y,y) == "?" end
local rightqm = function (y) return rightqmarks:sub(y,y) == "?" end
for y=#leftqmarks,1,-1 do
add(y)
if not leftqm(y) then add("/") end
end
add("0 0")
for y=1,#rightqmarks do
if not rightqm(y) then add("|") end
add(y)
end
return cuts
end
cutstoqmarks = function (cuts)
local l,r = cuts:sub(1,1)+0, cuts:sub(-1,-1)+0
local lqmarks,rqmarks = "", ""
lqmark = function (y) return not cuts:match(y.."/") end
rqmark = function (y) return not cuts:match("|"..y) end
for y=1,l do lqmarks = lqmarks .. (lqmark(y) and "?" or ".") end
for y=1,r do rqmarks = rqmarks .. (rqmark(y) and "?" or ".") end
return lqmarks, rqmarks
end
-- «qmarks-cuts-test» (to ".qmarks-cuts-test")
--[[
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
require "tcgs"
PP(qmarkstocuts(".??", "..???"))
PP(cutstoqmarks "321/0 0|1|2345")
--]]
-- _ _
-- | | (_)_ __ ___
-- | | | | '_ \ / _ \
-- | |___| | | | | __/
-- |_____|_|_| |_|\___|
--
-- «Line» (to ".Line")
-- Parametrized lines.
-- This is a copy of:
-- (find-LATEX "edrxtikz.lua" "Line")
-- minus MAYBE some methods for Analytic Geometry and Tikz.
--
Line = Class {
new = function (A, v, mint, maxt)
return Line {A=A, v=v, mint=mint, maxt=maxt}
end,
newAB = function (A, B, mint, maxt) return Line.new(A, B-A, mint, maxt) end,
type = "Line",
__tostring = function (li) return li:tostring() end,
__index = {
t = function (li, t) return li.A + t * li.v end,
draw = function (li) return formatt("%s -- %s", li:t(li.mint), li:t(li.maxt)) end,
tostring = function (li) return formatt("%s + t%s", li.A, li.v) end,
proj = function (li, P) return li.A + li.v:proj(P - li.A) end,
sym = function (li, P) return P + 2*(li:proj(P) - P) end,
--
pict = function (li) return formatt("\\Line%s%s", li:t(li.mint), li:t(li.maxt)) end,
--
-- (find-LATEX "edrxpict.lua" "pict2evector")
pictv = function (li)
local x0,y0 = li:t(li.mint):to_x_y()
local x1,y1 = li:t(li.maxt):to_x_y()
return pict2evector(x0, y0, x1, y1)
end,
},
}
-- «Line-test» (to ".Line-test")
--[[
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
r = Line.new(v(0, 1), v(3, 2), -1, 2)
= r
= r:t(0)
= r:t(0.1)
= r:t(1)
= r:draw()
= r:pict()
--]]
-- _____ ____ ____ ____
-- |_ _/ ___/ ___/ ___| _ __ ___ ___
-- | || | | | _\___ \| '_ \ / _ \/ __|
-- | || |__| |_| |___) | |_) | __/ (__
-- |_| \____\____|____/| .__/ \___|\___|
-- |_|
--
-- «TCGSpec» (to ".TCGSpec")
-- Based on:
-- (find-dn6 "zhaspecs.lua" "LR-fromtcgspec-tests")
-- (find-dn6 "zhaspecs.lua" "LR")
-- (find-dn6 "zhaspecs.lua" "LR" "fromtcgspec =")
TCGSpec = Class {
type = "TCGSpec",
split = function (specstr)
local pat = "^(%d)[ ,]*(%d);([ %d]*),([ %d]*)$"
local l,r,lgens,rgens = specstr:match(pat)
local l,r,lgens,rgens = l+0, r+0, split(lgens), split(rgens)
return l,r,lgens,rgens
end,
new = function (specstr, leftqmarks, rightqmarks)
local l,r,lgens,rgens = TCGSpec.split(specstr)
return TCGSpec {tcgspec=specstr,
maxl=l, maxr=r, leftgens=lgens, rightgens=rgens,
leftqmarks=leftqmarks, rightqmarks=rightqmarks
}
end,
--
ddtonn = function (dd)
local a,b = dd:match("^(%d)(%d)$")
return a+0, b+0
end,
generatelrs = function (lrs)
if type(lrs) == "string" then lrs = split(lrs) end
return cow(function ()
for _,lr in ipairs(lrs) do
local l,r = TCGSpec.ddtonn(lr)
coy(lr, l, r)
end
end)
end,
--
__tostring = function (ts) return mytabletostring(ts) end,
__index = {
LRcolstrs = function (ts, Lcolstr, Rcolstr)
ts.Lcolstr = Lcolstr
ts.Rcolstr = Rcolstr
return ts
end,
--
zha = function (ts)
return LR.fromtcgspec(ts.tcgspec):zha()
end,
zhaspec = function (ts) return ts:zha().spec end,
generateleftgens = function (ts)
return TCGSpec.generatelrs(ts.leftgens)
end,
generaterightgens = function (ts)
return TCGSpec.generatelrs(ts.rightgens)
end,
hasqmarks = function (ts) return ts.leftqmarks end,
--
cuts = function (ts)
return qmarkstocuts(ts.leftqmarks, ts.rightqmarks)
end,
mp = function (ts, opts)
local mp = mpnew(opts or {}, ts:zhaspec())
if ts:hasqmarks() then mp = mp:addcuts("c "..ts:cuts()) end
return mp
end,
--
-- See: (find-es "dednat" "lawvere-tierney")
mpunder = function (ts, utop, opts, ubot)
local zhaspec = ts:zhaspec()
local mp = mpnew(opts, zhaspec)
local cond = format("lr:below(v'%s') and lr:above(v'%s')", utop, ubot or "00")
local ulrf = format("lr -> (%s) and lr:lr() or '..'", cond)
mp:zhalrf0(ulrf)
if ts:hasqmarks() then
local uzha = ts:zha():shrinktop(v(utop))
local ucuts = "c "..ts:cuts()
mp.cuts:addcuts(uzha, ucuts)
end
return mp
end,
--
ap = function (ts)
local tdims = TCGDims {h=6, v=3, q=2, crh=2, crv=1, qrh=1} -- dummy
return TCGQ.newdsoa(tdims, ts, {}, "lr q").ap
end,
--
tcgq = function (ts, opts, actions)
return TCGQ.newdsoa(tdims, ts, opts, actions) -- use a global tdims
end,
},
}
-- «TCGSpec-test» (to ".TCGSpec-test")
--[[
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
spec = "46; 32, 15 26"
ts = TCGSpec.new(spec)
= ts
= ts:zha()
= ts:zha().spec
= ts:zhaspec()
for lr,l,r in ts:generateleftgens() do PP(lr,l,r) end
for lr,l,r in ts:generaterightgens() do PP(lr,l,r) end
for i,c in ("abcde"):gmatch("()(.)") do PP(i, c) end
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
ts = TCGSpec.new("46; 22 34 45, 25", ".???", "???.?.")
= ts
= ts:zha()
= ts:zhaspec()
= ts:cuts()
= ts:mp()
= ts:mp():addlrs()
ts:mp({zdef="foo"}):lprint()
= TCGSpec.new("46; 22 34 45, 25", ".???", "???.?."):mp():addlrs()
= TCGSpec.new("46; 22 34 45, 25" ):mp():addlrs()
-- (ph2p 24 "Q-partitions-are-slash-partitions" "side of each")
-- (ph2 "Q-partitions-are-slash-partitions" "side of each")
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
= TCGSpec.new("46; 32, 15 26", "?..?","..??.."):ap()
= TCGSpec.new("46; 32, 15 26" ):ap()
= TCGSpec.new("46; 32, 15 26", "?..?","..??.."):mp()
= TCGSpec.new("46; 32, 15 26", "?..?","..??.."):mp():addlrs()
= TCGSpec.new("46; 32, 15 26" ):mp():addlrs()
= TCGSpec.new("46; 32, 15 26" ):zha()
--]]
-- _____ ____ ____ ____ _
-- |_ _/ ___/ ___| _ \(_)_ __ ___ ___
-- | || | | | _| | | | | '_ ` _ \/ __|
-- | || |__| |_| | |_| | | | | | | \__ \
-- |_| \____\____|____/|_|_| |_| |_|___/
--
-- «TCGDims» (to ".TCGDims")
-- New! 2019apr28.
-- A structure that holds the dimension parameters of a TCG.
-- The functions L and R return the centers of the column cells.
-- The functions QL and QR return the centers of the question mark cells.
-- The "radius" of a node cell is (crh,crv).
-- The "radius" of a question mark cell is (qrh,crv).
TCGDims = Class {
type = "TCGDims",
__tostring = function (td) return mytabletostring(td) end,
__index = {
L = function (td, y) return v(0, td.v*y) end,
R = function (td, y) return v(td.h, td.v*y) end,
QR = function (td, y) return v(td.h+td.q, td.v*y) end,
QL = function (td, y) return v( -td.q, td.v*y) end,
cellradius = function (td) return v(td.crh, td.crv) end,
qmarkradius = function (td) return v(td.qrh, td.crv) end,
varrowts = function (td) return td.crv/td.v, 1-td.crv/td.v end,
harrowts = function (td) return td.crh/td.h, 1-td.crh/td.h end,
larrowparams = function (td, y0, y1)
return td:L(y0), td:L(y1), td:varrowts()
end,
rarrowparams = function (td, y0, y1)
return td:R(y0), td:R(y1), td:varrowts()
end,
lrarrowparams = function (td, y0, y1)
return td:L(y0), td:R(y1), td:harrowts()
end,
rlarrowparams = function (td, y0, y1)
return td:R(y0), td:L(y1), td:harrowts()
end,
lowerleft = function (td) return td:L(1)-td:cellradius() end,
lowerleftq = function (td) return td:QL(1)-td:qmarkradius() end,
upperright = function (td, y) return td:R(y)+td:cellradius() end,
upperrightq = function (td, y) return td:QR(y)+td:qmarkradius() end,
},
}
-- «TCGDims-test» (to ".TCGDims-test")
--[[
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
td = TCGDims {h=6, v=3, q=2, crh=2, crv=1, qrh=1}
= td
= td:lowerleft()
= td:lowerleftq()
= td:upperright(4)
= td:upperrightq(4)
= td:larrowparams(1, 0)
= td:lrarrowparams(1, 0)
--]]
-- (find-dn6 "picture.lua" "LPicture")
-- (find-LATEX "edrxtikz.lua" "Line")
-- LPicture.__index.addarrow = function (lp, A, B, t0, t1)
-- lp:addtex(Line.newAB(A, B, t0, t1):pictv())
-- end
-- _____ ____ ____ ___
-- |_ _/ ___/ ___|/ _ \
-- | || | | | _| | | |
-- | || |__| |_| | |_| |
-- |_| \____\____|\__\_\
--
-- «TCGQ» (to ".TCGQ")
-- A class for TCGs with optional question marks. This is a rewrite of
-- the obsolete TCG class, but this uses a TCGDims object in a field
-- ".td" to makes the dimensions much easier to adjust and to make the
-- calculations more readable. A TCGQ object has a field ".lp" with an
-- LPicture object with commands to draw all its nodes and arrows, a
-- field ".ap" with an AsciiPicture object that only stores its nodes
-- and qnodes (that I use to visualize in ascii how a TCGQ is converted
-- to a ZHAJ), and an optional TCGSpec object in the field ".ts".
--
-- It is possible to create a "low-level TCGQ" without a tcgspec for
-- tests; in this case you have to specify explicitly its "l" and "r".
-- In a "high-level TCGQ" the fields "l" and "r" are extracted the
-- tcgspec.
--
TCGQ = Class {
type = "TCGQ",
new = function (tdims, opts, l, r, tcgspec)
local tq = TCGQ {tdims=tdims, opts=opts, l=l, r=r,
ts=tcgspec,
lp=LPicture.new(opts),
ap=AsciiPicture.new(" "):put(v(1,1)," "),
}
if tcgspec then
tq.l = tcgspec.maxl
tq.r = tcgspec.maxr
if tcgspec:hasqmarks() then tq:addqpoints() end
end
tq:addpoints()
return tq
end,
newdsoa = function (tdims, tcgspec, opts, actions)
return TCGQ.new(tdims, opts, nil, nil, tcgspec):act(actions or "")
end,
--
__index = {
tolatex = function (tq) return tq.lp:tolatex() end,
print = function (tq) print(tq.lp); return tq end,
lprint = function (tq) print(tq.lp:tolatex()); return tq end,
output = function (tq) output(tq.lp:tolatex()); return tq end,
--
-- Functions to adjust the boundaries of the LPicture
addpoints = function (tq)
tq.lp:addpoint(tq.tdims:lowerleft())
tq.lp:addpoint(tq.tdims:upperright(max(tq.l, tq.r)))
return tq
end,
addqpoints = function (tq)
tq.lp:addpoint(tq.tdims:lowerleftq())
tq.lp:addpoint(tq.tdims:upperrightq(max(tq.l, tq.r)))
return tq
end,
--
-- Draw boxes on cells and qmarks, for debugging
drawboxes = function (tq)
for y=1,tq.l do tq.lp:addrectr(tq.tdims:L(y), tq.tdims:cellradius()) end
for y=1,tq.r do tq.lp:addrectr(tq.tdims:R(y), tq.tdims:cellradius()) end
return tq
end,
drawqboxes = function (tq)
for y=1,tq.l do tq.lp:addrectr(tq.tdims:QL(y), tq.tdims:qmarkradius()) end
for y=1,tq.r do tq.lp:addrectr(tq.tdims:QR(y), tq.tdims:qmarkradius()) end
return tq
end,
--
-- Draw the standard vertical arrows.
varrows = function (tq)
for y=tq.l,2,-1 do tq.lp:addarrow(tq.tdims:larrowparams(y, y-1)) end
for y=tq.r,2,-1 do tq.lp:addarrow(tq.tdims:rarrowparams(y, y-1)) end
return tq
end,
--
-- Put text in cells and in the qmark cells
put = function (tq, v, tex)
tq.lp:rawput(v, "\\cell{"..tex.."}")
return tq
end,
aput = function (tq, x, y, tex)
tex = (tex or ""):gsub("[\\_]", ""):sub(1,1)
tq.ap:put(v(x,y), tex)
return tq
end,
Lput = function (tq, y, tex) tq:put(tq.tdims:L(y), tex):aput(1, y, tex) end,
Rput = function (tq, y, tex) tq:put(tq.tdims:R(y), tex):aput(2, y, tex) end,
QLput = function (tq, y, tex) tq:put(tq.tdims:QL(y), tex):aput(0, y, tex) end,
QRput = function (tq, y, tex) tq:put(tq.tdims:QR(y), tex):aput(3, y, tex) end,
--
bullets = function (tq)
for y=1,tq.l do tq:Lput(y, "\\bullet") end
for y=1,tq.r do tq:Rput(y, "\\bullet") end
return tq
end,
lrs = function (tq)
for y=1,tq.l do tq:Lput(y, y.."\\_") end
for y=1,tq.r do tq:Rput(y, "\\_"..y) end
return tq
end,
--
LRputs = function (tq, left, right)
left = (left or tq.ts.Lcolstr):gsub("!", "\\")
right = (right or tq.ts.Rcolstr):gsub("!", "\\")
for y,str in ipairs(split(left)) do tq:Lput(y, str) end
for y,str in ipairs(split(right)) do tq:Rput(y, str) end
return tq
end,
--
-- Low-level functions to put "?"s and "!"s in qmark cells
QLputs = function (tq, qmarks)
for y,c in qmarks:gmatch("()(.)") do
if c=="?" or c=="!" then tq:QLput(y, c) end
end
return tq
end,
QRputs = function (tq, qmarks)
for y,c in qmarks:gmatch("()(.)") do
if c=="?" or c=="!" then tq:QRput(y, c) end
end
return tq
end,
--
-- A low-level function to put digits in cells
digits = function (tq, ldigits, rdigits)
for y,d in ldigits:gmatch("()(.)") do tq:Lput(y, d) end
for y,d in rdigits:gmatch("()(.)") do tq:Rput(y, d) end
return tq
end,
--
-- Functions that work only on "high-level TCGQs", that are the
-- ones with a "ts" field holding a TCGSpec object.
qmarks = function (tq)
if tq.ts:hasqmarks() then
tq:QLputs(tq.ts.leftqmarks)
tq:QRputs(tq.ts.rightqmarks)
end
return tq
end,
harrows = function (tq)
for lr,l,r in tq.ts:generateleftgens() do
-- PP("->", l, r)
tq.lp:addarrow(tq.tdims:lrarrowparams(l, r))
end
for lr,l,r in tq.ts:generaterightgens() do
-- PP("<-", l, r)
tq.lp:addarrow(tq.tdims:rlarrowparams(r, l))
end
return tq
end,
--
act = function (tq, actions)
for i,action in ipairs(split(actions)) do
if action == "b" then tq:bullets()
elseif action == "lr" then tq:lrs()
elseif action == "v" then tq:varrows()
elseif action == "h" then tq:harrows()
elseif action == "q" then tq:qmarks()
elseif action == "B" then tq:drawboxes()
elseif action == "QB" then tq:drawqboxes()
elseif action == "p" then tq:print()
elseif action == "ap" then tq.ap:print()
elseif action == "LR" then tq:LRputs()
elseif action == "o" then tq:output()
else error("Bad action: "..action)
end
end
return tq
end,
},
}
-- «TCGQ-tests» (to ".TCGQ-tests")
--[[
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
require "tcgs"
td = TCGDims {h=6, v=3, q=4, crh=2, crv=1, qrh=1}
opts = {meta="p s", def="foo"}
tq = TCGQ.new(td, opts, 3, 4):drawboxes():drawqboxes():varrows()
tq:addqpoints()
tq:Lput(2, "A")
tq:lprint()
tq = TCGQ.new(td, opts, 3, 4):act("B QB v"):addqpoints()
tq:Lput(2, "A")
tq:lprint()
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
require "tcgs"
td = TCGDims {h=6, v=3, q=4, crh=2, crv=1, qrh=1}
opts = {meta="p s", def="foo"}
tq = TCGQ.new(td, opts, 3, 4)
= tq.ap
= tq:lrs().ap
= tq:bullets().ap
= tq:QLputs("?.!").ap
= tq.ap
= tq:lrs().ap
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
tspec = TCGSpec.new("46; 32, 15 26", "?..?", "..??..")
tdims = TCGDims {h=6, v=3, q=2, crh=2, crv=1, qrh=1}
tq = TCGQ.new(tdims, {tdef="foo"}, nil, nil, tspec)
tq:bullets()
tq:lrs()
tq:varrows()
tq:harrows()
tq:qmarks()
tq:drawboxes()
tq:drawqboxes()
tq:print()
• (eepitch-lua51)
• (eepitch-kill)
• (eepitch-lua51)
dofile "tcgs.lua"
tspec = TCGSpec.new("46; 32, 15 26", "?..?","..??..")
tdims = TCGDims {h=6, v=3, q=2, crh=2, crv=1, qrh=1}
tq = TCGQ.newdsoa(tdims, tspec, {tdef="foo"}, "b v h p")
tq = TCGQ.newdsoa(tdims, tspec, {tdef="foo"})
tq:print()
tdims = TCGDims {h=6, v=3, q=2, crh=2, crv=1, qrh=1}
tq = TCGQ.newdsoa(tdims, tspec, {tdef="foo"}, "lr")
tq:print()
= tq.ap
--]]
-- Local Variables:
-- coding: utf-8-unix
-- End: