[文本处理] [已解决]试题0.8相似度的题目去除重复？

zhangop9

我在各个网上面收集了很多试题，里面肯定有重复的，我想把重复的删除了。如果用论坛上面删除重复行的办法必须每一行完全一样才能删除。但是每个网站的排版又不尽相同，里面标点符号可能不同，发布的格式也有区别。

举例子：
３１５、发现火灾，应拨打哪个电话报警？(１１９)
４０２、发现火灾，应拨打哪个电话报警？(１１９)
４１２、发现火灾，应拨打哪个电话报警？(１１９)
４１４、发现火灾，应拨打哪个电话报警？(１１９)
１１１３、发现火灾，应拨打哪个电话报警？(１１９)
７０６、饮酒后驾驶机动车的，一次记(１２)分。
１６７４、饮酒后驾驶机动车的，一次记＿＿＿分。(１２)
５３２、水上遇险求救电话号是(１２３９５)。
３２６、水上遇险求救电话号是。(１２３９５)
１２６８、水上遇险求救电话号是()(１２３９５)
８５、水上遇险求救电话号是(１２３９５)

处理后就得到：

３１５、发现火灾，应拨打哪个电话报警？(１１９)
７０６、饮酒后驾驶机动车的，一次记(１２)分。
５３２、水上遇险求救电话号是(１２３９５)。




现在需要对以上合并出来的txt文档进行出来，最终只留下唯一的一行。（注：以上只是举例，真正复制回来试题的可能有上千条。）

http://www.bathome.net/viewthread.php?tid=29652&highlight=%CF%E0%CB%C6

和这个贴子相似，
以下为要处理的文件的一部分

最后引用crlf版主的代码了，函数部分是引用了别人的在原帖中有，运行用了2天时间，最后结果是4200行得出了1400行，与我手动排序后去得结果1700行，相差了300多行。
这个办法太慢，慎用

    Const input = "输入.txt"
    Const output = "输出.txt"
    Const isDebug = False
    Const length = 4

    t=Timer

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(input,1)

    ar = Split(ts.ReadAll,vbCrLf)

    For i=UBound(ar) To 1 Step -1
    	If Not test(ar,i) Then ar(i)=""
    Next

    Set ts = fso.CreateTextFile(output,1)

    For Each a In ar
    	If Len(a) Then ts.WriteLine a
    Next

    If isDebug Then ts.WriteLine timer-t

    Function test(ar,i)
    	Dim j,length
    	
        For j=0 To i-1
            length = Len(ar(i))
            If Len(ar(j))>Len(ar(i)) Then length = Len(ar(j))
            If GetLevenshteinDistince(ar(i), ar(j)) > Sin(2/(Sqr(length)+5)) Then
            	test = False
    			Exit Function
            End If
        Next
        test = True
    End Function 

    Function GetLevenshteinDistince(str1, str2)        '函数引用自：http://bbs.bathome.net/thread-27991-1-1.html
            Dim x, y, A, B, C, K
            Dim l1,l2
            Dim Matrix()
            l1 = l2 = 0
            If Len(str2)>=length Then l1=Len(str2)-length+1
            If Len(str1)>=length Then l2=Len(str1)-length+1
            
            ReDim Matrix(l2, l1)
            
            '初始化第一行和第一列
            For x = 0 To UBound(Matrix, 1)
                    Matrix(x, 0) = x
            Next
            For y = 0 To UBound(Matrix, 2)
                    Matrix(0, y) = y
            Next

            '填充矩阵
            For x = 1 To UBound(Matrix, 1)
                    For y = 1 To UBound(Matrix, 2)
                            If (Mid(str1, Matrix(0, y), 4) = Mid(str2, Matrix(x, 0), 4)) Then
                                    C = Matrix(x -1 ,y - 1)
                            Else
                                    C = Matrix(x -1 ,y - 1) + 1
                            End If
                            
                            A = Matrix(x - 1, y) + 1
                            B = Matrix(x, y - 1) + 1
                            
                            If (A =< B and A =< C) Then Matrix(x, y) = A
                            If (B =< C and B =< A) Then Matrix(x, y) = B
                            If (C =< A and C =< B) Then Matrix(x, y) = C
                    Next
            Next
            
            '计算 LD 值
            If (Len(str1) > Len(str2)) Then
                    K = Len(str1)-length+1
            Else
                    K = Len(str2)-length+1
            End If

            GetLevenshteinDistince = 1 - (Matrix(l2, l1) / K)
    End Function
复制代码

Batcher

一两段代码恐怕搞不定，这需要AI

zhangop9

最好能用vbs,解决，dos看不懂，总行数4200用我引用的那个代码太慢了

Batcher

回复 3# zhangop9


    你这个问题比那个代码解决的问题复杂太多太多啦

ivor

批处理中运行

powershell "gc 输入.txt | group {([regex]::Matches($_,'[\u4e00-\u9fa5]+')).Value -join ''} | %{$_.Group[0]}"
复制代码

zhangop9

谢谢楼上老大

bailong360

看标题还以为是真的通用相似文本的去重
深感样本的重要性

bailong360

没完成可以回帖说一遍, 上面有人给了代码, 执行效果怎么样? 哪里需要改进?

什么都不说, 只标一句"还没有完成", 也太不礼貌了吧?

zhangop9

我不会那种代码，所以没有试。
我引用的贴子那个vbs 版试过了，用了2天时间，4200行去重后，得1400，
实际情况我手动通过排序后去重，有1700行，相差了300行。

Batcher

回复 10# zhangop9


试试这样执行6楼的代码：
http://bbs.bathome.net/thread-31071-1-1.html

如果遇到问题，把你的测试用例、测试结果打包上传让他帮你再看看。

bailong360

简单写了一个

use bk_tree::{BKTree, Metric};
use jieba_rs::Jieba;
use lazy_static::lazy_static;
use regex::Regex;
use simhash::simhash_stream;
use std::borrow::Cow;
use std::fs::File;
use std::io::{self, BufRead, BufReader};

struct Hamming;

impl Metric<u64> for Hamming {
    fn distance(&self, a: &u64, b: &u64) -> u64 {
        (a ^ b).count_ones() as u64
    }
}

fn strip(s: &str) -> Cow<str> {
    lazy_static! {
        static ref RE: Regex = Regex::new(r"[^\u4e00-\u9fa5]+").unwrap();
    }
    RE.replace_all(s, "")
}

fn strip_file(path: &str, tolerance: u64) -> Result<(), io::Error> {
    let jieba = Jieba::new();
    let mut bk_tree = BKTree::new(Hamming);

    let file = BufReader::new(File::open(path)?);
    for line in file.lines() {
        let line = line?;
        let stripped = strip(&line);
        let words = jieba.cut(&stripped, false);
        let hash = simhash_stream(words.into_iter());
        if bk_tree.find(&hash, tolerance).count() == 0 {
            println!("{}", line);
            bk_tree.add(hash);
        }
    }
    Ok(())
}

fn main() {
    let args = std::env::args().collect::<Vec<String>>();
    if args.len() != 3 {
        println!("Usage: {} FILENAME TOLERANCE", args[0]);
    } else {
        match strip_file(&args[1], args[2].parse::<u64>().unwrap()) {
            Err(e) => eprintln!("ERROR:\n{}", e),
            _ => (),
        }
    }
}
复制代码

binary 下载地址: https://send.firefox.com/downloa ... -VFiI0I4NP9Rh7rnnXg

用法举例 tmp2.exe test.txt 16
16 是最高能容忍的相似度, 最高 64

试了一下效果还行, 没去掉的一般都是省略了大段文字的缘故
举例

１７、集成电路自１９５９年被发明以来，……如我国华为公司设计的手机芯片“麒麟９８０”就采用了(７)纳米的最新工艺。
３７１、集成电路自１９５９年被发明以来，其发展的总趋势是：在单位面积的芯片上集成的电子元件越来越多，而连接这些元器件的线宽却越来越窄。集成电路现在正在向更窄的线宽迈进。如我国华为公司设计的手机芯片“麒麟９８０”就采用了()纳米的最新工艺。(７)
复制代码

只支持 UTF-8 文件

zhangop9

题库生成小程序，功能大致是：导入数据-整理剔重-生成拼音索引-生成数据文件.

bailong360

回复 12# bailong360

这个阈值感觉不好找, 除非先把文本按长度分类一下

可能根据公共子序列长度来判定相似度会更好一点

或者干脆不分词其实也行...

zhangop9

本人的系统旧，是winxp所以上面下载的tmp2.exe跑不起来

POWERSHELL也用不了，只能用最基本的dos或者vbs