comment on

Recently I discovered a couple of articles on a news Web site where one author had clearly plagiarized from another. After searching manually for other instances, I realized that this was something that needs to be automated. After doing a bit of research, I decided to write my own software to detect plagiarism. What follows is a rough first attempt at this.

There are two major problems with detecting plagiarism. The first is to collect the documents for comparison. The second is comparing those documents. Initially, I am focusing on the second problem.

My first attempt at the problem detects the plagiarism listed in the articles I found and it also detects some text that I deliberately plagiarized. The current usage is like this:

my $text = Text::Plagiarized->new;
$text->original($original_text);
foreach my $comparison (@comparison_texts) {
  # the following two lines should probably be collapsed to
  # $text->compare($comparison);
  $text->comparison($comparison);
  $text->analyze;
  print $text->percent, $/; # percent of matching sentences
  if ($text->percent > $some_threshold) {
    # arrayref of array refs with [$sentence, $possible_match]
    print Dumper($text->matches);
  }
}
[download]

It can be tested with some hand-crafted plagiarism samples in my use.perl journal. The interface is a bit sloppy and I intend to clean that up, but what I'm looking for now is advice/suggestions for improving this code. (Be gentle, I know there are serious limitations in this.)

package Text::Plagiarized;
$REVISION = '$Id: Plagiarized.pm,v 1.0 2003/07/13 19:15:57 ovid Exp $'
+;
$VERSION  = '0.01';

use 5.006;
use strict;
use warnings;

use String::Approx qw/amatch/;
use Text::Sentence qw/split_sentences/;

sub new {
    my $class = shift;
    my $self = bless {
        original   => {},
        comparison => {},
        matches    => [],
        threshold  => 80,
    } => $class;
}

sub original {
    my ($self, $text) = @_;
    local $_ = $text;
    $self->{original} = {
        text      => $text,
        sentences => [split_sentences($text)],
    };
    return $self;
}

sub comparison {
    my ($self, $text) = @_;
    local $_ = $text;
    $self->{comparison} = {
        text      => $text,
        sentences => [split_sentences($text)],
    };
    return $self;
}

my %percentage = map { $_ => 1 } 0 .. 100; # wow.  This is a cheap hac
+k
sub threshold {
    my $self = shift;
    if (@_) {
        my $num = shift;
        unless (exists $percentage{$num}) {
            require Carp;
            Carp::croak("threshold must be an integer between 0 and 10
+0, inclusive");
        }
        $self->{threshold} = 100 - $num;
    }
    $self->{threshold};
}

sub analyze {
    my $self = shift;
    my @sentences;
    my $threshold = $self->threshold;
    foreach my $sentence1 (@{$self->{original}{sentences}}) {
        foreach my $sentence2 (@{$self->{comparison}{sentences}}) {
            my ($hash1, $hash2) = _hash($sentence1, $sentence2);
            if ($hash1 eq $hash2 || amatch($hash1, ["$threshold%"], $h
+ash2)) {
                push @sentences => [$sentence1 => $sentence2];
                last;
            }
        }
    }
    $self->{matches} = \@sentences;
}

sub matches { shift->{matches} }
sub percent {
    my $self = shift;
    my $precision = shift || 0;
    my $matches = @{$self->matches};
    my $sentences = @{$self->{original}{sentences}};
    sprintf "%.${precision}f" => ($matches/$sentences) * 100;
}

# starts to break down if we have more than 26 different words
# use Unicode characters?
# stop words?
# memoize this
sub _hash {
    my @string = map lc $_ => @_;
    s/[^[:alnum:][:space:]]//g foreach @string;
    s/[[:space:]]+/ /g         foreach @string;
    my %words;
    my $letter = 'a';
    s/(\S+)/
        unless (exists $words{$1}) {
            $words{$1} = $letter;
            $letter++;
        }
        $words{$1}
    /eg foreach @string;
    s/ //g foreach @string;
    return @string;
}

1;
[download]

It works by converting individual words in sentences to one-character tokens (yeah, there's an ugly limit here), joining the tokens in a string and letting String::Approx see how far apart two strings are.

In the future, I plan to add stemming ("people/person", "children/child") and stop words, pretty HTML reports, etc. I also would like to allow people to specify minimum sentence length, different hash functions, how to split the text and which language the text is written in (for stemming, stop words and synonyms). Any advice here would be great.

One thing I would really like to do is handle word substitution. This involves knowing that the following two sentences could be indicative of plagiarism (taken from the link above):

Macbeth is presented as a  mature    man of definitely established cha
+racter.
Macbeth is shown     as an empowered man of well-      established cha
+racter.
[download]

That involves having a list of synonyms. I'm not sure of the best way to approach that, particularly if I'm trying to combine that with stemming since the latter is language specific. Also, perhaps word frequency is important, but I don't know how to account for this, either. Currently, "magnetosphere" and "cat" are equally important in comparison, even though "cat" is a far more common word.

Thanks in advance!

Cheers,
Ovid

New address of my CGI Course.

In reply to Brainstorming session: detecting plagiarism by Ovid

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Perl-Sensitive Sunglasses
	PerlMonks