Longest hypercube path
Husk, 27 26 24 bytes
→foΛεẊδṁ≠ÖLm↓≠⁰←ġ→PΠmṠe¬
Brute force, so very slow. Try it online!
Explanation
Husk reads naturally from right to left.
←ġ→PΠmṠe¬ Hypercube sequences ending in second input, say y=[1,1,0]
mṠe¬ Pair each element with its negation: [[0,1],[0,1],[1,0]]
Π Cartesian product: [[0,0,1],[1,0,1],..,[1,1,0]]
P Permutations.
ġ→ Group by last element
← and take first group.
The permutations are ordered so that those with last element y come first,
so they are grouped together and returned here.
ÖLm↓≠⁰ Find first input.
m For each permutation,
↓≠⁰ drop all elements before the first input.
ÖL Sort by length.
foΛεẊδṁ≠ Check path condition.
fo Keep those lists that satisfy:
Ẋ For each adjacent pair (e.g. [0,1,0] and [1,1,0]),
ṁ take sum of
≠ absolute differences
δ of corresponding elements: 1+0+0 gives 1.
Λε Each value is at most 1.
→ Finally, return last element (which has greatest length).
Mathematica, 108 bytes
a=#~FromDigits~2+1&;Last@PadLeft[IntegerDigits[#-1,2]&/@FindPath[HypercubeGraph@Length@#,a@#,a@#2,∞,All]]&
Input:
[{0, 0, 0, 0}, {1, 1, 1, 1}]
Output:
{{0, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 1}, {0, 0, 1, 0}, {0, 1, 1, 0},
{0, 1, 0, 0}, {0, 1, 0, 1}, {1, 1, 0, 1}, {1, 0, 0, 1}, {1, 0, 0, 0},
{1, 1, 0, 0}, {1, 1, 1, 0}, {1, 0, 1, 0}, {1, 0, 1, 1}, {1, 1, 1, 1}}
Mathematica, 175 bytes
Nice first question!
(m=#;n=#2;Last@SortBy[(S=Select)[S[Rest@Flatten[Permutations/@Subsets[Tuples[{0,1},(L=Length)@m]],1],First@#==m&&Last@#==n&],Union[EditDistance@@@Partition[#,2,1]]=={1}&],L])&
Input
[{0, 0, 0}, {1, 1, 1}]