Question

Я пытаюсь проанализировать и проанализировать контракты, которые получает министерство обороны, сопоставляя их с другими экономическими данными, которые я уже получил.Все это общедоступно на Defense.gov .

Однако они не занесены в таблицу, а соответствующая информация (Подрядчик, Дата, Имя, Идентификатор контракта и т. Д.)написано в форме абзаца.Я пытался передать данные в CSV, чтобы я мог выполнить их через R.

Обычно я просто извлекаю данные на основе тегов вокруг данных, но кто-нибудь может порекомендовать более простой способ полученияэти данные?Я уже извлек данные с помощью wget, но я просто пытаюсь извлечь их.

Это пример типичного абзаца :

Компания Booz Allen Hamilton, Inc., Херндон, Вирджиния, получает контракт стоимостью $ 9 450 189 с фиксированной платой и бессрочными поставками, требования к исследованиям и разработкам, чтобы завершить / выполнить оценку задач армейского ведения боевых действий и интегрированного обучения.планы, итоговые отчеты об экспериментах и планы экспериментов.Армия США будет использовать эти отчеты для разработки и пересмотра концепций армии и внесения вклада в другие службы и совместные концепции;дать рекомендации по разработке сценариев развития армии и совместных возможностей;исследовать текущие и будущие войны путем экспериментов;и создавать модели и симуляции для проверки новых идей боевых действий.ESG / PKS DTIC, база ВВС Оффут, Небраска, является контрактной деятельностью (SP0700-03-D-1380, заказ на поставку: 0452).

Я начал со скрипта Perl, нодобыча не работает так хорошо.Мне любопытно, если кто-то создал сценарий, который более динамичен, чем его можно построить, а не восстанавливать с нуля.

#!/usr/bin/perl -w
use Spreadsheet::WriteExcel;


# Create a new workbook called simple.xls and add a worksheet.
my $workbook  = Spreadsheet::WriteExcel->new('Dec4_min.xls');
my $worksheet = $workbook->add_worksheet();
our $row = 0;


@files = <~/Def_Contracts/*.*>;

foreach $HTML (@files) {                # open each file in folder  #$HTML = "contract.html";
    open (HTML) or die "Can't open the file!";
    @fullpage = <HTML>;
    print "fullpage array size = ", @fullpage. "\n";

my @cleaned;                        # this is a simplified array we will create

foreach $curr (@fullpage){              #this for each loop cuts array elements without dollar signs

# [0-9]+?\/[0-9]+?\/[0-9]{3}

        if($curr =~ m/content="([0-9]+?\/[0-9]+?\/[0-9]{4})/) {     #get date - looking for this: content="8/29/1995"
        print $1;
#           if ($currnt =~ m/([0-9]+,.[0-9]{4}/){   #  extract date dd,(space)dddd  
        our $date = $1;
        }

                            # CLEAN UP
    while(substr($curr,0,1) =~ m/[^\w]/){       # while not a word char   
            substr($curr,0,1)='';                 #cut that char
    }   
    if($curr =~ m/\$[0-9]/) {           # only use if has $number.


#######################  Now we've got what we need, output relevant parts into excel.


        my $firstcom = index($curr, ',');
        $name = substr($curr,0,$firstcom); 
    #   print "Name:", $name. "\n";
        $worksheet->write($row,0,$name);        # print the name in the first col

        $worksheet->write($row,1,$date);            # print the date in the 2nd col

        if($curr =~ m/\$([0-9,]*)/) {           # finds the cost PROBLEM: there may be more than one
    #   print "Cost:", $1. "\n";
        $worksheet->write($row,2,$1);
        }

        if($curr =~ m/([A-Za-z0-9][A-Z0-9]{4}[A-Z0-9]?\-[0-9]+\-[A-Z]\-[A-Z0-9]{4})/) {     # print ref # in 3rd col
    #   print "Cost:", $1. "\n";
        $worksheet->write($row,3,$1);               # ref takes form (letter ...-...-...number)
        }
                                            # 2nd attempt to get ref #
        if($curr =~ m/\((.*\-.*\-.*)\)/){   # print ref # in 4rd col
    #   print "Cost:", $1. "\n";
        $worksheet->write($row,4,$1);               # ref takes form (letter ...-...-...number)
        }

        $worksheet->write($row,5,$curr);        # print full record (for verification!)

        $row ++;    
    }                           # close for if has a number statement
}                               # close foreach line of HTML Page

#print "cleaned array size = ", @cleaned. "\n";



print "The end.\n";
close (HTML);

}               # End of foreach file

Sinan Ünür · Answer 1 · 07 декабря 2011

Очевидно, что это очень неполно, но тогда, как правило, требуется значительное количество денег, чтобы убедить меня разобраться с такого рода беспорядком (VIEWSTATE, правда?):

#!/usr/bin/env perl

use strict;
use warnings;

use HTML::TokeParser::Simple;
use Regexp::Common qw( number );

my $parser = HTML::TokeParser::Simple->new('contract.html');
my %contracts;

while (my $tag = $parser->get_tag('p')) {
    if (defined( my $align = $tag->get_attr('align')) ) {
        my $text = get_text_in_p($parser);
        next unless defined $text;

        if (lc($text) eq 'contracts') {
            process_contracts($parser, \%contracts);
        }
    }
}

use YAML;
print Dump \%contracts;

sub process_contracts {
    my ($parser, $contracts) = @_;

    my $current_dept = '';

    while (my $tag = $parser->get_tag('p')) {
        my $text = get_text_in_p($parser);
        next unless defined $text;

        if (defined $tag->get_attr('align')) {
            $current_dept = $text;
            next;
        }

        my ($company)  = ($text =~ /^(.+?), (?:is|was)/);

        my ($amount)   = ($text =~ m{
                (
                    \$
                    $RE{num}{int}{-base => 10}{-sep => ','}
                )
            }x
        );

        my ($contract) = ($text =~ m{
                (
                    [A-Z0-9]{6}
                    [A-Z0-9/-]+
                )
            }x
        );

        push @{ $contracts->{$current_dept} }, {
            company  => $company,
            amount   => $amount,
            contract => $contract,
            # text     => $text,
        };
    }
}

sub get_text_in_p {
    my ($parser) = @_;
    my $text = $parser->get_text('/p');
    return unless defined $text;

    $text =~ s/^[^A-Z]+//;
    $text =~ s/\s+\z//;

    return $text;
}

Выход для Нет. 1001-11

---
DEFENSE LOGISTICS AGENCY:
  - amount: '$49,418,113'
    company: 'Physio-Control, Inc., Redmond, Wash.'
    contract: SPM200-07-D-8261/P00005
  - amount: '$43,246,524'
    company: 'Johnson & Johnson Healthcare Systems, on behalf of Ortho-McNell-Janssen Pharmaceuticals, Inc., Piscataway, N.J.'
    contract: SPM2D0-12-D-0001
  - amount: '$15,240,054'
    company: 'Patterson Dental Supply, Inc., Minn.'
    contract: SPM2DE-10-D-7447/P00005
NAVY:
  - amount: '$60,360,995'
    company: 'Raytheon Co., Integrated Defense Systems, San Diego, Calif.'
    contract: N00024-11-C-2404
  - amount: '$33,693,891'
    company: 'Wyle Laboratories, Inc., Huntsville, Ala.'
    contract: N00421-03-D-0015
  - amount: '$30,071,729'
    company: 'Deloitte Consulting, L.L.P., Lexington Park, Md.'
    contract: N00421-03-D-0014
  - amount: '$22,151,900'
    company: 'Raytheon Co., Tucson, Ariz.'
    contract: N00024-08-C-5401
  - amount: '$18,508,325'
    company: 'Canadian Commercial Corp., General Dynamics Land Systems - Canada, Ontario, Canada'
    contract: M67854-07-D-5028

Ilmari Karonen · Answer 2 · 07 декабря 2011

Глядя на несколько записей, я подозреваю, что эти абзацы вводятся вручную с использованием набора шаблонных шаблонов.(Кажется, что различные филиалы / агентства имеют свои собственные форматы; например, ВВС и ВМС пишут «награждается», в то время как армия и ОАД «награждаются», а некоторые другие агентства имеют своисобственные специфические варианты .)

Таким образом, маловероятно, что вы можете написать код для надежного анализа всех записей.Лучшее, что вы можете сделать - это написать несколько регулярных выражений, чтобы проанализировать большинство (скажем, 99% или около того) из них, и пометить остальное для ручной обработки.

Я слишком устал, чтобы писать большеподробный ответ прямо сейчас, но я бы предложил начать с чего-то вроде этого:

my (@records, @rejects);
foreach (split /\n\s*\n/, $text) {  # split page into paragraphs
    s#\s+# #g; s#^ ##; s# $##;      # normalize whitespace
    my (%data, @m);

    if (@m = /^(.*), (?:is being|was) awarded a \$([0-9,]+) (.*) contract to (.*)\. (.*), is the contracting activity(?: \(([A-Z]{2}\d{4}-\d\d-[A-Z]-\d{4})(?:, Delivery Order: (\d+))?\))?\.$/) {
        @data{qw(company amount contract_type purpose activity contract_id delivery_order)} = @m;
    }
    elsif (@m = /^...$/) {
        @data{qw(...)} = @m;
    }
    # ...
    else {
        push @rejects, $_;
        next;
    }
    push @records, \%data;
}

Затем просмотрите отклоненные записи, добавьте новые регулярные выражения (или скорректируйте существующие), чтобы обработать наиболее распространенные среди них типыи повторите.Также не забудьте проверить проанализированный вывод, чтобы убедиться, что регулярные выражения работают правильно.

Как извлечь информацию из контракта Министерства обороны США для использования в статистическом анализе?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 2 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как извлечь информацию из контракта Министерства обороны США для использования в статистическом анализе?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 2 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов