DEPOBJS =
CLEAN += *.o *.d
+TIME = /usr/bin/time
+
+DICT = /usr/share/dict/british-english-insane
+
SRCEXT += c
CC = gcc
CFLAGS = $(OPTIMIZE) $(WARNINGS)
SRCEXT += rs
RUSTC = rustc
-RUSTFLAGS = --edition=2018 -L. $(OPTIMIZE_RUST)
+RUSTFLAGS = --edition=2018 -L$(abspath .) $(OPTIMIZE_RUST)
OPTIMIZE_RUST = -O
RUSTLIBS =
CARGODIR = /usr/share/cargo/registry
-compile-rust = $(call v-tag,RUSTC)$(RUSTC) $(RUSTFLAGS) $3 \
- -o$1 $2
+compile-rust = +$(call v-tag,RUSTC)\
+ rm -rf rusttmp.$1 && mkdir rusttmp.$1 && \
+ $(RUSTC) $(RUSTFLAGS) $4 \
+ -orusttmp.$1/$2 $3 && \
+ mv rusttmp.$1/$2 . && rmdir rusttmp.$1
RUSTLIBS += typed_arena
typed_arena_DIR = $(CARGODIR)/typed-arena-2.0.0
RUSTLIB_OBJS = $(foreach l,$(RUSTLIBS), lib$l.rlib)
CLEAN += $(RUSTLIB_OBJS)
-$(RUSTLIB_OBJS): lib%.rlib: $$($*_DEPS)
- $(call compile-rust,$@,$($*_DIR)/src/lib.rs, \
+$(RUSTLIB_OBJS): lib%.rlib: \
+ $$(or $$($$*_SRC), $$($$*_DIR)/src/lib.rs) $$($*_DEPS)
+ $(call compile-rust,$*,$@,$<, \
--crate-type=rlib --crate-name=$* $($*_RUSTFLAGS))
+SRCEXT += go
+GOBLD = go build
+
TREELIBS =
VPATH =
xyla-treap_CFLAGS = -DTREE=XYLA_TREAP
TREELIBS += qptrie
-qptrie_VARIANTS = qp-fanf qp-mdw fn-fanf fn-mdw
QPDIR = $(HOME)/src/ext/qp
VPATH += $(QPDIR)
CFLAGS += -mpopcnt
qptrie_CFLAGS = -I$(QPDIR)
qptrie_SRCS = Tbl.c
+qptrie_VARIANTS =
+
+qptrie_VARIANTS += qp-fanf qp-mdw qp-list
qptrie-qp_SRCS = qp.c
-qptrie-fn_SRCS = fn.c
-qptrie-qp-fanf_CFLAGS = -DTREE=QPTRIE_QP -DUSE_RECURSIVE_TNEXTL
+qptrie-qp-fanf_CFLAGS = -DTREE=QPTRIE_QP -DQPTRIE_ITER=QPITER_FANF
qptrie-qp-fanf_SRCS = $(qptrie-qp_SRCS)
-qptrie-fn-fanf_CFLAGS = -DTREE=QPTRIE_FN -DUSE_RECURSIVE_TNEXTL
-qptrie-fn-fanf_SRCS = $(qptrie-fn_SRCS)
-qptrie-qp-mdw_CFLAGS = -DTREE=QPTRIE_QP
+qptrie-qp-mdw_CFLAGS = -DTREE=QPTRIE_QP -DQPTRIE_ITER=QPITER_MDW
qptrie-qp-mdw_SRCS = $(qptrie-qp_SRCS)
-qptrie-fn-mdw_CFLAGS = -DTREE=QPTRIE_FN
+qptrie-qp-list_CFLAGS = -DTREE=QPTRIE_QP -DQPTRIE_ITER=QPITER_LIST
+qptrie-qp-list_SRCS = $(qptrie-qp_SRCS)
+
+qptrie_VARIANTS += fn-fanf fn-mdw fn-list
+qptrie-fn_SRCS = fn.c
+qptrie-fn-fanf_CFLAGS = -DTREE=QPTRIE_FN -DQPTRIE_ITER=QPITER_FANF
+qptrie-fn-fanf_SRCS = $(qptrie-fn_SRCS)
+qptrie-fn-mdw_CFLAGS = -DTREE=QPTRIE_FN -DQPTRIE_ITER=QPITER_MDW
qptrie-fn-mdw_SRCS = $(qptrie-fn_SRCS)
+qptrie-fn-list_CFLAGS = -DTREE=QPTRIE_FN -DQPTRIE_ITER=QPITER_LIST
+qptrie-fn-list_SRCS = $(qptrie-fn_SRCS)
TREELIBS += sgt
sgt_VARIANTS = tree234
CLEAN += chain.rust-$1
run-rust-$1 = ./chain.rust-$1 <$$1
chain.rust-$1: chain.rs $$(RUSTLIB_OBJS)
- $$(call compile-rust,$$@,$$<, \
+ $$(call compile-rust,chain-$1,$$@,$$<, \
$$(foreach l,$$(RUSTLIBS), \
$$(rust-$1_RUSTFLAGS) --extern=$$l))
endef
$(foreach v,$(rust_VARIANTS), \
$(eval $(call def-rust-variant,$v)))
-DICT = /usr/share/dict/british-english-insane
+ALL_VARIANTS += golang
+TARGETS += chain.golang
+CLEAN += chain.golang
+chain.golang: chain.go
+ $(call v-tag,GOBLD)$(GOBLD) -o $@ $<
+
+ALL_VARIANTS += perl python
+
+lisp_VARIANTS = cmucl ccl ecl sbcl
+measure-lisp = \
+ runlisp -L$1 chain.lisp -Ttime.$2.new $(DICT) >chain.$2.out
+define def-lisp-variant
+ALL_VARIANTS += lisp-$1
+lisp-$1_PROGRAM = chain.lisp
+lisp-$1_MEASURE = $$(call measure-lisp,$1,$$*)
+endef
+$(foreach v,$(lisp_VARIANTS), \
+ $(eval $(call def-lisp-variant,$v)))
+
+CLEAN += ref
+ref: $(DICT)
+ $(call v-tag,GEN)./chain.perl $(DICT) >$@.new && mv $@.new $@
+
+CLEAN += *.out *.new time.*
+COMMON_MEASURE = \
+ set -- $$($(TIME) -f"%U %S" 2>&1 ./chain.$* <$(DICT) >chain.$*.out) && \
+ { echo "$$1 $$2 + p" | dc; } >time.$*.new
+
+warm-cache:
+ $(call v-tag,CAT)cat $(DICT) >/dev/null
+.PHONY: warm-cache
MEASURES = $(foreach v,$(ALL_VARIANTS), measure/$v)
measure: $(MEASURES)
-$(MEASURES): measure/%: chain.%
- $TIME -f%U
-.PHONY: measure $(MEASURES)
+$(MEASURES): measure/%: $$(or $$($$*_PROGRAM),chain.$$*) ref warm-cache
+ $(call v-tag,MEASURE)$(or $($*_MEASURE),$(COMMON_MEASURE)) && \
+ ./chkref chain.$*.out ref && mv time.$*.new time.$*
+.PHONY: measure $(MEASURES)
all: $(TARGETS)
clean::; rm -f $(CLEAN)
-include $(DEPOBJS:.o=.d)
+p:; : $x
#define LIBAVL_TRB 19
#define MLIB_SYM 20
+#define QPITER_FANF 1
+#define QPITER_MDW 2
+#define QPITER_LIST 3
+
#if !TREE
# error "`TREE' not defined or bungled constant setting"
#elif TREE == XYLA_AVL
# define USE_LIBAVL 1
# define tree__name(name) trb_##name
#elif TREE == MLIB_SYM
+# include <unistd.h>
# include <mLib/sym.h>
+# include <mLib/unihash.h>
#else
# error "unknown `TREE' value"
#endif
# define TREE_T_NEXT tree__name(t_next)
#endif
+#if USE_QPTRIE
+# if !QPTRIE_ITER
+# error "`QPTRIE_ITER' not defined or bungled constant setting"
+# elif QPTRIE_ITER == QPITER_FANF
+# elif QPTRIE_ITER == QPITER_MDW
+# elif QPTRIE_ITER == QPITER_LIST
+# else
+# error "unknown `QPTRIE_ITER' value"
+# endif
+#endif
+
struct word { const char *p; size_t n; } word;
struct node {
#elif TREE == MLIB_SYM
struct sym_base _s;
#endif
+#if TREE == MLIB_SYM || (USE_QPTRIE && QPTRIE_ITER == QPITER_LIST)
+ struct node *next;
+#endif
#if TREE != MLIB_SYM
struct word w;
#endif
# endif
#elif USE_QPTRIE
-# ifdef USE_RECURSIVE_TNEXTL
+
+# if QPTRIE_ITER == QPITER_FANF
# define my_Tnextl Tnextl
-# elif TREE == QPTRIE_QP
+# define DECL_ITER \
+ struct word cur; \
+ void *v
+# define INSERT_LIST do ; while (0)
+# elif QPTRIE_ITER == QPITER_MDW
+# define DECL_ITER \
+ struct word cur; \
+ void *v
+# define INSERT_LIST do ; while (0)
+
+# if TREE == QPTRIE_QP
static bool my_Tnextl(Tbl *tbl, const char **k_inout, size_t *sz_inout,
void **val_out)
t = twig(t, off);
if (off + 1 < max) resume = t + 1;
}
- if (strcmp(k, t->leaf.key) != 0) return (false);
+ /* if (strcmp(k, t->leaf.key) != 0) return (false); */
t = resume; if (!t) return (false);
}
}
return (true);
}
-# elif TREE == QPTRIE_FN
+# elif TREE == QPTRIE_FN
static bool my_Tnextl(Tbl *t, const char **k_inout, size_t *sz_inout,
void **val_out)
t = Tbranch_twigs(t) + off;
if (off + 1 < max) resume = t + 1;
}
- if (strcmp(k, Tleaf_key(t)) != 0) return (false);
+ /* if (strcmp(k, Tleaf_key(t)) != 0) return (false); */
t = resume; if (!t) return (false);
}
while (isbranch(t)) t = Tbranch_twigs(t);
return (true);
}
+# else
+# error "no mdw `Tnextl' for this QP trie variant"
+# endif
+# elif QPTRIE_ITER == QPITER_LIST
+# define DECL_ITER \
+ struct node *list = 0, **tail = &list, *next
+# define INSERT_LIST \
+ do { node->next = 0; *tail = node; tail = &node->next; } while (0)
# endif
# define DECLS \
Tbl *tbl = 0; \
- struct word cur; \
- void *v
+ DECL_ITER
# define INIT do ; while (0)
# define INSERT do { \
tbl = Tsetl(tbl, node->w.p, node->w.n, node); \
+ INSERT_LIST; \
} while (0)
-# define ITERATE \
+# if QPTRIE_ITER == QPITER_LIST
+# define ITERATE \
+ for (next = list; node = next, node; next = next->next)
+# else
+# define ITERATE \
for (cur.p = 0, cur.n = 0; \
my_Tnextl(tbl, &cur.p, &cur.n, &v) ? node = v, 1 : 0; )
+#endif
# define FOCUS do ; while (0)
# define LOOKUP Tgetl(tbl, buf, word.n)
-# define FREE do { \
+# if QPTRIE_ITER == QPITER_LIST
+# define FREE do { \
+ for (node = list; node; node = next) { \
+ tbl = Tsetl(tbl, node->w.p, node->w.n, 0); \
+ next = node->next; free(node); \
+ } \
+ assert(!tbl); \
+ } while (0)
+# else
+# define FREE do { \
while (tbl) { \
cur.p = 0; cur.n = 0; my_Tnextl(tbl, &cur.p, &cur.n, &v); \
tbl = Tsetl(tbl, cur.p, cur.n, 0); free(v); \
} \
- } while (0)
+ } while (0)
+# endif
# define CHECK do ; while (0)
# define DECLS \
sym_table tab; \
- sym_iter it; \
+ struct node *list = 0, **tail = &list, *next; \
unsigned foundp
-# define INIT do { sym_create(&tab); } while (0)
+# define INIT do { \
+ unihash_setkey(&unihash_global, /*getpid()*/ 31022); \
+ sym_create(&tab); \
+ } while (0)
# define PREPNODE do ; while (0)
# define INSERT do { \
node = sym_find(&tab, buf, word.n, sizeof(*node), &foundp); \
if (foundp) { bail(";; duplicate `%s'\n", buf); node = 0; } \
+ else { node->next = 0; *tail = node; tail = &node->next; } \
} while (0)
-# define ITERATE for (sym_mkiter(&it, &tab); node = sym_next(&it), node; )
+# define ITERATE for (next = list; node = next, node; next = next->next)
# define FOCUS do ; while (0)
struct node *node, *parent;
struct word word;
char buf[WORDMAX];
- int ch, max;
+ int ch, max, nlen, plen;
INIT;
word.p = buf;
ITERATE {
FOCUS;
-/* fprintf(stderr, ";; ponder `%.*s'\n", WORDLEN(node), WORDPTR(node)); */
+ /* fprintf(stderr, ";; ponder `%.*s'\n", WORDLEN(node), WORDPTR(node)); */
if (WORDLEN(node) <= 1)
parent = 0;
else {
GETPREFIX;
-/* fprintf(stderr, ";; search `%.*s'\n", word.n, word.p); */
+ /* fprintf(stderr, ";; search `%.*s'\n", word.n, word.p); */
parent = LOOKUP;
}
- node->up = parent;
+ node->up = parent; nlen = node->len;
while (parent) {
- if (parent->len > node->len + 1) break;
- if (parent->len < node->len + 1) parent->down = 0;
- if (parent->down != node)
- { node->right = parent->down; parent->down = node; }
- parent->len = node->len + 1;
- if (parent->len > max) max = parent->len;
- node = parent; parent = node->up;
+ plen = parent->len; nlen++;
+ if (plen > nlen)
+ break;
+ else if (plen == nlen) {
+ node->right = parent->down; parent->down = node;
+ break;
+ } else {
+ parent->down = node; node->right = 0;
+ parent->len = nlen;
+ node = parent; parent = node->up;
+ }
}
+ if (nlen > max) max = nlen;
}
ITERATE if (node->len == max) { print_chain(node); putchar('\n'); }
std::exit(2);
}
-static void print_chain(WordNode *node)
+static void print_chain(WordNode *wnode)
{
- if (!node->second.right) {
- std::fputs(node->first.c_str(), stdout);
- if (node->second.down)
- { std::putchar(' '); print_chain(node->second.down); }
+ const std::string *word = &wnode->first;
+ Node *node = &wnode->second;
+
+ if (!node->right) {
+ std::fputs(word->c_str(), stdout);
+ if (node->down)
+ { std::putchar(' '); print_chain(node->down); }
} else {
std::fputs("{ ", stdout);
for (;;) {
- std::fputs(node->first.c_str(), stdout);
- if (node->second.down)
- { std::putchar(' '); print_chain(node->second.down); }
- node = node->second.right; if (!node) break;
+ std::fputs(word->c_str(), stdout);
+ if (node->down)
+ { std::putchar(' '); print_chain(node->down); }
+ wnode = node->right; if (!wnode) break;
std::fputs(" | ", stdout);
+ word = &wnode->first; node = &wnode->second;
}
std::fputs(" }", stdout);
}
{
Map map{};
char buf[WORDMAX]; size_t n;
- int ch, max;
for (;;) {
if (!std::fgets(buf, WORDMAX, stdin)) break;
n = std::strlen(buf); assert(n);
if (buf[n - 1] == '\n') buf[--n] = 0;
else if (n == WORDMAX - 1) bail("word too long");
- else if (ch = std::getchar(), ch != EOF)
- bail("short read, found `%c'", ch);
+ else {
+ int ch;
+ if (ch = std::getchar(), ch != EOF)
+ bail("short read, found `%c'", ch);
+ }
auto r = map.insert(WordNode(std::string(buf, n), Node{}));
if (!r.second) printf(";; duplicate `%s'\n", buf);
else {
- WordNode *w = &*r.first;
- w->second.up = w->second.down = w->second.right = 0;
- w->second.len = 1;
+ Node *node = &r.first->second;
+ node->len = 1; node->up = node->down = node->right = 0;
}
}
- max = 0;
+ int max = 0;
for (auto p = map.begin(); p != map.end(); ++p) {
-/* std::fprintf(stderr, ";; ponder `%.*s'\n",
- p->first.length(), p->first.c_str()); */
- WordNode *w = &*p, *parent;
- if (w->first.length() <= 1)
- parent = 0;
+ /* std::fprintf(stderr, ";; ponder `%.*s'\n",
+ p->first.length(), p->first.c_str()); */
+ WordNode *wnode = &*p, *pwnode;
+ const std::string *word = &wnode->first;
+ Node *node = &wnode->second;
+ if (word->length() <= 1)
+ pwnode = 0;
else {
-/* std::fprintf(stderr, ";; search `%.*s'\n",
- w->first.length(), w->first.c_str()); */
- std::string prefix{w->first, 0, w->first.length() - 1};
- auto p = map.find(prefix); parent = p == map.end() ? 0 : &*p;
+ /* std::fprintf(stderr, ";; search `%.*s'\n",
+ w->first.length(), w->first.c_str()); */
+ std::string prefix{*word, 0, word->length() - 1};
+ auto p = map.find(prefix); pwnode = p == map.end() ? 0 : &*p;
}
- w->second.up = parent;
- while (parent) {
- if (parent->second.len > w->second.len + 1) break;
- if (parent->second.len < w->second.len + 1) parent->second.down = 0;
- if (parent->second.down != w) {
- w->second.right = parent->second.down;
- parent->second.down = w;
+ int nlen = node->len;
+ node->up = pwnode;
+ while (pwnode) {
+ Node *parent = &pwnode->second;
+ nlen++; int plen = parent->len;
+ if (plen > nlen)
+ break;
+ else if (plen == nlen) {
+ node->right = parent->down; parent->down = wnode;
+ break;
+ } else {
+ parent->down = wnode; node->right = 0;
+ parent->len = nlen;
+ wnode = pwnode; node = &wnode->second; pwnode = node->up;
}
- parent->second.len = w->second.len + 1;
- if (parent->second.len > max) max = parent->second.len;
- w = parent; parent = w->second.up;
}
+ if (nlen > max) max = nlen;
}
for (auto p = map.begin(); p != map.end(); ++p)
--- /dev/null
+/* -*-go-*- */
+
+package main
+
+import ("bufio"; "fmt"; "os")
+
+type wordnode struct {
+ word *string
+ len int
+ up, down, right *wordnode
+}
+
+func print_chain(node *wordnode) {
+ if node.right == nil {
+ fmt.Printf("%s", *node.word)
+ if node.down != nil {
+ fmt.Printf(" ")
+ print_chain(node.down)
+ }
+ } else {
+ fmt.Printf("{ ")
+ for {
+ fmt.Printf("%s", *node.word)
+ if node.down != nil {
+ fmt.Printf(" ")
+ print_chain(node.down)
+ }
+ node = node.right
+ if node == nil { break }
+ fmt.Printf(" | ")
+ }
+ fmt.Printf(" }")
+ }
+}
+
+func main() {
+ words := make(map[string] *wordnode)
+
+ scanner := bufio.NewScanner(os.Stdin)
+ for scanner.Scan() {
+ word := scanner.Text()
+ words[word] = &wordnode { &word, 1, nil, nil, nil }
+ }
+
+ max := 0
+ for word, node := range words {
+ wlen := len(word)
+ if wlen <= 1 { continue }
+ parent := words[word[:wlen - 1]]
+ node.up = parent
+ for parent != nil {
+ nlen := node.len + 1
+ plen := parent.len
+ if nlen < plen {
+ break
+ } else if nlen > plen {
+ parent.down = nil
+ parent.len = nlen
+ if nlen > max { max = nlen }
+ }
+ if parent.down != node {
+ node.right = parent.down; parent.down = node
+ }
+ node = parent; parent = node.up
+ }
+ }
+
+ for _, node := range words {
+ if node.len == max { print_chain(node); fmt.Printf("\n") }
+ }
+}
--- /dev/null
+;;; -*-lisp-*-
+
+(defstruct (node (:predicate nodep)
+ (:constructor make-node (word)))
+ (word (error "uninitialized slot") :type string :read-only t)
+ (len 0 :type fixnum)
+ (up nil :type (or node null))
+ (down nil :type (or node null))
+ (right nil :type (or node null)))
+
+(defun word-chain (stream)
+ (declare (optimize speed))
+
+ (let ((map (make-hash-table :test #'equal))
+ (max 0))
+
+ (loop
+ (let ((line (read-line stream nil)))
+ (unless line (return))
+ (setf (gethash line map) (make-node line))))
+
+ (maphash (lambda (word node)
+ (declare (type string word)
+ (type node node))
+
+ ;;(format t ";; contemplate `~A'~%" word)
+ (let ((parent (let ((len (length word)))
+ (and (>= len 1)
+ (gethash (subseq word 0 (1- len))
+ map))))
+ (nlen (node-len node)))
+ (setf (node-up node) parent)
+ (loop
+ (unless parent (return))
+ (incf nlen)
+ (let ((plen (node-len parent)))
+ ;;(format t ";; node `~A' ~D parent `~A' ~D~%"
+ ;; (node-word node) (1- nlen)
+ ;; (node-word parent) plen)
+ (cond ((> plen nlen)
+ ;;(format t ";; longer chain through `~A'~%"
+ ;; (node-word (node-down parent)))
+ (return))
+ ((= plen nlen)
+ (setf (node-right node) (node-down parent)
+ (node-down parent) node)
+ (return))
+ (t
+ ;;(format t ";; new longest chain ~A > ~A~%"
+ ;; nlen plen)
+ (setf (node-down parent) node
+ (node-right node) nil
+ (node-len parent) nlen
+ node parent
+ parent (node-up node))))))
+ (when (> nlen max) (setf max nlen))))
+ map)
+
+ (maphash (lambda (word node)
+ (declare (ignore word)
+ (type node node))
+
+ (when (= (node-len node) max)
+ (labels ((print-chain (node)
+ (cond ((null (node-right node))
+ (write-string (node-word node))
+ (let ((down (node-down node)))
+ (when down
+ (write-char #\space)
+ (print-chain down))))
+ (t
+ (write-string "{ ")
+ (loop
+ (write-string (node-word node))
+ (let ((down (node-down node)))
+ (when down
+ (write-char #\space)
+ (print-chain down)))
+ (let ((right (node-right node)))
+ (unless right (return))
+ (write-string " | ")
+ (setf node right)))
+ (write-string " }")))))
+ (print-chain node)
+ (terpri))))
+ map)))
+
+#+runlisp-script
+(let ((args (uiop:command-line-arguments))
+ (timing-out nil))
+
+ (handler-bind ((warning #'muffle-warning))
+ (let ((*compile-verbose* nil))
+ (compile 'word-chain)))
+
+ (when (and args (>= (length (car args)) 2)
+ (string= (car args) "-T" :end1 2))
+ (let ((arg (pop args)))
+ (setf timing-out (if (= (length arg) 2) t
+ (subseq arg 2)))))
+
+ (let (t0 t1 t2)
+ (setf t0 (get-internal-run-time)) ; warm cache
+ (setf t0 (get-internal-run-time)) ; start time
+ (setf t1 (get-internal-run-time)) ; overhead
+ (flet ((hack-file (path)
+ (cond ((string= path "-") (word-chain *standard-input*))
+ (t (with-open-file (stream path) (word-chain stream))))))
+ (cond ((null args)
+ (word-chain *standard-input*))
+ ((null (cdr args))
+ (hack-file (car args)))
+ (t
+ (dolist (arg args)
+ (format t "~A: " arg)
+ (hack-file arg)))))
+ (setf t2 (get-internal-run-time)) ; final time
+
+ (flet ((write-time (stream)
+ (format stream "~,3F~%"
+ (/ (max 0 (+ t2 t0 (* -2 t1)))
+ internal-time-units-per-second))))
+ (cond ((eq timing-out t)
+ (write-string ";; time = ")
+ (write-time *standard-output*))
+ (timing-out
+ (with-open-file (stream timing-out
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
+ (write-time stream)))))))
--- /dev/null
+#! /usr/bin/perl -w
+
+use autodie;
+use strict;
+
+use constant { WORD => 0, LEN => 1, UP => 2, DOWN => 3, RIGHT => 4 };
+
+my %WORD;
+while (<>) {
+ chomp;
+ $WORD{$_} = [$_, 1, undef, undef, undef];
+}
+
+my $MAX = 0;
+WORD: while (my ($word, $node) = each %WORD) {
+ my $len = length $word;
+ my $parent = $len <= 1 ? undef : $WORD{substr $word, 0, $len - 1};
+ $node->[UP] = $parent;
+ my $nlen = $node->[LEN];
+ UP: while (defined $parent) {
+ my $plen = $parent->[LEN]; $nlen++;
+ if ($plen > $nlen)
+ { last UP; }
+ elsif ($plen == $nlen)
+ { $node->[RIGHT] = $parent->[DOWN]; $parent->[DOWN] = $node; last UP; }
+ else {
+ $parent->[DOWN] = $node; $node->[RIGHT] = undef;
+ $parent->[LEN] = $nlen;
+ $node = $parent; $parent = $node->[UP];
+ }
+ }
+ if ($nlen > $MAX) { $MAX = $nlen; }
+}
+
+sub print_chain ($);
+sub print_chain ($) {
+ my ($node) = @_;
+
+ if (!defined $node->[RIGHT]) {
+ print $node->[WORD];
+ if (defined $node->[DOWN]) { print " "; print_chain $node->[DOWN]; }
+ } else {
+ print "{ ";
+ ALT: for (;;) {
+ print $node->[WORD];
+ if (defined $node->[DOWN]) { print " "; print_chain $node->[DOWN]; }
+ $node = $node->[RIGHT]; last ALT unless defined $node;
+ print " | ";
+ }
+ print " }";
+ }
+}
+
+for my $node (values %WORD)
+ { if ($node->[LEN] == $MAX) { print_chain $node; print "\n"; } }
--- /dev/null
+#! /usr/bin/python3
+
+import sys as SYS
+
+class Node (object):
+ __slots__ = ["word", "len", "up", "down", "right"];
+ def __init__(me, word):
+ me.word = word
+ me.len = 1
+ me.up = me.down = me.right = None
+
+WORDS = dict()
+
+for line in SYS.stdin:
+ line = line.rstrip("\n")
+ WORDS[line] = Node(line)
+
+MAX = 0
+for node in WORDS.values():
+ word = node.word; wlen = len(word)
+ if wlen <= 1: parent = None
+ else: parent = WORDS.get(word[:wlen -1])
+ node.up = parent; nlen = node.len
+ while parent is not None:
+ plen = parent.len; nlen += 1
+ if plen > nlen:
+ break
+ elif plen == nlen:
+ node.right = parent.down; parent.down = node
+ break
+ else:
+ parent.down = node; node.right = None
+ parent.len = nlen
+ node = parent; parent = node.up
+ if nlen > MAX: MAX = nlen
+
+def print_chain(node):
+ if node.right is None:
+ SYS.stdout.write(node.word)
+ if node.down:
+ SYS.stdout.write(" "); print_chain(node.down)
+ else:
+ SYS.stdout.write("{ ")
+ while True:
+ SYS.stdout.write(node.word)
+ if node.down:
+ SYS.stdout.write(" "); print_chain(node.down)
+ node = node.right
+ if node is None: break
+ SYS.stdout.write(" | ")
+ SYS.stdout.write(" }")
+
+for node in WORDS.values():
+ if node.len == MAX: print_chain(node); SYS.stdout.write("\n")
use std::cell::Cell;
use std::io::{self, BufRead, Write};
-use std::ptr;
use typed_arena;
let n = line.len();
if n == 0 { break; }
if line[n - 1] == b'\n' { line = &line[0 .. n - 1]; }
-//stdout.write_all(b";; read `")?;
-//stdout.write_all(line)?;
-//stdout.write_all(b"'\n")?;
+ //stdout.write_all(b";; read `")?;
+ //stdout.write_all(line)?;
+ //stdout.write_all(b"'\n")?;
let word: &[u8] = byte_arena.alloc_extend(line.iter().map(|p| *p));
if let MapEntry::Vacant(e) = map.entry(word) {
e.insert(node_arena.alloc(Node { word: word, .. Node::default() }));
let mut max = 0;
for node in map.values() {
-//stdout.write_all(b";; ponder `")?;
-//stdout.write_all(node.word)?;
-//stdout.write_all(b"'\n")?;
+ //stdout.write_all(b";; ponder `")?;
+ //stdout.write_all(node.word)?;
+ //stdout.write_all(b"'\n")?;
let mut node: &Node = node;
let mut parent;
let n = node.word.len();
if n <= 1 { parent = None; }
else { parent = map.get(&node.word[0 .. n - 1]).map(|n| &**n); }
node.up.set(parent);
+ let mut nlen = node.len.get();
while let Some(parent_node) = parent {
- let plen = parent_node.len.get();
- let nlen = node.len.get() + 1;
- if plen > nlen { break; }
- if plen < nlen { parent_node.down.set(None); }
- match parent_node.down.get() {
- Some(link) if ptr::eq(link, node) => (),
- _ => {
- node.right.set(parent_node.down.get());
- parent_node.down.set(Some(node));
- }
+ let plen = parent_node.len.get(); nlen += 1;
+ if plen > nlen
+ { break; }
+ else if plen == nlen {
+ node.right.set(parent_node.down.get());
+ parent_node.down.set(Some(node));
+ break;
+ } else {
+ parent_node.down.set(Some(node));
+ node.right.set(None);
+ parent_node.len.set(nlen);
+ node = parent_node; parent = node.up.get();
}
- parent_node.len.set(nlen);
- if nlen > max { max = nlen; }
- node = parent_node; parent = node.up.get()
}
+ if nlen > max { max = nlen; }
}
for node in map.values() {
--- /dev/null
+#! /usr/bin/perl -w
+
+use autodie;
+use strict;
+
+sub parse_chain (\@);
+sub parse_chain (\@) {
+ my ($words) = @_;
+
+ my $chain = ""; my $sep = "";
+ WORD: for (;;) {
+ last WORD unless @$words;
+ my $word = shift @$words;
+ if ($word eq "}" || $word eq "|") {
+ unshift @$words, $word; last WORD;
+ } elsif ($word ne "{") {
+ $chain .= $sep . $word; $sep = ",";
+ } else {
+ my @alts;
+ ALT: for (;;) {
+ push @alts, parse_chain(@$words);
+ my $tok = shift @$words;
+ last ALT if $tok eq "}";
+ die "bad syntax" unless $tok eq "|";
+ }
+ $chain .= "(" . join("|", sort { $a cmp $b } @alts) . ")";
+ }
+ }
+ return $chain;
+}
+
+sub parse_list ($) {
+ my ($path) = @_;
+
+ open my $f, "<", $path;
+ my @chains;
+ while (<$f>) {
+ my @words = split;
+ push @chains, parse_chain(@words);
+ }
+ $f->close;
+ return join("|", @chains);
+}
+
+die "usage: $0 A B" unless @ARGV == 2;
+
+my $achain = parse_list $ARGV[0];
+my $bchain = parse_list $ARGV[1];
+die "$achain /= $bchain" unless $achain eq $bchain;
--- /dev/null
+a
+an
+and
+i
+in
+ink
+inky
+bi
+bin
+bind
+binds
+bins
~mdw / wordchain / commitdiff