okieheart has asked for the wisdom of the Perl Monks concerning the following question:

I recently got assigned some projects that use PERL, and I have no experience with it so I'm flying solo here. So I apologize in advance for using the wrong terminology or not clarifying my question.

I have a section of code that groups records by diagnosis codes. Right now it groups anything that has a specific code number, but now I need to create a group of "everything else". Here's the current code. I need to change the Unspecified group to include everything not included in group A or group B, instead of having to list each one as I can have up to 100+ different diagnosis codes each time. The diagnosis codes are a text field, if that makes a difference, and some have numbers and letters.

@DiagGroupA = qw(2770 27700 27701 27702 27703 27707 27709); @DiagGroupB = qw(277); @UNSPECIFIED = qw(0704 07049); foreach $diagnosis (@DiagGroupA) { $DiagGroupA_list{$diagnosis} = 1; } foreach $diagnosis (@DiagGroupB) { $DiagGroupB_list{$diagnosis} = 1; } foreach $diagnosis (@UNSPECIFIED) { #$DiagUNSPECIFIED_list{$diagnosis} = 1;

Replies are listed 'Best First'.
Re: Grouping Data
by choroba (Cardinal) on Feb 04, 2016 at 22:10 UTC
    Hello okieheart, welcome to the Monastery!

    Where do the codes come from? If you have an array containing all possible codes, populating @UNSPECIFIED is easy. If there's no such list and the code can be anything, then @UNSPECIFIED is infinitely large.

    #!/usr/bin/perl use warnings; use strict; my @all = qw( 2770 27700 27701 27702 27703 27707 27709 277 0704 07049 1a 1b 1c 1d 1e 1f 1g 1h ); my @diag_group_A = qw( 2770 27700 27701 27702 27703 27707 27709 ); my @diag_group_B = qw( 277 ); my ( %is_in_groupA, %is_in_groupB, %is_unspecified, ); @is_in_groupA{ @diag_group_A } = (1) x @diag_group_B; @is_in_groupB{ @diag_group_B } = (1) x @diag_group_B; $is_unspecified{$_} = 1 for grep ! $is_in_groupA{$_} && ! $is_in_groupB{$_}, @all;

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Re: Grouping Data
by Laurent_R (Canon) on Feb 04, 2016 at 23:00 UTC
    hi okieheart,
    I recently got assigned some projects that use PERL, and I have no experience with it so I'm flying solo here. So I apologize in advance for using the wrong terminology
    Just to settle a minor terminology point, the name of the language is Perl, not PERL. And, BTW, the name of the interpreter is perl.

    Your question is not completely clear to me; for example, I do not know why or how @DiagGroupB is relevant to your question. Maybe you should try to boil down your example to what is useful for your problem. Showing more of the existing code might very much help.

    Now, to simplify what I understand from your problem, I'll assume you have records in which one field is giving you the day of the week. You have categories for the weekdays, Monday through Friday (labeled mo, tu, we, th, fr) and your program is assigning your records to weekdays. Now, sometimes, for some obscure reasons, some records fall outside that range of categories, i.e. on weekend days.

    You might create a param hash:

    my %param = (mo => 1, tu =>1, ..., fr =>1);
    Then, when you read the records, you store somewhere, say in a hash of arrays, records that have a day in the param hash, and in an @unspecified array those that are not in the param list. As an example:
    my (%values, @unspecified); while (my $line = <$data_in>) { my $day = get_day($line); # some function to get the day of week f +rom the record if (exists $param{$day) { push @{$values{$day}}, $line; } else { push @unspecified, $line; } }
    I hope that this helps.
Re: Grouping Data
by poj (Abbot) on Feb 04, 2016 at 22:21 UTC

    I'm guessing some pattern matching and if/elsif/else blocks are what you need

    !perl use strict; my %groups = (); while (my $code = <DATA>){ chomp($code); my $group = code2group($code); print "Code $code is Group $group\n"; } sub code2group { my $code = shift; if ($code eq '277'){ return 'B'; } elsif ($code =~ /2770[012379]?/){ return 'A'; } else { return 'UNKNOWN'; } } __DATA__ 277 2770 27700 27701 27702 27703 27707 27709 0704 07049 12345
    poj