Find columns where all characters are the same

Question

I came across this question on SO and thought it'd make a nice golf challenge. So here it is:

Challenge:

Write a program that reads a sequence of character strings, one per line, and outputs a list of all positions where each string has the same character.

Input and output:

The input consists of one or more lines of printable non-whitespace ASCII characters, each followed by a newline. You may assume that all input lines have the same length. The newline is not to be considered part of the input (i.e. you should not output it as a matching character).

Example input (shamelessly stolen from the SO question):

abcdefg
avcddeg
acbdeeg

After reading the input, your program should print the positions of each matching column and the characters they contain. (Your program may, but need not, stop reading further input if it can determine early that there are no matching columns.) Any reasonable output format is permitted; in particular, you may use either 0-based or 1-based indexing for the positions.

Example output for the above input (using 0-based indexing):

0: a
3: d
6: g

Scoring:

This is code golf, so shortest answer wins. In the event of a tie, fractional tie-breaker chars may be awarded for additional features:

• −½ chars for correctly handling input lines of unequal length. (Output should not contain positions past the end of the shortest input line.)
• −¼ chars for correctly handling input consisting of arbitrary UTF-8 encoded Unicode characters.

For inspiration, you may find some ungolfed solutions at the SO question (see above).

Clarifications:

• Simply concatenating the positions and characters, as in 0a3d6g, does not count as "reasonable output". You should provide some kind of separator (such as a space) between each element of the output so that it can be parsed unambiguously.

• The input will be provided on the standard input stream (stdin), or using whatever text file input mechanism is most natural to your language of choice. (If your chosen language doesn't have a natural mechanism for file input, do whatever seems closest in spirit.)

• The input ends when there is no more data to be read (i.e. when an end-of-file condition occurs). If you wish, you may require that the input be terminated by a blank line (which you then should not count as part of the input, obviously). If you do so, please mention it in your answer so that others can provide correct input for testing.

• Every input line, including the last one, ends with a newline character. Your answer must not report this newline as a matching column. (It's fine if your solution can also handle input where the last line doesn't end in a newline, but that's not required.)

Answer 1

APL, 25 characters

∩/{0=⍴⍵:⍬⋄(⊂⍵,⍨¨⍳⍴⍵),∇⍞}⍞

I used Dyalog APL (version 13) as my interpreter. It handles both inputs of unequal length and Unicode (UTF-8) characters.

Examples:

      ∩/{0=⍴⍵:⍬⋄(⊂⍵,⍨¨⍳⍴⍵),∇⍞}⍞
abcdefg
avcddeg
acbdeeg

  1 a  4 d  7 g  

      ∩/{0=⍴⍵:⍬⋄(⊂⍵,⍨¨⍳⍴⍵),∇⍞}⍞
test日本
blat日本国foo

  4 t  5 日  6 本 

Explanation, somewhat from right to left:

• The main chunk of this answer is the direct function (basically, anonymous function), defined within the curly braces. Its right argument is specified by ⍵.
  • 0=⍴⍵:⍬ is our first expression, and it checks if we've gotten an empty line (i.e., we are done). It uses a guard (a familiar construct to many functional programmers) to conditionally execute the expression to the right of the colon. In this case, if 0 is equal to the shape/length (⍴) of the right argument, we return the empty set (⍬).
  • ⋄ separates the two expressions within the function. If the previous expression didn't get evaluated (and thus didn't return anything), we move to the next expression.
  • We recursively call the function using the self-reference function (∇). The argument to the function is a line of non-evaluated user input, given by quote-quad (⍞).
  • ⊂⍵,⍨¨⍳⍴⍵ creates pairs for each character in the string, where each pair's first element is its position in the string, and its second element is the character.
  • ⍳⍴⍵ gives a vector from 1 to ⍴⍵, or the length of the input string.
  • ⍵,⍨¨ applies the commuted concatenation function (,⍨) to each (¨) element to its left (⍵, in this case the user's input) and right. Commuting the concatenation function causes its left and right arguments to be swapped.
  • Finally, we enclose the result using ⊂, so that we can differentiate between lines of input.
• We initially feed our function with user input (⍞).
• Finally, we reduce (/) our resulting vector of vectors of pairs using the intersection function (∩), yielding the pairs that are found in all of the sub-vectors.

Answer 2

Golfscript (28 chars)

n/zip:^,,{.^=.&.,1>{;;}*}%n*

There are character set issues when piping Unicode through, so no quarter-point bonus.

Answer 3

J, 57 51 44 40 characters

,.&.>y;y{{.z[y=.I.*/2=/\]z=.];._2]1!:1]3

I'm getting there slowly but surely. This is still far from ideal though I think.

I felt sure that using a hook would be the answer but unfortunately not (44 chars):

,.&.>((];({{.)~)([:I.[:*/2=/\]))];._2]1!:1]3

I may need a completely different method to get any shorter.

Answer 4

Python 2, score 81.5 (116 94 86 83 82 bytes minus bonus)

import sys
i=0
for x in zip(*sys.stdin)[:-1]:
 i+=1
 if len(set(x))<2:print i,x[0]

Answer 5

Haskell, 64 characters

main=interact$show.foldl1(filter.flip elem).map(zip[0..]).lines

Handles lines of unequal length. Unicode support depends on the current locale settings.

Example output:

[(0,'a'),(3,'d'),(6,'g')]

Answer 6

(Bash) Shell Scripting, 105 characters

If anyone has some more tricks for this, please fill free to comment!

for((i=1;i<`tail -1 $1|wc -c`;i++))do
x="cut -c$i $1";y=`$x`;[ `$x|uniq|wc -l` = 1 ]&& echo $i ${y:3};done

Result:

1 a
4 d
7 g

Answer 7

Perl, 87 characters (−½ char tie-break bonus)

Here's a golfed version of my own solution from the SO thread:

chomp($a=$b=<>);$a&=$_,$b|=$_ for<>;@$_=$$_=~/./sgfor a,b;$b[$i++]eq$_&&say"$i:$_"for@a

Unlike the SO version, this one uses 1-based indexes for the output. It uses the Perl 5.10 say feature, so needs to be run with perl -M5.010 (or with perl -E).

Like the SO version, this code handles variable-length lines, and would handle arbitrary Unicode input if the standard input and output were in UTF-8 mode. Alas, by default they're not, unless one specifies the non-free -CS command line switch. Thus, it earns the −½ char bonus, but not the −¼ one.

Edit: +1 char to fix a bug: just because the input strings don't contain line feeds doesn't mean they can't end up in $a (e.g. "+" & "J" eq "\n").

Answer 8

T-SQL

SELECT N.number, letter = MIN(SUBSTRING(L.line, N.number, 1))
FROM Lines AS L
INNER JOIN master.dbo.spt_values AS N ON N.type = 'P'
WHERE N.number BETWEEN 1 AND (SELECT MAX(LEN(L2.line)) FROM Lines AS L2)
GROUP BY N.number
HAVING COUNT(DISTINCT SUBSTRING(L.line, N.number, 1)) = 1
ORDER BY N.number

Answer 9

Q, 32

{a!((*:)x)a:(&)1=(#:')(?:')(+)x}

usage

q){a!((*:)x)a:(&)1=(#:')(?:')(+)x}[("abcdefg";"avcddeg";"acbdeeg")]
0| a
3| d
6| g

K, 22

The above solution can be reduced to 22 by writing it completely in K rather than passing K functions to a Q interpreter, reducing the number of parentheses required.

{a!@[*x]a:&1=#:'?:'+x}

Answer 10

Scala 115107: (−¼ for handling UTF-8)

io.Source.stdin.getLines.map(_.zipWithIndex).toList.flatten.groupBy(_._2).map(_._2.toSet).filter(_.size==1)

ungolfed, and Source.fromFile ("f") instead of stdin for better testability:

io.Source.fromFile ("f").
  getLines.map (_.zipWithIndex).
    toList.flatten.groupBy (_._2). 
      map (_._2.toSet).
        filter (_.size==1)

Result:

List(Set((a,0)), Set((g,6)), Set((d,3)))

Thanks to Gareth for the reduction of size 8 for using stdin.

Answer 11

VBA (307.25 284 - 0.75 bonus = 283.25)

I know this has already been won, but here's my shot (not reading a file, just a string - needs to have the io added). I like that I got to use l() recursively. I usually don't have a need for recursion my real-life programming. I only did so much testing, but I believe this covers the unicode bonus point stipulation. It also assumes vbCr is the line terminator. This may not translate to all systems because of that.

Code:

Function a(i)
b=Split(Left(i,Len(i)-1),vbCr):c=UBound(b):For q=1 To Len(b(c)):d=Mid(b(c),q,1):If l(b,c,q,d) Then a=a & q & ": " & d & vbCr:Next
End Function
Function l(m, n, o, p)
If n+1 Then l=IIf(o<=Len(m(n)),Mid(m(n),o,1)=p,0) And l(m,n-1,o,p) Else l=Mid(m(n+1),o,1)=p
End Function

---

Example input/output:

Debug.Print a("abcdefghijklmnop" & vbCr & "abcdefg" & vbCr & "abcabcghijkl" & vbCr)

---

1: a
2: b
3: c
7: g

Answer 12

05AB1E (legacy), score: \$9\frac{1}{4}\$ (10 bytes - \$\frac{3}{4}\$ for both bonuses)

|ø€Ùā‚øʒнg

Outputs with 1-based indexing.

Try it online.

Uses the legacy version, because ø worked with a list of strings whereas the new version would need an explicit €S to convert each inner string to a list of characters first. It does mean I can't use the builtin .ā of the new version though, which pairs each item with its 0-based index. As alternative I use ā‚ø to pair with its 1-based index.

In the new 05AB1E version this would therefore have been 11 bytes: |€Sø€Ù.āʒнg - Try it online (with 0-based indexing instead).

Explanation:

|           # Push all input-lines as a list
 ø          # Zip/transpose; swapping rows/columns,
            # which implicitly discards any trailing characters for the 1/2 bonus
  €Ù        # Uniquify each inner string/character-list
    ā       # Push a list in the range [1, length] (without popping the list of strings)
     ‚      # Pair it with the list of strings
      ø     # Zip/transpose again, which pairs each string with its 1-based index
       ʒ    # Filter this list of string-index pairs by:
        н   #  Where the first item (the string)
         g  #  Has a length equal to 1 (note: only 1 is truthy in 05AB1E)
            # (after which the result is output implicitly)

Answer 13

PHP, 123 127 :(

I'm not happy with it (there's bound to be improvements to be had), but here goes:

<?$a=$b=trim(fgets(STDIN));while($l=fgets(STDIN)){$a&=$l;$b|=$l;}$n=-1;while(@$a[++$n]){echo$a[$n]!=$b[$n]?'':"$n:{$a[$n]}\n";}

Proof it works.

If anyone can think of a more clever way of initializing $a and $b, please let me know. Originally I had $a=$b=$n='' and $b eventually was correct, but [empty] & [anything] == [empty], so $a never had content.

---

Edit: Had to fix newline handling (+6) but dropped closing tag (-2).

Answer 14

JavaScript (125 134 140)

for(i=s=[];I=s[++i]=prompt(o='');S=I);for(c=-1;w=r=++c<S.length;o+=r?c+':'+C+'\n':'')for(C=S[c];w<i;)r&=s[w++][c]==C;alert(o)

Demo: http://jsfiddle.net/Fv7kY/4/

Edit 1: Rearrange loops to avoid braces. Initialize i with [] to combine with s. Move w increment into expression.

Edit 2: Set S=I to capture last entered word and save using s[1]. Combine r=1 and ++c<S.length. Set C=s[c] in inner loop and compare to C instead of previous and next words to shorten expression s[w][c]==s[w++][c] to just s[w++][c]==C. Saved a total of 9 characters. Also set w=r=... because when that's true w=1 which is what we need to initialize w with.

Answer 15

Ruby (71)

a,*s=*$<.lines
(a.size-1).times{|i|s.all?{|t|t[i]==a[i]}&&p([i,a[i]])}

output:

[0, "a"]
[3, "d"]
[6, "g"]

Answer 16

Common Lisp, 183 165 characters

(let((l(loop for m =(read-line)until(equal m "")collect m)))(loop for c across(car l)for i from 0 if(null(remove c(mapcar(lambda(y)(char y i))l)))collect(list i c)))

Readable format:

(let ((l (loop for m = (read-line) until (equal m "") collect m)))
  (loop for c across (car l)
        for i from 0 
        if (null (remove c 
                         (mapcar (lambda(y) (char y i))l)))
        collect(list i c)))

Enter this directly into the REPL and enter lines, terminating with an empty line.

Answer 17

C, 126 chars

char a[999],b[999];main(i){for(gets(a);gets(b);)for(i=0;b[i];++i)a[i]^b[i]?a[i]=0:0;
while(i--)a[i]&&printf("%d:%c\n",i,a[i]);}

I've been staring at this but I just can't make it smaller. A new approach may be needed.

(No bonus points; it only handles differently-sized lines if the first line is the shorter one.)

Answer 18

Burlesque, 16 bytes

ln)XXtpzif{[~sm}

Try it online!

ln   # Split to lines
)XX  # Split each line to chars
tp   # Transpose
zi   # Zip with indices
f{   # Filter for
 [~  # Tail (i.e. chars)
 sm  # All the same
}

Answer 19

T-SQL, 134 bytes

This can handle input lines of unequal length

Using 0-based indexing

SELECT n,max(z)FROM(SELECT 
substring(x,number+1,1)z,abs(number)n,*FROM spt_values,@)t
GROUP BY n
HAVING max(z)=min(z)and n<max(len(x))

Try it online

Answer 20

JavaScript (Node.js), 67 bytes (Anonymous function)

a=>[...a[0]].reduce((p,c,i)=>p+(a.every(s=>s[i]==c)?i+c+" ":""),"")

Try it online!

Input as array of lines, output in form "0a 2g 5p " etc

Answer 21

C# with .NET 4 (280)

using c=System.Console;class P{static void Main(){char[]a=c.ReadLine().ToCharArray();int r,i,l=a.Length;m:i=0;n:r=c.Read();if(r>0&&r!=10&&r!=13){if((int)a[i]!=r)a[i]='\0';i++;goto n;}for(;i>0&&i<l;)a[i++]='\0';if(r>0)goto m;for(i=0;i<l;i++)if(a[i]!='\0')c.WriteLine(i+":"+a[i]);}}

• 1 line, 280 characters
• Includes all necessary using statements and Main method.
• Program does not require an empty line at the end, but will accept it
• Empty lines are ignored
• Handles input strings of any length.
• Reserves output until the end (whereas the original answer provided incremental output)

Readable version

    char[]a=c.ReadLine().ToCharArray();
    int r,i,l=a.Length;
    m:
    i=0;
    n:
    r=c.Read();
    if(r>0&&r!=10&&r!=13){
        if((int)a[i]!=r)
            a[i]='\0';
        i++;
        goto n;
    }
    for(;i>0&&i<l;)
        a[i++]='\0';
    if(r>0)
        goto m;
    for(i=0;i<l;i++)
        if(a[i]!='\0')
            c.WriteLine(i+":"+a[i]);

---

Original answer

using c=System.Console;class P{static void Main(){char[]a;var b=c.ReadLine();a=b.ToCharArray();while(b!=""){for(int i=0;i

• 1 line
• 207 characters
• Includes all necessary using statements and Main method.
• Program ends when an empty line is entered.
• Does not handle input strings that are shorter than the first.

---

Readable version:

    static void Readable()
    {
        char[]a;
        string b=System.Console.ReadLine();
        a=b.ToCharArray();
        while(b.Length>0)
        {
            for (int i = 0; i < a.Length; i++)
            {
                if (a[i] != b[i])
                {
                    a[i] = '\0';
                }
                else
                {
                    System.Console.WriteLine(i+": "+a[i]);
                }
            }
            b=System.Console.ReadLine();
        }
    }

Answer 22

python 122 characters:

print("\n".join([str(i)+':'+str(x[0]) for i,x in enumerate(zip(*[tuple(x) for x in input().split()])) if len(set(x))<2]))

Answer 23

Ruby (242)

s = %w{ abcdefg avcddeg acbdeeg aejdjeggd }
cols = []
s.sort{ |a, b| b.size <=> a.size }[0].size.times do |i|
  uneq=true
  l = s[0][i]
  s.each { |w| uneq = false if l != w[i] }
  cols << [l, i] if uneq
end
cols.each { |c| puts c.join('|') }

Answer 24

C#

List<string> strings = new List<string> { "abcdefg", "avcddeg", "acbdeeg", "aejdjeggd" };
var transposes = from index in Enumerable.Range(0, strings.First().Length)
                 select new string((from s in strings select s[index]).ToArray());
int i = 0;
foreach(string transpose in transposes)
{
   if (transpose.Distinct().Count() == 1)
     Console.WriteLine("{0}: {1}", i , transpose[0]);
   i++;
}