[Novalug] [OT] programming question PERL for PERL GURU

jecottrell3 at comcast.net jecottrell3 at comcast.net
Fri May 29 16:00:16 EDT 2009


Sounds like what you are doing is the same thing that tsort(1) does. Check out Knuth's algorithm for Topological Sorts.

I have never tried solving it, but here is how I would attempt it. Note, the first part is pseudocode, and the second part is just a rough draft at perl code, not debugged, probably full of obvious syntax errors. As they say, cleaning it up is an exercise left to the reader.

I decided to make all the dogs integers instead of letters, you can pass thru ord() if you like or use hashes if you don't.

L is the Left  (Parent) Dog
R is the Right (Child)  Dog
G[x] is the Generation Number of each dog

while ((L, R) = next_pair))
{
  G[L] = 0 unless G[L];
  G[R] = 1 + G[L] unless G[R] > G[L];
}

Now you have the generation number for each dog. Do an inverse sort and print the result.

The problem with this algorithm is that it must be repeated until no changes happen, much in the same way that a bubble sort does.

But there is probably a better way. The sort function in C and perl will take a comparison function, which simply says A is {less,equal,greater} than B.

my $g_g_generation = []; # not trying to cause a big sensation

sub agecmp
{ $g_g_generation->[$a][$b]; }

while (($L, $R] = next_pair)
{
  $g_g_generation->[$L][$R] = -1;
  $g_g_generation->[$R][$L] =  1;
}

print(join ' ', sort(agecmp @$g_g_generation), "\n");

JIM


----- Original Message -----
From: "Bonnie Dalzell" <bdalzell at qis.net>
To: "novalug mailing list" <NOVALUG at calypso.tux.org>
Sent: Friday, May 29, 2009 1:41:27 PM GMT -05:00 US/Canada Eastern
Subject: [Novalug] [OT] programming question PERL for PERL GURU


I know this is off topic. If you have no interest in perl and 
programming please delete. Thanks so much.

The last part of my open source pedigree program i am writing in perl is 
the coefficient of inbreeding part. This has been really hard for me. The 
most computationally friendly wayt to do it is called the tabular method 
but to do the tabular method you need to know the relative dates of birth 
of all the dogs in the pedigree. however in many dog databases there are 
no dates of birth so one has to get relative dates of birth by sorting 
the dogs. Easy to do by logic, hard to do with a computer. Below is the 
logical technique.

I am trying to set up a list of dogs sorted by relative date of birth. I 
do not have an absolute date of birth. I have them in a complicated 
pedigree so I can set up relationship pairs where the one on the left is 
a parent to the one on the right.

For a complex but short pedigree the set of pairs would look like this:
the indentification letters are NOT ment to reflect relative age!

I>G
I>E
I>D
H>G
H>E
H>D
G>C
F>C
E>F
E>B
D>B
C>A
B>F
B>A

With logic I can sort them into a relative age list by doing this;

First find the pairs in which the dog on the left is not listed on th 
right. Move those listings into a sub list:

I>G
I>E
I>D
H>G
H>E
H>D

This leaves:
B>A
B>F
C>A
D>B
E>B
E>F
F>C
G>C

Again identify the dog on the left which is not on the right

G>C
Leaving sublist:
B>A
B>F
C>A
D>B
E>B
E>F
F>C

Again identify the dog on the left which is not on the right:
E>B
E>F
Leaving sublist:
B>A
B>F
C>A
D>B
F>C

And Again:
D>B
Leaving sublist:
B>A
B>F
C>A
F>C

And again:
B>A
B>F
Leaving sublist:
C>A
F>C

And again:
F<C
Leaving sublist:
C>A

Then we can take the dogs in order from the left hand side of the "do not 
occur on right sets and do order them from oldest to youngest.

I H G E D B F C A

I cannot figure out how to set up these logical pairs in perl.

If I do them as a hash the problem is that hashes do not allow multiple 
key value pairs where a given key can have multiple values.

The rest of the rather large pedigree program I have written is in perl so 
I would rather not abandon the language and do it in soem other language.

I have not yet posted this to the perl list because (unlike the perl tk 
list) the people on the perl list are rather mean and I do not need a RTFM 
reply.

Thank You for your patience


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                        Bonnie Dalzell, MA
mail:5100 Hydes Rd PO Box 60, Hydes,MD,USA 21082-0060|EMAIL:bdalzell at qis.net

freelance anatomist, vertebrate paleontologist, writer, illustrator, dog
breeder, computer nerd & iconoclast... Borzoi info at www.borzois.com.
Editor Net.Pet Online Animal Magazine  - http://www.netpetmagazine.com
HOME http://www.qis.net/~borzoi/          BUSINESS http://www.batw.com

_______________________________________________
Novalug mailing list
Novalug at calypso.tux.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/novalug



More information about the Novalug mailing list