in reply to parsing textfile is too slow
On my laptop, the version below takes 24 seconds to process the data. It assumes that the data is sorted, so there's a one-time additional cost (which may not be necessary) of sorting the data file; actually the important thing is not the sorting, but that all the lines corresponding to a given codepoint are adjacent to each other in the input stream. The idea is not to build the large %unihan hash, but output the data for each codepoint as soon as it is available.
use strict; use warnings; my %tags; { my $i = 0; for ( qw( kRSUnicode kIRGKangXi kRSKangXi kIRG_GSource kHanYu kIRGHanyuDaZidian kIRG_TSource kTotalStrokes kMandarin kIRG_KPSource kMorohashi kKangXi kDefinition kCantonese kCCCII kSBGY kKPS1 kIRGDaiKanwaZiten kIRG_KSource kCangjie kCNS1992 kCNS1986 kDaeJaweon kIRGDaeJaweon kCihaiT kIRG_JSource kRSAdobe_Japan1_6 kEACC kJapaneseOn kBigFive kPhonetic kJapaneseKun kIICore kXerox kIRG_VSource kKorean kTaiwanTelegraph kMatthews kVietnamese kGSR kMeyerWempe kMainlandTelegraph kGB1 kGB0 kJis0 kFennIndex kJis1 kNelson kFrequency kFenn kKSC0 kGB3 kHKGlyph kCowles kKPS0 kIRG_HSource kHKSCS kTang kHanyuPinlu kJIS0213 kLau kSemanticVariant kKSC1 kGB5 kSimplifiedVariant kTraditionalVariant kGradeLevel kZVariant kKarlgren kCompatibilityVariant kGB8 kSpecializedSemanticVariant kIBMJapan kHDZRadBreak kRSJapanese kRSKanWa kPseudoGB1 kGB7 kIRG_USource kOtherNumeric kAccountingNumeric kRSKorean kPrimaryNumeric ) ) { $tags{ $_ } = $i++; } } my %unihan; my $last; my @data = ( '' ) x keys %tags; { local $_ = <>; output( $last, \@data ), last if !defined; redo if /^#/; chomp; my ( $codepoint, $tag, $content ) = split /\t/; $codepoint =~ s/^U\+/0x/; $codepoint = hex $codepoint; if ( defined $last && $codepoint != $last ) { output( $last, \@data ); @data = ( '' ) x keys %tags; } $last = $codepoint; $data[ $tags{ $tag } ] = $content; redo; } sub output { my ( $codepoint, $data ) = @_; my $s = "$codepoint\t"; # codepoint in dec + tab $s .= join "\t", @$data; $s .= "\n"; # append final newline $s =~ s/([\x{10000}-\x{1FFFFF}])/'\x{'.(sprintf '%X', ord $1).'}'/ge +; print $s; }
Update: Minor improvement to the code (in the way that the length of the @data array is handled, and the undef values avoided). Also, restructured the main loop somewhat.
the lowliest monk
|
|---|