Perl 如何从列表中删除可以在列表中其他较长行中找到的行？

我有一个文件，

list.txt

，如下所示：

cat
bear
tree
catfish
fish
bear

catfish
tree
bear

我需要删除文档中其他地方已经完全找到的任何行，无论是作为重复行，还是在另一个较长的行中找到的。例如，“熊”和“熊”行相同，因此删除其中一行；“猫”完全可以在“鲶鱼”中找到，因此“猫”被删除。输出如下所示：

cat
bear
tree
catfish
fish
bear

catfish
tree
bear

如何删除所有重复行，包括列表中较长行中的行

到目前为止，我有：

#!/bin/bash
touch list.tmp
while read -r line
do
    found="$(grep -c $line list.tmp)"
    if [ "$found" -eq "1" ]
    then
        echo $line >> list.tmp
        echo $line" added"
    else
        echo "Not added."
fi
done < list.txt

#/bin/bash
touch list.tmp
而read-r行
做
found=“$（grep-c$行列表.tmp）”
如果[“$found”-等式“1”]
然后
echo$line>>list.tmp
echo$行“已添加”
其他的
echo“未添加”
fi
完成

由于子字符串问题，这将非常困难。起初，我想对我的列表进行排序，像

cat

和

catfish

这样的东西会排在一起，但看看这个列表：

bug
bear
calf
catbug
catbear

对这个列表进行排序没有帮助。另外，这个呢

concatenate
cat
bear
bug

我是否省略了

cat

？它已经在单词

连接中了

那么这个呢：

cat
concatenate
bear
bug

在这种情况下，单词cat和concatenate都在列表中，因为cat在concatenate之前是列表中的第一个。因为没有任何单词已经是concatenate的一部分，所以它会进入列表

除非我需要双向检查。是我要添加到列表中的单词，该单词已经在列表中，并且是我正在查看的单词中包含的列表中的单词

这不仅是一个定义不清的问题，而且是一个代码混乱的问题。编码实际上非常简单，但最终会生成一个O2类型的算法。这意味着将列表的大小增加一倍将导致处理时间增加四倍。如果我能在一秒钟内处理100个单词，我需要4秒来处理200个单词，8秒来处理400个单词，16秒来处理800个单词。差不多20秒就能完成1000个单词

这里使用的是你的定义，顺序是重要的。也就是说，如果

cat

在

catbug

之前，两者都在您批准的列表中，但是如果

catbug

在

cat

之前，则

cat

将不在列表中：

#! /usr/bin/env perl
#
use strict;
use warnings;
use autodie;
use feature qw(say);
use Data::Dumper;

use constant {
    LIST_FILE => "text.txt",
};

open my $list_fh, "<", LIST_FILE;
my @approved_list;
while ( my $new_word = <list_fh> ) {
    chomp $new_word;
    my $new_word_in_list = 0;
    for my $word_already_in_list ( @approved_list ) {
        if ( $word_already_in_list =~ /\Q$new_word\E/ ) {
            # Word is already in the list or in a word in the list
            $new_word_in_list = 1;
            last;
        }
    }
    if ( not $new_word_in_list ) {
        push @approved_list, $new_word;
    }
}
say Dumper \@approved_list;

程序看起来更短，似乎只需要一个循环，但是

grep

隐藏了内部循环。为了让grep工作，它仍然需要遍历数组中的每个条目。这就是为什么我决定不使用

grep

，而是使内部循环更加明确

但是，如果我可以用一个字符串而不是数组来保存单词，然后用我可以保证不在单词中的字符来分隔单词，会怎么样？也许我可以在字符串上使用正则表达式。这样会更有效率吗

#! /usr/bin/env perl
#
use strict;
use warnings;
use autodie;
use feature qw(say);
use Data::Dumper;

use constant {
    LIST_FILE => "text.txt",
};

open my $list_fh, "<", LIST_FILE;
my $approved_list = "";
while ( my $new_word = <$list_fh> ) {
    chomp $new_word;
    if ( not $approved_list =~ /\Q$new_word\E/ ) {
        $approved_list = ( $approved_list ) ? "$approved_list\0$new_word" : $new_word;
    }
}
say Dumper split /\0/, $approved_list;

#/usr/bin/env perl
#
严格使用；
使用警告；
使用自动模具；
使用特征qw（例如）；
使用数据：：转储程序；
使用常数{
LIST_FILE=>“text.txt”，
};
打开我的$list_fh，“我可以想出一个相当好的算法。我将用Perl来回答，以保持结果足够有效

对于每个单词，测试它是否是较大单词集中任何单词的子字符串。如果不是，则从该单词的子字符串集中删除所有这些单词，并将该单词添加到该集中

因为这通常意味着在所有值之间循环，所以我们也可以使用数组。为了加快速度，我们将数组按较小的大小进行排序。这允许我们对集合中已经存在的每个单词只测试一次

use strict; use warnings;

my @words;
INPUT:
while (<>) {
  chomp;
  my $len = length;
  my $i = 0;

  # check larger words if they contain $_
  LARGER:
  for ( ; $i < @words ; $i++) {
    last LARGER if length $words[$i] < $len;
    next INPUT if 0 <= index $words[$i], $_; # the word was seen
  }

  # insert the new word
  splice @words, $i++, 0, $_;

  # remove words that are contained in new word
  for ( ; $i < @words ; $i++) {
    splice @words, $i--, 1 if 0 <= index $_, $words[$i]; # $i-- adjusts index for deletion
  }
}
print "$_\n" for @words;

这需要对文件进行两次传递，但应能正常工作：

script.awk的内容
测试：
为了好玩，这里有一个shell脚本版本。不过，我通过使用Perl打印行长度来作弊

#!/bin/sh

touch list.tmp

# Schwartzian transform: add length as prefix for each line,
perl -nle 'print length, "\t", $_' list.txt |
# reverse sort by this prefix,
sort -rn |
# and discard the prefix
cut -f2- |
while read -r line; do
     grep -q "$line" list.tmp && continue
     echo "$line" >>list.tmp
done

如果O（N^2）不困扰您：

#!/usr/bin/env perl

use strict;
use warnings;
use List::MoreUtils qw{any};

my @words;
for my $word (
    sort {length $b <=> length $a}
    do {
        my %words;
        my @words = <>;
        chomp @words;
        @words{@words} = ();
        keys %words;
    }
)
{
    push @words, $word unless do {
        my $re = qr/\Q$word/;
        any {m/$re/} @words;
    };
}

print "$_\n" for @words;

！/usr/bin/env perl
严格使用；
使用警告；
使用列表：：MoreUtils qw{any}；
我的文字；
我发誓(
排序{length$b length$a}
做{
我的%字；
我的@words=；
咀嚼文字；
@单词{@words}=（）；
关键词%；
}
)
{
按@words，$word，除非执行{
我的$re=qr/\Q$word/；
任何{m/$re/}@字；
};
}
为@words打印“$\un”；

如果您想要O（NlogN），您必须使用某种trie方法。例如，使用后缀树：

#!/usr/bin/env perl

use strict;
use warnings;
use Tree::Suffix;

my $tree = Tree::Suffix->new();

my @words;
for my $word (
    sort {length $b <=> length $a}
    do {
        my %words;
        my @words = <>;
        chomp @words;
        @words{@words} = ();
        keys %words;
    }
)
{
    unless ($tree->find($word)){
        push @words, $word;
        $tree->insert($word);
    };
}

print "$_\n" for @words;

！/usr/bin/env perl
严格使用；
使用警告；
使用Tree：：后缀；
my$tree=tree:：后缀->新建（）；
我的文字；
我发誓(
排序{length$b length$a}
做{
我的%字；
我的@words=；
咀嚼文字；
@单词{@words}=（）；
关键词%；
}
)
{
除非（$tree->find（$word））{
推送@words，$word；
$tree->insert（$word）；
};
}
为@words打印“$\un”；
这可能适合您（GNU-sed）：

将文件存储在内存中，然后删除在整个文件中前后重复的单个单词。
到目前为止，您有什么发现？顺便说一句，如果一个单词出现多次，您的代码也会失败（请考虑“shellfish”、“catfish”中的“fish”）。正确的检查方法是
如果grep-q“$line“list.tmp；然后…
如果按长度排序，就像@Amon的回答一样，可以避免比较两种方式的问题。@tripleee如果顺序不重要，按长度排序可以避免顺序问题。您可以将所有处理移到
结尾
块，只需对文件本身进行一次I/O操作即可。处理过程仍然是两次，最终整个文件都会存储在内存中，但是如果输入非常大，可以通过按长度排序来解决这个问题。
#!/usr/bin/env perl

use strict;
use warnings;
use List::MoreUtils qw{any};

my @words;
for my $word (
    sort {length $b <=> length $a}
    do {
        my %words;
        my @words = <>;
        chomp @words;
        @words{@words} = ();
        keys %words;
    }
)
{
    push @words, $word unless do {
        my $re = qr/\Q$word/;
        any {m/$re/} @words;
    };
}

print "$_\n" for @words;

#!/usr/bin/env perl

use strict;
use warnings;
use Tree::Suffix;

my $tree = Tree::Suffix->new();

my @words;
for my $word (
    sort {length $b <=> length $a}
    do {
        my %words;
        my @words = <>;
        chomp @words;
        @words{@words} = ();
        keys %words;
    }
)
{
    unless ($tree->find($word)){
        push @words, $word;
        $tree->insert($word);
    };
}

print "$_\n" for @words;

sed -r ':a;$!{N;ba};s/\b([^\n]+)\n(.*\1)/\2/;ta;s/(([^\n]+).*\n)(\2)\n?/\1/;ta' file