[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