4
\$\begingroup\$

Given two rectangular arrays, A and B, let's say that A is embedded in B if A can be obtained from B by deleting some (or none) of the rows and columns of B.

Write a program with the following I/O:

Input: two arbitrary rectangular arrays of letters (a-z), as a string from stdin.

Output: the number of embeddings of the first array in the second array, followed by a "text picture" of each embedding (showing deleted elements replaced by dots).

(This is a two dimensional generalization of my old question Is string X a subsequence of string Y?)

Example:

input:

abb
aba

ababb
aabba
babab
abbaa

output (if I haven't missed any):

5

a..bb
a..ba
.....
.....

ab.b.
.....
.....
ab.a.

ab..b
.....
.....
ab..a

.....
a.bb.
.....
a.ba.

.....
.abb.
.aba.
..... 

The winner is the shortest such program (least number of characters).

\$\endgroup\$
  • \$\begingroup\$ There are only 5 embeddings. Your first one is the same as your fourth one. \$\endgroup\$ – marinus Oct 27 '13 at 20:00
7
\$\begingroup\$

APL (160)

{∆,⍨⍴∆←⍵∘{(⍴⍵)⍴(,⍵){⍺:⍵⋄'.'}¨,⍺}¨⊃¨∘.∧/¨∆/⍨⍺∘≡¨⍵∘{(⊃⍵)⌿⍺/⍨⊃⌽⍵}¨∆←,⊃∘.,/⊂¨¨K{⍵=0:⊂⍺/1⋄~(⍳⍺)∘∊¨⍵{⍺=1:(⍳⍵)⋄∆/⍨{∧/</¨2,/⍵}¨∆←,⍳⍺/⍵}⍺}¨(K←⍴⍵)-⍴⍺}/{×⍴K←⍞:∇⍵,⊂K⋄↑⍵}¨⍬⍬

Output:

      {∆,⍨⍴∆←⍵∘{(⍴⍵)⍴(,⍵){⍺:⍵⋄'.'}¨,⍺}¨⊃¨∘.∧/¨∆/⍨⍺∘≡¨⍵∘{(⊃⍵)⌿⍺/⍨⊃⌽⍵}¨∆←,⊃∘.,/⊂¨¨K{⍵=0:⊂⍺/1⋄~(⍳⍺)∘∊¨⍵{⍺=1:(⍳⍵)⋄∆/⍨{∧/</¨2,/⍵}¨∆←,⍳⍺/⍵}⍺}¨(K←⍴⍵)-⍴⍺}/{×⍴K←⍞:∇⍵,⊂K⋄↑⍵}¨⍬⍬
abb
aba

ababb
aabba
babab
abbaa

 5  .....  .....  ab..b  ab.b.  a..bb  
    a.bb.  .abb.  .....  .....  a..ba  
    .....  .aba.  .....  .....  .....  
    a.ba.  .....  ab..a  ab.a.  .....  

Explanation:

  • {...}/{×⍴K←⍞:∇⍵,⊂K⋄↑⍵}¨⍬⍬: read the two arrays from the keyboard, and return them as two matrices. Reduce the following function over the list of the two matrices.
  • ∆{...}¨(∆←⍴⍵)-⍴⍺: get the height and width of each of the matrices. In both the width and the height, get a list of possible lines to drop.

    • ⍵=0:⊂⍺/1: if the matrices are the same length in a dimension, never drop any lines from that dimension. Otherwise:

    • ⍺=1:(⍳⍵)⋄: If the difference is one, try to drop each line

    • ∆/⍨{∧/</¨2,/⍵}¨∆←,⍳⍺/⍵: otherwise, drop each possible combination of lines.
  • ∆←,⊃∘.,/⊂¨¨: combine each height mask with each width mask, giving all possible combinations to make the second list the size of the first.
  • ⍵∘{(⊃⍵)⌿⍺/⍨⊃⌽⍵}¨∆: for each possible combination, remove those lines from the second matrix.
  • ∆/⍨⍺∘≡¨: drop all the ones that are not equal to the first matrix, giving the solutions.
  • ⊃¨∘.∧/¨: for each of the possible solutions, make a matrix with 0 where a dot should go and 1 where the corresponding character from the first matrix should go.
  • ⍵∘{(⍴⍵)⍴(,⍵){⍺:⍵⋄'.'}¨,⍺}¨: for each of these, flatten both the second matrix (,⍵) and the matrix of dots (,⍺), and take either the character or a dot for each position ({⍺:⍵⋄'.'}¨). Then reshape it to the shape it had before ((⍴⍵)⍴).
  • ∆,⍨⍴∆: give the amount of solution, and each solution.
\$\endgroup\$
  • \$\begingroup\$ Thanks for the explanation! To someone unacquainted with APL, it would also be useful to know what exactly is to be typed for input via the keyboard. (I'd like to run your program with an online interpreter.) \$\endgroup\$ – r.e.s. Oct 28 '13 at 13:07
  • \$\begingroup\$ @r.e.s. It will not run in ngn/apl, because it lacks support for some functions that are used. I use Dyalog APL (dyalog.com), if you're on Windows you can download a free version and then you can just paste this line in its command window and then type the arrays in the same format as in the question (i.e., array, blank line, array, blank line). Note: if you do this, do not paste them because the Dyalog interpreter seems to have a bug and will eat the blank lines. [1/2] \$\endgroup\$ – marinus Oct 29 '13 at 0:51
  • \$\begingroup\$ @r.e.s. If you want to try it without installing anything, everything but the input routine will run on TryAPL (tryapl.com). To make that work, you have to define your two matrices first (i.e. type a←2 3⍴'abbaba', enter, b←4 5⍴'ababbaabbababababbaa', enter). Then remove the part that does input ({×⍴K←⍞:∇⍵,⊂K⋄↑⍵}¨⍬⍬) at the end and put a b after the /. [2/2] \$\endgroup\$ – marinus Oct 29 '13 at 0:55
  • \$\begingroup\$ The fact that this APL program is so long frightens me \$\endgroup\$ – Claudiu Nov 3 '14 at 19:22
  • 1
    \$\begingroup\$ @Claudiu: APL frightens me in general. \$\endgroup\$ – Alex A. Dec 19 '14 at 19:51
6
\$\begingroup\$

Mathematica, 186 chars

{a,b}=Characters/@StringSplit@InputString[]&~Array~2;{Length@#,Grid/@#}&[ReplacePart[b,Except[$|##&@@Tuples@#,{_,_}]->"."]&/@Select[Tuples[Subsets/@Range/@Dimensions@b],b[[##]]&@@#==a&]]

Example:

In[1]:= {a,b}=Characters/@StringSplit@InputString[]&~Array~2;{Length@#,Grid/@#}&[ReplacePart[b,Except[$|##&@@Tuples@#,{_,_}]->"."]&/@Select[Tuples[Subsets/@Range/@Dimensions@b],b[[##]]&@@#==a&]]  
? abb aba
? ababb aabba babab abbaa

Out[1]= {5, {a . . b b, a b . b ., a b . . b, . . . . ., . . . . .}}
             a . . b a  . . . . .  . . . . .  . a b b .  a . b b .
             . . . . .  . . . . .  . . . . .  . a b a .  . . . . .
             . . . . .  a b . a .  a b . . a  . . . . .  a . b a .
\$\endgroup\$
  • 1
    \$\begingroup\$ What world are we living in where Mathematica almost beat APL? \$\endgroup\$ – Claudiu Nov 3 '14 at 19:22
  • 1
    \$\begingroup\$ @Claudiu: one in which Mathematica has built-ins for just about anything, but their names are very long. \$\endgroup\$ – marinus Dec 26 '14 at 17:10
3
\$\begingroup\$

Python 2 with Numpy, 342 chars

from numpy import*
from itertools import*
import sys
S=str.split
C=combinations
R=range
a,b=[mat(map(list,S(x)))for x in S(sys.stdin.read(),'\n\n')]
n,m=b.shape
o,p=a.shape
z=[]
for i in product(C(R(n),o),C(R(m),p)):
 i=ix_(*i);e=b[i]
 if all(a==e):f=copy(b);f[:]='.';f[i]=e;z+=[f]
print len(z)
for x in z:print'\n'.join(map(''.join,x))+'\n'

Output Example

5
a..bb
a..ba
.....
.....

ab.b.
.....
.....
ab.a.

ab..b
.....
.....
ab..a

.....
.abb.
.aba.
.....

.....
a.bb.
.....
a.ba.
\$\endgroup\$
1
\$\begingroup\$

Haskell, 364 chars

m=map
l=length
u=unlines
v=reverse
z=zip[0..]
q s=p(lines s)[]
e i a=[a!!j|j<-i]
main=g.w.q=<<getContents
g x=(print.l)x>>(putStr.u.m u)x
c 0=[[]];c n=let x=m(m(1+))$c(n-1)in x++m(0:)x
p(c:x) a|c==""=(v a,fst$p x[])|1<2=p x(c:a);p[]a=(v a,[])
w(a,b)=[m(\(p,r)->m(\(q,x)->if(elem p i&&elem q j)then(b!!p!!q)else '.')$z r)$z b|i<-c.l$b,j<-c.l$b!!0,a==(m(e j).e i)b]

Ungolfed Version, 716 chars

parse (c:x) a | c == "" = (reverse a, fst$parse x [])
              | otherwise = parse x (c:a)
parse [] a = (reverse a, [])
readMat s = parse (lines s) []

choose 0 = [[]]
choose n = let
  x = map (map (1+))$choose (n-1)
  in x ++ map (0:) x

select ix a = [a!!i | i<-ix]

for = flip map
make b (ix, jx) = 
  for (zip [0..] b) (\(i,r) ->
    for (zip [0..] r) (\(j,x) ->
      if elem i ix && elem j jx
      then b!!i!!j
      else '.'
    )
  )

main = do
  s <- getContents
  let (a, b) = readMat s
      (n, m) = (length b, length.head$ b)
  let ans = [make b (ix, jx) | ix <- choose n, jx <- choose n, 
              a == (map (select jx).select ix$ b)]
  print$ length ans
  putStrLn$unlines.map unlines$ ans
\$\endgroup\$
1
\$\begingroup\$

Ruby 448

class Array
alias t transpose
alias z size
alias e each
alias s select
end

def x
v=[]
while(w=gets.chop).size>0 do
v<<w.split('')
end
v
end

def w(i,j)(0...i).to_a.combination(i-j).to_a end

a=x
n=a.z
a=a.t
o=a.z
b=x
q=b.z
r=b[0].z
w=['.']
y=w*r
z=w*q
f=[]
w(q,n).e{|u|w(r,o).e{|v|
h=b.dup
u.e{|i|h[i]=y}
h=h.t
v.e{|j|h[j]=z}
h=h.t
f<<h if(h.s{|i|i!=y}.t.s{|i|i!=w*n})==a}}
p f.z
puts
f.e{|b|b.e{|i|k='';i.e{|j|(k<<' ')if k.size>0;k<<j}
puts k}
puts}
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.