Programmers: up for a SDN weird code challenge?

GEC: Discuss gaming, computers and electronics and venture into the bizarre world of STGODs.

Moderator: Thanas

User avatar
Mad
Jedi Council Member
Posts: 1923
Joined: 2002-07-04 01:32am
Location: North Carolina, USA
Contact:

Post by Mad »

phongn wrote:Can I find a C interpreter and do that instead? :lol:
That's cheating. You have to convert it to a different language and run it through that compiler instead. I choose C++. :mrgreen:

Oh, and it crashes if you enter a number that's too big, that's what it does.

Actually, I figured out the first three numbers by running it through my head and took a guess from there. I ran it and was correct.

Big hint (but not as big as running it :P): they're pretty easy because a lot of logic used later is skipped for the first numbers. Things get more complex after that, but the first numbers tell you all you need to know. The guess is assuming the rest of the code works, because if it doesn't, I'd be wrong.
Later...
User avatar
Durandal
Bile-Driven Hate Machine
Posts: 17927
Joined: 2002-07-03 06:26pm
Location: Silicon Valley, CA
Contact:

Post by Durandal »

Miles Teg wrote:* No namespaces
Frankly, I couldn't give two shits about namespaces. They're designed to solve a problem that is the result of poor design: conflicting function names. I prefix all my class methods with a class acronym. WOW! I just made namespaces totally redundant!
Damien Sorresso

"Ever see what them computa bitchez do to numbas? It ain't natural. Numbas ain't supposed to be code, they supposed to quantify shit."
- The Onion
User avatar
Chris OFarrell
Durandal's Bitch
Posts: 5724
Joined: 2002-08-02 07:57pm
Contact:

Post by Chris OFarrell »

Durandal wrote:
Miles Teg wrote:* No namespaces
Frankly, I couldn't give two shits about namespaces. They're designed to solve a problem that is the result of poor design: conflicting function names. I prefix all my class methods with a class acronym. WOW! I just made namespaces totally redundant!
You use common sense instead of an over the top, insane, elaborate....oh right, you work for Apple instead of Microsoft no? :)
User avatar
Durandal
Bile-Driven Hate Machine
Posts: 17927
Joined: 2002-07-03 06:26pm
Location: Silicon Valley, CA
Contact:

Post by Durandal »

I feel the same way about multiple inheritance. Talk about a feature that is completely useless for 99% of programmers. "OMG I'VE GOT CONFLICTING ATTRIBUTES!" Well design your class structure better next time.
Damien Sorresso

"Ever see what them computa bitchez do to numbas? It ain't natural. Numbas ain't supposed to be code, they supposed to quantify shit."
- The Onion
User avatar
Pu-239
Sith Marauder
Posts: 4727
Joined: 2002-10-21 08:44am
Location: Fake Virginia

Post by Pu-239 »

Durandal wrote:
Miles Teg wrote:* No namespaces
Frankly, I couldn't give two shits about namespaces. They're designed to solve a problem that is the result of poor design: conflicting function names. I prefix all my class methods with a class acronym. WOW! I just made namespaces totally redundant!
Well, it makes for less typing... I think? Don't have to type the prefix on everything, and it can be changed later w/o mass renaming. Also you have 3rd party libraries who's names may conflict...

ah.....the path to happiness is revision of dreams and not fulfillment... -SWPIGWANG
Sufficient Googling is indistinguishable from knowledge -somebody
Anything worth the cost of a missile, which can be located on the battlefield, will be shot at with missiles. If the US military is involved, then things, which are not worth the cost if a missile will also be shot at with missiles. -Sea Skimmer


George Bush makes freedom sound like a giant robot that breaks down a lot. -Darth Raptor
User avatar
phongn
Rebel Leader
Posts: 18487
Joined: 2002-07-03 11:11pm

Post by phongn »

Durandal wrote:I feel the same way about multiple inheritance. Talk about a feature that is completely useless for 99% of programmers. "OMG I'VE GOT CONFLICTING ATTRIBUTES!" Well design your class structure better next time.
Bah. I like namespaces, though I know they are abused. As for multiple inheritance - I can't tell if you say it's a good thing or bad thing?
User avatar
Mad
Jedi Council Member
Posts: 1923
Joined: 2002-07-04 01:32am
Location: North Carolina, USA
Contact:

Post by Mad »

Durandal wrote:
Miles Teg wrote:* No namespaces
Frankly, I couldn't give two shits about namespaces. They're designed to solve a problem that is the result of poor design: conflicting function names. I prefix all my class methods with a class acronym. WOW! I just made namespaces totally redundant!
In that case, is "boost::regex" really so much harder to type than "boost_regex"?

In any case, namespaces are just a natural extension of scoping rules. Why not just have a bunch of global variables each prefixed with the function they belong to? Then you won't have any conflicting variable names and you can use them whenever you need to. :P (The correct answer is "that's stupid, and it prohibits recursion.")

Code inside a namespace looks a lot cleaner without class prefixes dangling around everywhere. (Sorta like you're probably glad you don't have to use this to reference methods and members... unless you're using PHP.)
Later...
User avatar
Durandal
Bile-Driven Hate Machine
Posts: 17927
Joined: 2002-07-03 06:26pm
Location: Silicon Valley, CA
Contact:

Post by Durandal »

Mad wrote:In that case, is "boost::regex" really so much harder to type than "boost_regex"?
No, but "boost_regex" looks nicer. :D
In any case, namespaces are just a natural extension of scoping rules. Why not just have a bunch of global variables each prefixed with the function they belong to? Then you won't have any conflicting variable names and you can use them whenever you need to. :P (The correct answer is "that's stupid, and it prohibits recursion.")
The other correct answer would be that variable names are reused far more frequently than function names. See 'i', 'j' and 'k'. My personal favorite is from the guide to writing unmaintainable code.

marypoppins = superman + starship / god;
Code inside a namespace looks a lot cleaner without class prefixes dangling around everywhere. (Sorta like you're probably glad you don't have to use this to reference methods and members... unless you're using PHP.)
Actually, being an Mac OS X developer, I work in Objective-C. When calling an internal method, you send the message [self methodName]. Makes it easy to tell where the call is coming from. Since method calls are actually messages, you can have two different classes have the same method names without any need for scoping.

By the way, I take it that everyone here has read the Guide to Writing Unmaintainable Code?
Damien Sorresso

"Ever see what them computa bitchez do to numbas? It ain't natural. Numbas ain't supposed to be code, they supposed to quantify shit."
- The Onion
User avatar
Dooey Jo
Sith Devotee
Posts: 3127
Joined: 2002-08-09 01:09pm
Location: The land beyond the forest; Sweden.
Contact:

Post by Dooey Jo »

Destructionator XIII wrote:The awesome part is 16k is so pathetic. Even the NES had 64k of memory, in addition to the sprite buffer. There's an idea to get around the framebuffer issues: force you to use sprites like the NES did.
Heh, you think 16k is pathetic? Try the Atari 2600. It had 128. Bytes! And 4k of ROM storage. Now that's shit :lol:
Am I the only one who thinks this would be fun as hell, or does it sound like a good challenge?
It sure sounds challenging... Though on the topic of NES, I think it would be cool to make some kind of (un)official SDN NES game or something...
Image
"Nippon ichi, bitches! Boing-boing."
Mai smote the demonic fires of heck...

Faker Ninjas invented ninjitsu
User avatar
Mad
Jedi Council Member
Posts: 1923
Joined: 2002-07-04 01:32am
Location: North Carolina, USA
Contact:

Post by Mad »

Destructionator XIII wrote:Still, I'd be willing to try a SDN NES game.
Now that would rock.
Later...
User avatar
Dooey Jo
Sith Devotee
Posts: 3127
Joined: 2002-08-09 01:09pm
Location: The land beyond the forest; Sweden.
Contact:

Post by Dooey Jo »

Destructionator XIII wrote:If you know of where we can find a NES C compiler, then we might be in business though. The assembler was too puny and I found it hard to get any serious work done with it (though I am a much better programmer now than I was then, maybe if I go back it won't be so bad). Still, C would make it much, much easier.
I think there is one. I can look into it tomorrow.


In the meantime, enjoy the wyrd program I wrote today. It's an ASCII art converter. It can read 24-bit BMPs and 32-bit TGAs (and probably 24-bit too, although I haven't tested). It saves a text file with the same name as the specified image, and also a 24-bit BMP file, generated with Windows' GDI. If you're running on a non-Windows machine, remove the BMP saving and loading, and it should work fine (or just the saving and write your own file structs). Also, I mixed in a little C file loading code, because I reused the image loading from another project. There's probably a few bugs but it seems to work okay. Here's a download if you don't want to compile it yourself.

Code: Select all

#include <cstdlib>
#include <iostream>
#include <fstream>
#include <map>
#include <string>
#include "windows.h"

class AGradient {
    // ASCII gradient class
    
    std::string g; // The letter gradient to be used
    public:
        AGradient() {
            g = "MWYASQPDBNZOUVCXTFRJLI890657432mwyaspqdbnzouvcxtfrj1li\\/!:;"*_~-¨^,.'`´ ";
        }
        char GetChar(unsigned char n) {
            // Returns a matching letter, scaled over the gradient's size
            float f = float(n) / 256.f;
            int i = int(float(g.size()) * f);
            return g[i];
        }
};

class CBitmap {
    // Class for loading bitmaps
    bool loaded;
    std::string name;
    unsigned char *data;
    int width,height;
    int BPP;
    
    public:
        CBitmap() {
            loaded = false;
            data = NULL;
            width = height = BPP = 0;
        }
        ~CBitmap() {
            delete [] data;
        }
        bool Load(std::string filename);
        void Convert();
};

using namespace std;

/////////////////////////////////////////////////
// Class CBitmap

bool CBitmap::Load(string filename)
{
    // Loads a bitmap into memory
    if (loaded==true) // This bitmap is already loaded!
       return false;

    name = filename;

    // Create a temporary, all lower-case filename
    string lName = name;
    int (*pf)(int)=tolower; 
    transform(lName.begin(),lName.end(), lName.begin(), pf); 

    int imageSize=0;	// Used to store the image size when setting aside ram
    int bytesPerPixel=0;	// Holds number of bytes per pixel used in the file

    if (lName.find(".bmp")!=string::npos) // Load a .bmp file
    {
	    // These are both defined in Windows.h
	    BITMAPFILEHEADER	BitmapFileHeader;
	    BITMAPINFOHEADER	BitmapInfoHeader;

	    // open filename in "read binary" mode
	    FILE *file = fopen(filename.c_str(), "rb");
	    if (file == NULL) {
		    return false;
	    }

	    // Header
	    fread (&BitmapFileHeader, sizeof (BITMAPFILEHEADER), 1, file);
	    if (BitmapFileHeader.bfType != 'MB') {
		    fclose (file);
		    return false;
	    }
	    
	    // Information
	    fread (&BitmapInfoHeader, 1, sizeof (BITMAPINFOHEADER), file);
	    if (BitmapInfoHeader.biWidth==0 || BitmapInfoHeader.biHeight==0) {
		    fclose (file);
		    return false;
	    }
      
	    width = BitmapInfoHeader.biWidth;
	    height = BitmapInfoHeader.biHeight;
	    BPP = 3;	// Only load 24-bit Bitmaps
	    bytesPerPixel = 3;
	    imageSize = width*height*bytesPerPixel; // Set image size

        // Seek position in file (no headers in the data, please!)
	    fseek (file, BitmapFileHeader.bfOffBits, SEEK_SET);
	    data = new unsigned char [imageSize];
	    if (data == NULL) { // Error allocating memory!
		    delete [] data;
		    fclose (file);
		    return false; // Oh noes!
	    }
	    fread (data, 1, imageSize, file); // Read the file into memory

	    // Turn BGR to RBG
	    for (int i = 0; i < (int) imageSize; i += 3) {
		    int temp = data [i];
		    data [i + 0] = data [i + 2];
		    data [i + 2] = temp;
	    }

	    fclose(file); // Close file
    } else if (lName.find(".tga")!=string::npos) // Load a .tga file
    {
     	unsigned char		TGAheader[12]={0,0,2,0,0,0,0,0,0,0,0,0};	// Uncompressed TGA Header
     	unsigned char		TGAcompare[12];	// Used To Compare TGA Header
     	unsigned char		header[6];	// First 6 Useful Bytes From The Header

     	FILE *file = fopen(filename.c_str(), "rb");	// Open The TGA File

     	if(	file==NULL ||		// Does File Even Exist?
       		fread(TGAcompare,1,sizeof(TGAcompare),file)!=sizeof(TGAcompare) ||	// Are There 12 Bytes To Read?
       		memcmp(TGAheader,TGAcompare,sizeof(TGAheader))!=0 ||	// Does The Header Match What We Want?
       		fread(header,1,sizeof(header),file)!=sizeof(header))	// If So Read Next 6 Header Bytes
     	{
     		if (file == NULL)	// Did The File Not Exist?
     			return false;	// Return False
     		else	// Otherwise
     		{
     			fclose(file);	// If Anything Failed, Close The File
     			return false;	// Return False
     		}
     	}

        // If went OK, so continue the loading
     	width  = header[1] * 256 + header[0];	// Determine The TGA Width
     	height = header[3] * 256 + header[2];	// Determine The TGA Height

    	if(	width	<=0	||	// Is The Width Less Than Or Equal To Zero
     		height	<=0	||	// Is The Height Less Than Or Equal To Zero
     		(header[4]!=24 && header[4]!=32))	// Is The TGA 24 or 32 Bit?
     	{
     		fclose(file);	// If Anything Failed, Close The File
     		return false;	// Return error
     	}

     	BPP = header[4]/8;		// Grab The TGA's Bits Per Pixel (24 or 32)
     	bytesPerPixel = BPP;	// Divide By 8 To Get The Bytes Per Pixel
     	imageSize = width*height*bytesPerPixel;	// Calculate The Memory Required For The TGA Data

     	data = new unsigned char[imageSize];	// Reserve Memory To Hold The TGA Data

     	if(	data==NULL ||	// Does The Storage Memory Exist?
     		fread(data, 1, imageSize, file)!=imageSize)	// Does The Image Size Match The Memory Reserved?
     	{
     		if(data!=NULL)
     			delete [] data;

     		fclose(file);	// Close The File
     		return false;
     	}

     	for(int i=0; i<int(imageSize); i+=bytesPerPixel)	// Loop Through The Image Data
     	{	// Swaps The 1st And 3rd Bytes (Red and Blue)
     		int temp=data[i];
     		data[i] = data[i + 2];
     		data[i + 2] = temp;
     	}

     	fclose (file);	// Close The File
    } else { // Unknown file format
        return false;
    }

    loaded = true; // Bitmap is now loaded. Hooray!

    return true; // Everything went OK
}

void CBitmap::Convert() {
    // Converts an image to text using the color information to produce a gradient
    if (loaded == false) return;
    
    int sizeX = 8;
    int sizeY = 15;
    
    int tWidth = width/sizeX;
    int tHeight = height/sizeY;
    int size = tWidth*tHeight*3;
    if (size == 0) return;
    unsigned char *cData = new unsigned char[size];
    
    // Downsample the image using sizeX*sizeY blocks
    for (int y=0, fx=0; y<tHeight && fx<size; ++y) {
        for (int x=0; x<tWidth && fx<size; ++x, fx+=3) {
            int r = 0,b = 0,g = 0;
            for (int dx=0; dx<sizeX; ++dx) {
                for (int dy=0; dy<sizeY; ++dy) {
                    if (x*sizeX + dx >= width || y*sizeY + dy >= height) break;
                    int p = (x*sizeX + dx) * BPP + (y*sizeY + dy) * width * BPP;
                    r += data[p];
                    g += data[p+1];
                    b += data[p+2];
                }
            }
            int d = sizeX*sizeY; // Average and store the colour
            r /= d; g /= d; b /= d;
            cData[fx] = (unsigned char)(r);
            cData[fx+1] = (unsigned char)(g);
            cData[fx+2] = (unsigned char)(b);
        }
    }
    
    // Convert the downsampled image to a "text gradient"
    AGradient grad;
    string str;
    for (int y=tHeight-1; y>=0; --y) { // Image is upside down...
        for (int x=0; x<tWidth; ++x) {
            int p = (x+y*tWidth)*3;
            
            int r = cData[p];
            int g = cData[p+1];
            int b = cData[p+2];
            int l = (r + g + b) / 3;
            
            str += grad.GetChar((unsigned char)(l));
        }
        str += "\n";
    }

    { // Write a text file
        int index = name.rfind(".");
        string filename(name,0,index);
        filename += ".txt";
        ofstream file(filename.c_str());
        file << str;
        file.close();
    }

    { // Write a bitmap using GDI text stuff
        int index = name.rfind(".");
        string filename(name,0,index);
        filename += "_t.bmp";
        
        // Create a device context in memory
        HDC hdc = CreateCompatibleDC(NULL);

        // Apply a bitmap
        BITMAPINFO bi;
        ZeroMemory( &bi.bmiHeader, sizeof(BITMAPINFOHEADER) );
        bi.bmiHeader.biWidth=tWidth*sizeX;
        bi.bmiHeader.biHeight=tHeight*sizeY;
        bi.bmiHeader.biPlanes=1;
        bi.bmiHeader.biBitCount=24;
        bi.bmiHeader.biSizeImage=0;
        bi.bmiHeader.biSize=sizeof(BITMAPINFOHEADER);
        bi.bmiHeader.biClrUsed= 0;
        bi.bmiHeader.biClrImportant= 0;
        VOID *pvBits;
        HBITMAP hbmp= CreateDIBSection( hdc,
            &bi,
            DIB_RGB_COLORS,
            &pvBits,
            NULL,
            0);
        SelectObject(hdc,hbmp);

        // Create font
        HFONT font = CreateFont(sizeY,0,0,0,FW_NORMAL,FALSE,FALSE,0,ANSI_CHARSET,
           OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH | FF_SWISS,
           "Fixedsys");
        
        // Select font and set colours etc.
        SelectObject(hdc,font);
        SetBkMode(hdc,OPAQUE);
        SetBkColor(hdc,RGB(192,192,192));
        
        // Write coloured letters
        for (int y=0; y<tHeight; ++y) {
            for (int x=0; x<tWidth; ++x) {
                int p = (x+(tHeight-y-1)*tWidth)*3;
            
                int r = cData[p];
                int g = cData[p+1];
                int b = cData[p+2];
                SetTextColor(hdc,RGB(r,g,b));
                
                int l = (r + g + b) / 6; // Darker
                char c = grad.GetChar((unsigned char)(l));
                TextOut(hdc,x*sizeX,y*sizeY,&c,1);
            }
        }
        
        // Don't need font anymore
        DeleteObject(font);

        // prepare the bitmap file header
        BITMAPFILEHEADER bmfh;
        bmfh.bfType = 'MB';
        bmfh.bfSize = sizeof(bmfh) + sizeof(bi.bmiHeader) + bi.bmiHeader.biSizeImage;
        bmfh.bfReserved1 = bmfh.bfReserved2 = 0;
        bmfh.bfOffBits = sizeof(bmfh) + sizeof(bi.bmiHeader);

        BITMAP bmp;
        GetObject(hbmp,sizeof(BITMAP),&bmp);

        int imageBytes = bi.bmiHeader.biWidth * bi.bmiHeader.biHeight * 3;
        char *pBits = new char [imageBytes];

        int scanLineCount = GetDIBits(hdc, hbmp, 0, bmp.bmHeight,
                            pBits, &bi, DIB_RGB_COLORS);

        // Open a file for writing
        ofstream file(filename.c_str(),ios::binary);
	    file.write((char*)(&bmfh), sizeof(BITMAPFILEHEADER));
	    file.write((char*)(&bi.bmiHeader), sizeof(BITMAPINFOHEADER));
	    file.write((char*)(pBits), imageBytes);
	    file.close();
	    
	    // Delete image data
	    delete [] pBits;
	    
	    // Delete bitmap object
	    DeleteObject(hbmp);
	    
	    // And device context
	    DeleteDC(hdc);
    }
    
    delete [] cData;
}

/////////////////////////////////////////////////

int main(int argc, char *argv[])
{
    while (1) { // Enter main loop
        cout << "Enter filename:\n";
        string file;
        if (cin >> file) {
            CBitmap bmap;
            if (!bmap.Load(file)) {
                cout << "Error loading file!\n";
            } else {
                bmap.Convert();
                cout << "File converted...\n";
            }
        } else {
            cout << "Error!!\n";
        }
        
        cout << "\nLoad another file? Y/N";
        
        string c;
        cin >> c;
        
        if (c == "n" || c == "N" || c == "no") break;
        
        system("cls");
    }
    
    return EXIT_SUCCESS;
}

Here's a few tests I did. I'm sure there are already a lot of programs like this though. If you can recompile it you can change the gradient string and maybe get better results. Of course, I could make a config file for all that...
Image
"Nippon ichi, bitches! Boing-boing."
Mai smote the demonic fires of heck...

Faker Ninjas invented ninjitsu
User avatar
Arrow
Jedi Council Member
Posts: 2283
Joined: 2003-01-12 09:14pm

Post by Arrow »

Ok, that's shit cool. Nice work!
Artillery. Its what's for dinner.
User avatar
Dooey Jo
Sith Devotee
Posts: 3127
Joined: 2002-08-09 01:09pm
Location: The land beyond the forest; Sweden.
Contact:

Post by Dooey Jo »

Well I did find a 6502 C compiler which is supposed to work for the NES. Though I haven't had the time to test it.


But if someone has any fun ideas for a SDN game we could always write it for the GBA (which is quite nice to program) or just for the PC with something simple like SDL...
Image
"Nippon ichi, bitches! Boing-boing."
Mai smote the demonic fires of heck...

Faker Ninjas invented ninjitsu
User avatar
DarkSilver
Jedi Council Member
Posts: 1606
Joined: 2004-10-28 08:54am
Location: Librium Arcana
Contact:

Post by DarkSilver »

A bit late since your now speaking of the NES compiler and all...

but I bring a convulted peice of php to print "Hello World!" twice and doublespaced!

Code: Select all

<?php
$shat = "h";
$spin = "3";
$frank = "1";
$alyu = "0";
$mood = "ho";
$hw = "Hello World";

if ($mood == "ho")
{ 
print "Hello World!<p> </p>";
}
elseif ($spin == "h") 
{ 
print "Blow me sleezeball!"; 
}
else 
{
print " ";
}

switch ($frank)
{
case "9":
print "screw me";
break;
case "4":
print "nope, try again";
default:
echo $hw;
}
?>
Yes, I know it's simplistic, I'm just learning here!
XBL: Darek Silver | Wii Friend: 5602 6414 0598 0225
LibriumArcana - Roleplaying, Fiction, Irreverence
Trekker (TOS, TNG/DS9-Era) | Warsie (semi-movie purist) | B5'er | TransFan
Cult of Vin Diesel: While it is well known that James Earl Jones performed the voice of Darth Vader, it is less appreciated that Vin Diesel performs the voice of James Earl Jones.
User avatar
Mad
Jedi Council Member
Posts: 1923
Joined: 2002-07-04 01:32am
Location: North Carolina, USA
Contact:

Post by Mad »

Dooey Jo wrote:But if someone has any fun ideas for a SDN game we could always write it for the GBA (which is quite nice to program) or just for the PC with something simple like SDL...
When making an NES game was mentioned, I had an idea for a Konami-style Star Trek vs Star Wars game. But it was more as a novelty than a full-fledged game.
Later...
User avatar
sketerpot
Jedi Council Member
Posts: 1723
Joined: 2004-03-06 12:40pm
Location: San Francisco

Post by sketerpot »

Remember when Richard Dawkins wrote a computer program to evolve a phrase from one of Shakespeare's plays through random mutation combined with selection and asexual reproduction? I did the same thing. And, since the language apparently frightens someone greatly, I did it in Lisp.

Here's a "fossil record" from this program.

Code: Select all

(defparameter *target* "to be or not to be that is the question")
(defparameter *mutation-rate* 0.2)
(defparameter *crossover-rate* 0.9
  "What portion of the population is filled by sexual crossover.
   This should be high, like 0.9")

(defun fitness (x)
  (loop for index below (length x)
	sum (if (eql (elt x index)
		     (elt *target* index))
		1
		0)))

(defun mutate (x &optional (mutation-rate *mutation-rate*))
  "Destructively introduce random letters or spaces into x"
  (dotimes (index (length x))
    (if (probability mutation-rate)
	(setf (elt x index) (random-letter))))
  x)

(defun crossover (gene-1 gene-2)
  "Combine gene-1 and gene-2 with single-point crossover"
  (let* ((length (length gene-1))
	 (child (make-string length))
	 (cut-point (random length)))
    ;; Copy from gene-1 up to cut-point
    (loop for index below cut-point
	  do (setf (elt child index)
		   (elt gene-1 index)))
    ;; Fill the rest of child from gene-2
    (loop for index from cut-point below length
	  do (setf (elt child index)
		   (elt gene-2 index)))
    child))

(defun probability (p)
  "Return true with a probability p"
  (<= 0
      (random 1.0)
      p))

(defun random-letter ()
  "Return a random letter"
  (let ((choices (concatenate 'string "   abcdefghijklmnopqrstuvwxyzabcdefghijklmnopq"
"rstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzae"
"iouaeiouaeiouaeiouaeioueeeeee")))
    (elt choices (random (length choices)))))

(defun random-string (length)
  "Return a random string"
  (let ((string (make-string length)))
    (loop for index below length
	  do (setf (elt string index) (random-letter)))
    string))

(defparameter *gene-pool-size* 20
  "Size of gene pool. Experience has shown that 20 is generally a pretty
   good size, and bigger sizes aren't necessarily better.")

(defun make-new-gene-pool ()
  "Make an empty gene pool and return it"
  (make-array *gene-pool-size*
	      :element-type 'simple-base-string
	      :initial-element ""
	      :fill-pointer nil
	      :adjustable nil))

(defparameter *gene-pool* (make-new-gene-pool)
  "The current gene pool")

(defun fill-gene-pool ()
  "Fill the gene pool with random strings"
  (dotimes (index (length *gene-pool*))
    (setf (elt *gene-pool* index)
	  (random-string (length *target*)))))

(defun best-of-gene-pool ()
  "Return the best candidate in the gene pool"
  (let ((best (elt *gene-pool* 0)))
    (loop for candidate across *gene-pool*
	  do (when (> (fitness candidate)
		      (fitness best))
	       (setf best candidate)))
    best))

(defun good-breeding-candidate (pool)
  "Return a good candidate for breeding from by using roulette-wheel
   selection."
  (let ((s (loop for gene across pool
		  sum (fitness gene))))
    (if (zerop s)
	(elt pool (random (length pool)))
	(let ((r (random s)))
	  (loop for gene across pool
		summing (fitness gene) into total-fitness-so-far
		do (if (> total-fitness-so-far r)
		       (return-from good-breeding-candidate gene)))))))

(defun fill-new-gene-pool ()
  "Fill up a new gene pool and return it"
  (let ((new-gene-pool (make-new-gene-pool))
	(number-to-fill-with-crossovers (ceiling (* *gene-pool-size*
						    *crossover-rate*))))
    ;; Fill 90% of the gene pool with crossovers
    (loop for index below number-to-fill-with-crossovers
	  do (setf (elt new-gene-pool index)
		   (crossover (good-breeding-candidate *gene-pool*)
			      (good-breeding-candidate *gene-pool*))))
    ;; Fill all but one of the remaining slots with mutatants
    (loop for index from number-to-fill-with-crossovers
	  below (1- *gene-pool-size*)
	  do (setf (elt new-gene-pool index)
		   (mutate (copy-seq (good-breeding-candidate *gene-pool*)))))
    ;; Preserve the best of the last generation to ensure that
    ;; progress goes forward from generation to generation.
    (setf (elt new-gene-pool (1- *gene-pool-size*))
	  (best-of-gene-pool))
    new-gene-pool))

(defun evolve (generations)
  (dotimes (current-generation generations)
    (setf *gene-pool* (fill-new-gene-pool))))

(fill-gene-pool)
(time (evolve 1000))
Edit: mangled a bit of the code so that it doesn't widen the page.
User avatar
phongn
Rebel Leader
Posts: 18487
Joined: 2002-07-03 11:11pm

Post by phongn »

Yay lisp!
User avatar
Arrow
Jedi Council Member
Posts: 2283
Joined: 2003-01-12 09:14pm

Post by Arrow »

Hey, what the hell? WTF are you thinking, writing readable lisp like that!? :P
Artillery. Its what's for dinner.
User avatar
sketerpot
Jedi Council Member
Posts: 1723
Joined: 2004-03-06 12:40pm
Location: San Francisco

Post by sketerpot »

Arrow wrote:Hey, what the hell? WTF are you thinking, writing readable lisp like that!? :P
I'm sorry. Perhaps this will make you feel better:

Code: Select all

((LAMBDA (LAMBDA) `((LAMBDA (LAMBDA) ,LAMBDA) ',LAMBDA))
 '`((LAMBDA (LAMBDA) ,LAMBDA) ',LAMBDA))
That's a quine: a program that prints its own source code. Which is somewhat similar to what I've been working on lately: writing code which spits out nigh-unreadable C code for one of the PIC18 microcontrollers. I can actually do some pretty cool stuff. In four lines of code, I can define a program which continuously performed multiplexed interrupt-drive analog-to-digital conversions on four pins using a finite-state-machine for control and passes off the values to four seperate simple functions which print the values to the USART. In four lines of code.
User avatar
Lagmonster
Master Control Program
Master Control Program
Posts: 7719
Joined: 2002-07-04 09:53am
Location: Ottawa, Canada

Post by Lagmonster »

De-stickied because nobody's even looked at it since August. If you *want* it back, PM me and I'll put it back for you.
Note: I'm semi-retired from the board, so if you need something, please be patient.
Post Reply