Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

RE: RE: Kris Kringle Script

by Marburg (Novice)
on Apr 28, 2000 at 20:26 UTC ( [id://9603]=note: print w/replies, xml ) Need Help??


in reply to RE: Kris Kringle Script
in thread Kris Kringle Script

Thanks for the comments and the effort placed in producing a new solution for the Kris Kringle script. I should have checked the return of the open statement of course - I almost always do after months of seeing that very comment in comp.lang.per.misc.

Anyway, just a note to say that my solution, or code rather, doesn't have the problem you mention at the end, but it was good to point it out. I've never had the problem after substantial testing.

This script is interesting, I think, as it is typical of scripts that must work first time, and you cannot really test it over and over with real data as you don't want to bug people with junk email. I normally approach this type of problem with writing to files and the writing another Perl program to test.

All programming style asside ...

The main difference between our solutions it that your approach just loops again if you randomly choose yourself and my approach is to remove yourself from the list before you choose. In theory (extrapolating here) you could get caught in a infinite loop if the random assignment returned yourself every time. I was just removing that possibility of ever occurring. My approach also removes the people already selected from the list so that they are not selected again.

I think that I will make a few runs of the programs available with different data sets to show people interested in the workings how it performs over data etc. What do people think?

Regards, Marburg (john.keating@may.ie)

Replies are listed 'Best First'.
RE: RE: RE: Kris Kringle Script
by turnstep (Parson) on Apr 28, 2000 at 21:05 UTC

    >In theory (extrapolating here) you could get caught in a
    >infinite loop if the random assignment returned yourself every time

    Well, *in theory* yes, but considering that perl can generate well over 100,000 random numbers per second on even a slow machine, the odds of an infinite loop are, well, infinitely small. The odds of it taking over 1 second are pretty slim, too. Nothing to worry about here.

    >This script is interesting, I think, as it is typical of
    >scripts that must work first time, and you cannot really
    >test it over and over with real data as you don't want to
    >bug people with junk email. I normally approach this type
    >of problem with writing to files and the writing another
    >Perl program to test.

    Actually, I tested mine extensively - that's how I found the last person "gotcha". A simple rewrite of one line to

    open (M, "|more") || die "Could not open more!\n";
    takes care of that.

    >Anyway, just a note to say that my solution, or code
    >rather, doesn't have the problem you mention at the end,
    >but it was good to point it out. I've never had the
    >problem after substantial testing.

    Your code *does* have that problem - if everyone else is used up, it assigns a null Kris Kringle. Try this out:

    chomp,@_=split(/::/),($e{$_[0]},$l{$_[0]})=($_[1],0)while(<>); for (keys %l) { $l{$_}++; @L=grep{($l{$_}==0)}keys%l; $x=int rand(@L); $l{$L[$x]}++; $l{$_}--; print "$e{$_} has a KK of $L[$x]\n"; }

    Now run that with a data set like this:

    A::aaron B::bob C::cindy

    When aaron and bob get each other, cindy gets nothing:

    %type test.txt | perl kk2.pl aaron has a KK of B bob has a KK of A cindy has a KK of

    The chance of it happening decreases with the total number of people, but it can still happen....

      You are perfectly correcct of course ... I guess that my main problems were twofold ... i didn't test with small sets of data and I just tested by experiment rather than proper analysis of the algorithm. Thanks.

      I just checked this with the code that you suggest on my Win32 PC and the "random" numbers appeared the same every time!! So I didn't get the problem. I then checked it using a unix perl and got the example you cited after the fifth trial ... thanks very much - I really appreciate it. It was fun too.

      Regards, Marburg (john.keating@may.ie)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://9603]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (9)
As of 2024-04-18 13:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found