Perl

最大化數據集的覆蓋範圍

  • October 16, 2019

我有以下格式的數據集。欄位 1 列出一個標識符，欄位 3 列出數據點，欄位 2 對這些數據點進行計數。

id1      5        E1, E2, E3, E4, E5
id2    4        E3, E4, E5, E6
id3 2        E6, E7
id4    1        E8
id5    2        E1, E8

我需要一個腳本，當限制為 X 個標識符時，它能夠告訴我哪些 X 標識符將覆蓋最大數量的數據點，非冗餘（但在能夠時優先考慮冗餘覆蓋，例如 id5 將無論如何總是選擇超過 id4）。此外，我想知道將涵蓋的總數據點的比例以及將涵蓋哪些標識符。

我更喜歡 perl 解決方案，但如果這可以通過另一種方式更好地完成，那麼我不受限制。

如果我選擇 X=3 標識符，這是一個範例輸出：

id1, id3, id5    8/8        E1, E2, E3, E4, E5, E6, E7, E8

或者，如果我採用 X=2 標識符：

id1, id3    7/8        E1, E2, E3, E4, E5, E6, E7

將選擇 id1 是因為它本身涵蓋了最多的數據點。id2 覆蓋次之；但是，除了其中一個數據點之外的所有數據點都已被 id1 覆蓋。id3 非冗餘地覆蓋了下一個最多的數據點，因此它成為第二選擇。id4 和 id5 都添加了一個非冗餘數據點；但是，id5 額外添加了一個冗餘數據點，因此選擇它而不是 id4。

我的數據集包括大約 1200 萬個標識符和約 350 萬個非冗餘數據點，因此編寫腳本以盡可能乾淨地執行將是可取的（一些標識符與超過 9000 個數據點相關聯）。我希望我將用於 X 的實際值將介於 X=12 和 X=40 之間。

這是我在這裡的第一個問題，它（至少對我而言）是一個相當複雜的問題，所以我希望我已經對所有內容進行了格式化和解釋，足以讓我的問題得到解決。謝謝您的幫助！

#!/usr/bin/perl

use strict;
use Set::Tiny;

my $max = shift;

# A set to hold all unique data_points:
my $all_dps = Set::Tiny->new();
# hash of sets. key is id, val is the set of data_points for that id:
my %ids = ();
# hash containing the number of data_points for each id:
my %counts = ();

# read the input file, parse into %ids
while(<>) {
 chomp;
 my ($id,$count,$dp) = split /\s+/,$_,3;            #/
 $ids{$id} = Set::Tiny->new(split /\s*,\s*/, $dp);  #/
 # The "#/" commentS exists solely to fix U&Ls perl syntax highlighting
 $counts{$id} = $count;

 $all_dps = $all_dps->union($ids{$id});
};

my $total_dps = keys %{ $all_dps };

# array to hold the list of output ids:
my @idlist=();
# set to hold the output data points:
my $data_points = Set::Tiny->new();
# count of output data points:
my $dpcount=0;

# stop when id list is = max. or when the count of output data points is equal
# to he total data points. or when there are no non-empty keys left.
while ((@idlist < $max) && ($dpcount < $total_dps) && (keys %ids > 0)) {

 # sort the counts hash by value.
 my @counts = ( sort { $counts{$b} <=> $counts{$a} } keys %counts );

 # add the sets from the id with the highest count to the output set.
 $data_points = $data_points->union($ids{$counts[0]});
 # and add that id to the output id list
 push @idlist, $counts[0];
 $dpcount = keys %{ $data_points };

 foreach (keys %ids) {
   my $diff = $ids{$_}->difference($data_points);

   if (keys %{$diff} == 0) {
     # delete ids with no difference from the current data_points set.
     delete $ids{$_};
     delete $counts{$_};
   } else {
     # add the intersection count as a decimal fraction so ids with more
     # dupes sort slightly higher.
     my $intersection = $ids{$_}->intersection2($data_points);
     $counts{$_} = (keys %{$diff}) . "." .  (keys %{$intersection});
   };
 };
};

print join(",",@idlist) .  "\t$dpcount/$total_dps\t" .
 join(",",(sort keys %{ $data_points })) .  "\n";

該腳本首先讀入整個輸入文件並使用 perl Set::Tiny模組建構一個“集合”（即 perl 雜湊）和一個包含每個 id 的集合元素計數的雜湊。 Set::Tiny可以從上面的 CPAN 連結獲得，或者它可能已經為您的發行版打包（例如在 Debian: 上sudo apt-get install libset-tiny-perl）。

然後，它反复嘗試通過以下方式建構最大的輸出集：

  • 按值對目前%counts雜湊進行排序
  • 將最大集添加到輸出集（即聯合）
  • 刪除沒有任何數據點但尚未在輸出集中的所有集（和相關計數） 。
  • 將未刪除的 id 的計數雜湊更新為等於不在輸出集中的數據點的數量加上一個小數部分，該小數等於在輸出集中的數據點的數量（以便具有更多冗餘的 id數據點排序高於那些較少或沒有的）。

這本質上是您在評論中描述為“笨拙”的算法。我更喜歡將其視為“直截了當”或“蠻力”:-)

我嘗試了幾種不同的優化方法，但我找不到更有效的方法。這並不一定意味著沒有。這只是意味著我找不到它。主要困難是要求優先考慮具有更多冗餘數據點的 id。

無論如何，我沒有包含數百萬條目的輸入文件，所以我無法進行任何計時測試。我很想知道它在完整數據集下執行的速度有多快。以及如果您使用 MLDBM 或下面提到的類似功能，它的性能如何。

該腳本將使用大量 RAM。如果您有 1200 萬個 ID，它將使用大約12 MB * (the average id string length + the average data points length per id). 如果您的可用 RAM 少於 32GB 甚至 64GB，這可能是個問題。

如果腳本確實超出了您的可用 RAM 並導致交換抖動，您可以使用MLDBM模組或其中一個Tie::模組將 %ids 雜湊（也可能是 %counts 雜湊）儲存在數據庫中而不是記憶體中。例如 Tie::DBI使用 sqlite 或 mysql 或 postgresql 等數據庫。

使用MLDBMorTie::模組可能不會更快（儘管它可能會更快，因為它不會破壞 RAM 和交換），但是 a）由於記憶體不足，腳本在完成之前死掉的可能性要小得多，並且 b）它對系統上執行的其他程序的危害要小得多（否則可能會因記憶體不足而被殺死）。

例如，在my %ids=()和my %counts=()行之後立即添加以下內容以將 Berkeley DB 文件用於 %ids：

      use MLDBM qw(DB_File Storable);
      use Fcntl;
      my $id_db = tie %ids, 'MLDBM', './ids.db', O_CREAT|O_RDWR, 0640 or die $!;

也許這也是，將 %counts 雜湊綁定到數據庫數據庫：

      my $count_db = tie %counts, 'MLDBM', './counts.db', O_CREAT|O_RDWR, 0640 or die $!;

樣本輸出：

我將此腳本保存為ryan.pl，使其可執行chmod +x ryan.pl並執行為：

$ ./ryan.pl 1 input.txt
id1     5/8   E1,E2,E3,E4,E5

$ ./ryan.pl 2 input.txt
id1,id3 7/8   E1,E2,E3,E4,E5,E6,E7

$ ./ryan.pl 3 input.txt
id1,id3,id5     8/8   E1,E2,E3,E4,E5,E6,E7,E8

在 U&L 上很難看到，但輸出是製表符分隔的。

一些初步測試（一個 145MB 的輸入文件有 100 萬行，每個包含 1 到 20 個隨機字典單詞作為 data_points）表明我最初對記憶體使用的猜測是完全錯誤的。

將這些集合載入到 RAM 大約需要 23 分鐘（這只是載入數據文件而不對其進行處理），並且在我的 Phenom II 1090T 上消耗了 1GB RAM（安裝了 32GB RAM，但只有大約 8GB 可用）。

使用 MLDBM 載入數據文件大約需要 21 分鐘。它創建了一個323MBids.db和 78MB 的文件。counts.db這樣做時它使用了恆定的 9.3MB RAM。

所以，我猜你的數據文件至少是那個大小的 10-20 倍，所以不太可能適合 RAM。使用 MLDBM，最好在 NVME SSD 上以獲得最佳性能。

既然你要求了，這裡是腳本的更新版本。也許你可以從中提取一些有用的想法。

它至少比以前的版本快兩倍。只用了 15 分鐘，不僅讀取了我的 145MB 測試文件，而且處理了它並生成了 12 個標識符的結果——我可以通過其他優化嘗試得到的最好結果是大約 33 分鐘。

IMO 仍然完全不適合非常大的數據集，例如您提到的 104GB 文件。

但是，如果您仍想嘗試它，我建議您將其拆分為兩個腳本。一個填充 .db 文件（包括while (<>)循環在內的所有內容），以及第二個腳本（該while (<>)循環之前的所有內容，但當然沒有unlink語句，然後幾乎所有內容）處理 .db 的副本文件。

這是因為至少有一半的執行時間用於讀取文本文件並將其儲存在 .db 文件中。對於多次執行，僅複製 .db 文件並處理副本要比在每次執行時從頭開始生成它們要快得多**。**

（需要副本，因為腳本在處理數據時會修改和刪除 %ids 和 %counts 雜湊中的條目。處理副本可讓您快速將 .db 文件重置為起始條件）

#!/usr/bin/perl

use strict;
use Set::Tiny;

# The first arg is the maximum number of identifiers we want.
# Any remaining args (and stdin) are input.
my $max = shift;

# hash of sets. key is id, val is the set of data_points for that id:
my %ids = ();

# hash containing the number of data_points for each id:
my %counts = ();

# The following two arrays exist to minimise memory usage, so that datapoints
# which appear in multiple IDs are stored in %id by reference rather than
# value.
#
# Array containing each datapoint indexed numerically
my @dp=();
# Hash containing each datapoint indexed by value
my %seen=();

use BerkeleyDB ;
use MLDBM qw(BerkeleyDB::Btree Storable);

# delete the .db files
unlink './ids.db';
unlink './counts.db';
unlink './seen.db';
unlink './dp.db';

# use MLDBM for the %ids hash - we need to serialise the Set::Tiny
# data structures.
tie %ids,    'MLDBM', -Filename => 'ids.db',    -Flags => DB_CREATE or die "Cannot open database 'ids.db': $!\n";

# It's faster to use BerkeleyDB directly for the other arrays (they
# contain scalar values, so there is no need for serialisation)
tie %counts, 'BerkeleyDB::Btree', -Filename => 'counts.db', -Flags => DB_CREATE or die "Cannot open database 'counts.db': $!\n";
tie %seen,   'BerkeleyDB::Btree', -Filename => 'seen.db',   -Flags => DB_CREATE or die "Cannot open database 'seen.db': $!\n";
tie @dp,     'BerkeleyDB::Recno', -Filename => 'dp.db',     -Flags => DB_CREATE or die "Cannot open database 'dp.db': $!\n";

my $total_dps=0;
# read the input file, parse into %ids
while(<>) {
 chomp;
 # split input line on spaces with max of 3 fields.
 my ($id,$count,$data) = split(/\s+/,$_,3);   #/

 # split $data by commas
 my @data = split(/\s*,\s*/, $data);          #/
 my $data_count = @data;
 my @data_by_idx = ();

 # convert @data to  @data_by_idx
 for (0..$#data) {
   if (!defined($seen{$data[$_]})) {
     # We haven't seen this datapoint before, so add it to both @dp
     # and %seen.
     $dp[++$total_dps] = $data[$_];
     $seen{$data[$_]}=$total_dps;
   };
   # add the datapoint's index number to @data_by_idx
   push @data_by_idx, $seen{$data[$_]};
 };
 $ids{$id} = Set::Tiny->new(@data_by_idx);

 $counts{$id} = $count;
};

# array to hold the list of output ids:
my @idlist=();
# set to hold the output data points:
my $data_points = Set::Tiny->new();
# count of output data points:
my $dpcount=0;

my $biggest_id='unknown';
my $biggest_count=0;

# stop when id list is = max. or when the count of output data points
# is equal to he total data points. or when there are no non-empty
# keys left.
while ((@idlist < $max) && ($dpcount < $total_dps) && (keys %ids > 0)) {

 # find the id with the most data points without using sort().
 if ($biggest_id eq 'unknown') {
   foreach (keys %counts) {
     if ($counts{$_} > $biggest_count) {
       $biggest_count = $counts{$_};
       $biggest_id = $_;
     };
   };
 };

 # add the sets from the id with the highest count to the output set.
 $data_points = $data_points->union($ids{$biggest_id});
 # and add that id to the output id list
 push @idlist, $biggest_id;
 $dpcount = keys %{ $data_points };

 $biggest_count=0;

 foreach (keys %ids) {
   my $diff = $ids{$_}->difference($data_points);

   if (keys %{$diff} == 0) {
     # delete ids with no difference from the current data_points set.
     delete $ids{$_};
     delete $counts{$_};
   } else {
     # add the intersection count as a decimal fraction so ids with more
     # dupes sort slightly higher.
     my $intersection = $ids{$_}->intersection2($data_points);
     $counts{$_} = (keys %{$diff}) . "." .  (keys %{$intersection});
     # find the new id with the most data points.
     if ($counts{$_} > $biggest_count) {
       $biggest_count = $counts{$_};
       $biggest_id = $_;
     };
   };
 };
};

print join(",",@idlist) .  "\t$dpcount/$total_dps\t";
print join (",", (map $dp[$_], keys %{ $data_points })), "\n";

至於評論中的其他問題（即如何拆分數據以在集群上進行多核處理），我不知道。

我不認為這是一項適合對數據進行分片、並行處理分片然後組合結果的任務，因為 AFAICT 任何此類過程都需要訪問整個數據集才能產生任何有意義的輸出。

這個任務是 I/O 密集型的，而不是 CPU 密集型的——它在計算上並不困難或“昂貴”，它只是需要大量時間（和記憶體）來讀取和處理龐大的數據集。

不要相信我的話，想。我對您的數據或您要做什麼幾乎一無所知。a) 更好地理解您的數據集並且 b) 知道您要從中獲得什麼的人可能能夠有效地對您的數據進行分片，並且仍然能夠組合結果集。

引用自：https://unix.stackexchange.com/questions/544537

相關問答

Perl

DBD/DBI：如果程序被分叉，則崩潰

  • January 5, 2016
檢視問答
Debian

perl 在 debian 中寫了多少程式碼？

  • October 15, 2022
檢視問答
Regular-Expression

如何將多個正則表達式壓縮為單行？

  • August 25, 2022
檢視問答
Shell

clusterssh：防止視窗按字母順序排列

  • August 24, 2022
檢視問答
Perl

Perl：s的速度///

  • July 31, 2022
檢視問答
Sed

使用 perl 進行條件替換

  • June 11, 2022
檢視問答