Longest Common Subsequence

lcs.red

Red [
	Purpose: "Longest Common Subsequence"
	Partially-based-on: http://rosettacode.org/wiki/Longest_common_subsequence
	Date: 8-Jan-2019
	Last: 10-Jan-2019
]
lcs: function [s t][
	case [ ; preliminary checks
		s = t [return copy s]
		any [empty? s empty? t] [return copy ""]
	]
	a: s b: t
	while [all [a b s/1 == t/1]][if a: next s [s: a] if b: next t [t: b]] ; check common prefix
	start: index? s
	x: length? s y: length? t
	while [all [x > 0 y > 0 s/:x == t/:y]][x: x - 1 y: y - 1] ; check common suffix

	if all [x > 0 y > 0][ ; unless we have pure insertion or deletion
		lens: make block! 1 + x
		loop x + 1 [append/only lens append/dup make block! 1 + y 0 y + 1] ; make matrix
		repeat i x [
			repeat j y [
				lens/(i + 1)/(j + 1): either s/:i = t/:j [
					lens/:i/:j + 1 
				][
					max lens/(i + 1)/:j lens/:i/(j + 1)
				]
			]
		]
	]
	
	result: make type? s min length? s length? t
	insert result at head s start + x ; common suffix
	while [all [0 < x 0 < y]][
		case [
			lens/(x + 1)/(y + 1) = lens/:x/(y + 1) [x: x - 1]
			lens/(x + 1)/(y + 1) = lens/(x + 1)/:y [y: y - 1]
			'else [
				if s/:x = t/:y [
					insert/only result s/:x
				]
				x: x - 1
				y: y - 1
			]
		]
	]
	insert result copy/part head s start - 1 ; common prefix
	result
]