You are not logged in.

#1 2008-02-29 20:34:08

wuischke
Member
From: Suisse Romande
Registered: 2007-01-06
Posts: 630

Programming challenges

This thread serves as a collection of small (solvable in less than 1 hour), but yet not trivial programming challenges. Please feel free to post your solution below, but try to avoid lengthy discussions.

1. Challenge:

Create a program to print the solution for any given (solvable, i.e. no guessing is needed) sudoku puzzle. Puzzles are represented as follows:

5 3 0 0 7 0 0 0 0
6 0 0 1 9 5 0 0 0
0 9 8 0 0 0 0 6 0
8 0 0 0 6 0 0 0 3
4 0 0 8 0 3 0 0 1
7 0 0 0 2 0 0 0 6
0 6 0 0 0 0 2 8 0
0 0 0 4 1 9 0 0 5
0 0 0 0 8 0 0 7 9

2. Challenge:

Create a program which takes a conjugated (regular) verb from in the present tense in various languages and tells you the language and the infinitive of the verb.

For simplicity's sake, I'll narrow it down a bit further: The program should be able to recognize German regular verbs (see "spielen"), Portuguese verbs on -ar (see "falar") and French verbs on -ir (see "choisir")

Example session:

$ ./lang kennst
German: kennen
./lang cantam
Portuguese: cantar
./lang finit
French: finir

If you want to suggest another challenge, please write me a mail. Remarkable solutions (very fast, small or elegant) for each challenge will be highlighted.

Last edited by wuischke (2008-03-02 13:12:33)

Offline

#2 2008-02-29 21:45:28

peart
Member
From: Kanuckistan
Registered: 2003-07-28
Posts: 510

Re: Programming challenges

You chose an np-complete problem sad

Offline

#3 2008-02-29 22:10:39

tam1138
Member
Registered: 2007-09-10
Posts: 238

Re: Programming challenges

2. Challenge
Prove that Challenge 1 is NP-complete. smile

Offline

#4 2008-02-29 22:12:36

shining
Pacman Developer
Registered: 2006-05-10
Posts: 2,043

Re: Programming challenges

3. Challenge
Propose a polynomial-time solution smile


pacman roulette : pacman -S $(pacman -Slq | LANG=C sort -R | head -n $((RANDOM % 10)))

Offline

#5 2008-02-29 22:14:26

wuischke
Member
From: Suisse Romande
Registered: 2007-01-06
Posts: 630

Re: Programming challenges

I have written a (not very pretty) solution in C using candidate elimination, which will solve the problem in an instant. I added the "solvable" condition not without an reason.

Offline

#6 2008-02-29 22:39:07

mfolnovic
Member
From: Zagreb, Croatia
Registered: 2008-01-03
Posts: 104

Re: Programming challenges

hmm, I can only solve it in O(num of num you have to find out ^ 3), can anyone explain me how can I solve it faster ? big_smile

Offline

#7 2008-02-29 22:49:39

wuischke
Member
From: Suisse Romande
Registered: 2007-01-06
Posts: 630

Re: Programming challenges

OK, I'll take some fun out of the game. wink

You start with an empty field, i.e. you can add every value to every field. Now add the 5 in the top-right corner. You are not allowed to add another 5 to the first row, first column and the top-left square anymore. Take the 3 and you eliminate the three from the first row, second column and the top-left square.
If your puzzle is solvable you will have it solved after adding all values from the source field. Don't forget to eliminate the square, row and column every time you know for sure a certain value for a field.

Offline

#8 2008-03-01 01:41:16

ibendiben
Member
Registered: 2007-10-10
Posts: 519

Re: Programming challenges

nice topic

Offline

#9 2008-03-01 10:53:59

lloeki
Member
From: France
Registered: 2007-02-20
Posts: 456
Website

Re: Programming challenges

back in the day where sudoku popularity rised, I made a naive recursive approach to it in php. it was slow as hell, but so nice in its simplicity (two mutually recursive short functions).
then I implemented a probabilistic approach I heard of somewhere, and it worked incredibly well.

Last edited by lloeki (2008-03-01 11:00:36)


To know recursion, you must first know recursion.

Offline

#10 2008-03-01 13:31:24

wuischke
Member
From: Suisse Romande
Registered: 2007-01-06
Posts: 630

Re: Programming challenges

OK, I'll post my solution as well. Written in ansi-C. It's sometimes very ugly (particularly the code to clear the square), well, but it works. You can add a call to the "PrintField" function before adding each value to see how this solver works.

#include <stdio.h>
#include <math.h>

int GetValue(int value) {
    switch(value) {
        case 0x01: return 1;
        case 0x02: return 2;
        case 0x04: return 3;
        case 0x08: return 4;
        case 0x10: return 5;
        case 0x20: return 6;
        case 0x40: return 7;
        case 0x80: return 8;
        case 0x100: return 9;
    }
    return 0;
}

int PrintValue(int value) {
    int first = 1;
    int i;

    if ( 0 != GetValue(value) ) {
        printf("%d", GetValue(value));
        return 0;
    }

    printf("(");
    for (i=0;i<9;i++) {
        if ((int)pow(2, i) & value) {
            if (1 == first) {
                first = 0;
            }else {
                printf(",");
            }
            printf("%d", i+1);
        }
    }
    printf(")");

    return 0;
}

int SetValue(int number) {
    if( 0 == number) {
        return 0x1FF;
    }
    return pow(2, number-1);
}

void PrintfField(int field[81]) {
    int i;
    for(i=0;i<81;i++) {
        PrintValue(field[i]);
        printf(" ");
        if (0 == (i+1)%9) {
            printf("\n");
        }
    }
}

int SubtractValue(int value, int number) {
    if ( 0 == value) {
        fprintf(stderr, "A value of zero is not possible for <value>!\n");
        return 0;
    }
    
    if ( (pow(2, number-1) != value) && ((int)pow(2, number-1) & value) ) {
        return value - pow(2, number-1);
    }
    
    return value;
}

int CleanUp(int field[81], int number, int pos) {
    int col = pos%9;
    int row = pos/9;
    int change, k, l, p = 0;
    int list[25] = { 0 };

    for (k=0;k<9;k++) {
        change = GetValue(field[col+9*k]);
        field[col+9*k] = SubtractValue(field[col+9*k], number);
        if ( (0 == change) && ( 0 != GetValue(field[col+9*k]))) {
            list[p++] = col+9*k;
        }
        change = GetValue(field[k+9*row]);
        field[k+9*row] = SubtractValue(field[k+9*row], number);
        if ( (0 == change) && ( 0 != GetValue(field[k+9*row]))) {
            list[p++] = k+9*row;
        }
    }

    for(k=3*(col/3);k<3*((col/3)+1);k++) {
        for(l=3*(row/3);l<3*((row/3)+1);l++) {
            change = GetValue(field[k+9*l]);
            field[k+9*l] = SubtractValue(field[k+9*l], number);
            if ( (0 == change) && ( 0 != GetValue(field[k+9*l]))) {
                list[p++] = k+9*l;
            }
        }
    }

    for(k=0;k<p;k++) {
        CleanUp(field, GetValue(field[list[k]]), list[k]);
    }

    return 0;
}

int AddValue(int field[81], int number, int pos) {
    int col = pos%9;
    int row = pos/9;
    
    if ( 0 == number) {
        return 0;
    }

    if ( (int)pow(2, number-1) & field[pos] ) {
        field[pos] = SetValue(number);
    }else {
        fprintf(stderr, "conflict while solving: Value %d not possible for [%d][%d] !\n", number, col, row);
        PrintValue(field[pos]);
        printf("\n\n");
        return -1;
    }

    CleanUp(field, number, pos);

    return 0;
}


int main(int argc, char *argv[]) {
    int i;
    int field[81];
    int source[] = { 
         5, 3, 0, 0, 7, 0, 0, 0, 0 ,
         6, 0, 0, 1, 9, 5, 0, 0, 0 ,
         0, 9, 8, 0, 0, 0, 0, 6, 0 ,
         8, 0 ,0 ,0 ,6, 0, 0, 0, 3 ,
         4, 0, 0, 8, 0, 3, 0, 0, 1 ,
         7, 0, 0, 0, 2, 0, 0, 0, 6 ,
         0, 6, 0, 0, 0, 0, 2, 8, 0 ,
         0, 0, 0, 4, 1, 9, 0, 0, 5 ,
         0, 0, 0, 0, 8, 0, 0, 7, 9 
    };
    
    for(i=0;i<81;i++) {
        field[i] = 0x1FF;
    }
    
    for(i=0;i<81;i++) {
        AddValue(field, source[i], i);
    }
    
    PrintfField(field);
}

I've seen incredibly small solvers written in Haskell - anyone here who knows functional programming languages well enough to post a nice solution?

Offline

#11 2008-03-02 13:17:14

wuischke
Member
From: Suisse Romande
Registered: 2007-01-06
Posts: 630

Re: Programming challenges

What happened to the solution in Java? It was incomplete, but a start. sad

Anyway, there's a new challenge: This time it's no maths, but cognitive computer science (well, at least a part of it). Pick a programming language which is good with strings, there's no bonus for being masochistic and writing a solution in C. wink

Offline

#12 2008-03-14 21:08:22

wuischke
Member
From: Suisse Romande
Registered: 2007-01-06
Posts: 630

Re: Programming challenges

Nobody? I'm a bit disappointed, I'm sure it was not too hard and I don't think it was too simple, either. Maybe not interesting enough?

Anyway, here's a solution for the second challenge. It's my first perl script. It's a really nice language and fun to write in, but it is indeed too easy to write "obfuscated" code.

#!/usr/bin/perl

$test = $ARGV[0];

$suffixes{'French'} = { 'ir' => ["is","is","it","issons","issez","issent"] };
$suffixes{'German'} = { 'en' => ["e","st","t","en","t","en"] };
$suffixes{'Portuguese'} = { 'ar' => ["o","as","a","amos","ais","am"] };

$root_ref = {};

# create tree
foreach $lang (keys %suffixes) {
    foreach $conj (keys %{$suffixes{$lang}}) {
        foreach $suffix (@{$suffixes{$lang}{$conj}}) {
            my $current = $root_ref;
            while ((length $suffix) > 0) {
                my $letter = (chop $suffix);
                $current->{$letter} = {} if (!exists $current->{$letter} ) ;
                $current->{$letter}->{'.lang'} = { $conj => $lang } if (0 == length $suffix );
                $current = $current->{$letter};
            }
        }
    }
}

$current = $root_ref;
my $exit = "false";
my $stem = "";
my %lang = ();

# "walk down" tree
do {
    $letter = chop($test);
    if (exists  $current->{$letter}) {
        $current = $current->{$letter};
        if (exists $current->{'.lang'}) {
            %lang = ();
            $stem = $test;
            foreach $suffix (keys %{$current->{'.lang'}}) {
                $lang{$suffix} = $current->{'.lang'}->{$suffix};
            }
        }
    }else {
        $exit = "true";
    }
} until("true" eq $exit);

foreach $suffix (keys %lang) {
    print $lang{$suffix} . ": " . $stem . $suffix ."\n";
}

Offline

#13 2008-07-07 17:44:51

vogt
Member
From: Toronto, Canada
Registered: 2006-11-25
Posts: 389

Re: Programming challenges

wuischke wrote:

OK, I'll post my solution as well. Written in ansi-C. It's sometimes very ugly (particularly the code to clear the square), well, but it works. You can add a call to the "PrintField" function before adding each value to see how this solver works.

I've seen incredibly small solvers written in Haskell - anyone here who knows functional programming languages well enough to post a nice solution?

This is a late solution to the first one.

This haskell solver isn't too small, but it is fast, and does guess when it gets stuck.

I used a similar strategy to yours: fill a list of lists with lists of candidates, and repeatedly check rows, columns, 3x3 squares (with wheel), and eliminate taken numbers (which also including 1 if we already have [1,2] in two spots).

It's a bit long, but it does guess once the above strategy stops changing the square, which solves all the newspaper problems I've tried (some of which end up taking the algorithm to maybe 15 dead ends: without guessing, those could probably be solved more intelligently using linear algebra (the problem is still np) (since each row,col,3x3 totals 45, giving at least as many equations as knowns), which would be elegant, but probably less efficient and more confusing)

My parser takes files without spaces, since I like it that way.

Ex:

53__7____
6__195___
_98____6_
8___6___3
4__8_3__1
7___2___6
_6____28_
___419__5
____8__79

Here it is:

module Main where

import Control.Monad
import Data.Maybe
import Data.Char (digitToInt,intToDigit)
import Data.List (nub,transpose,group,sort)
import Debug.Trace
import System.Environment

type MagicSq = [[[Int]]]

main = do f <- getArgs
          if null f then error "specify one or more sudoku problem files to solve"
            else mapM (\x -> unparseSq . solPret . rowsPar =<< readFile x) f

sol :: (Monad m) => [MagicSq] -> m [MagicSq]
sol = liftM (concat) . mapM sol'

sol' :: (Monad m) => MagicSq -> m [MagicSq]
sol' = let y x  = mapMaybe wheel $ x
           ty x = let yx = y x in trace ("branch of: " ++ show (length yx)) yx
       in return . y . branch

solPret x = let f x = untillSame $ scanl (>>=) (sol x) $ repeat sol
                -- somewhere magicSq is reversed... corrected here
                goodSol x = if length x == 1 then return $ reverse $ head x
                     else fail "multiple, possibly incomplete solution found"
            in  join $ goodSol =<< f (wheel' x)

branch :: MagicSq -> [MagicSq]
branch x = if isSolved x then [x]
                else map (unConcat x) $ branchRow $ concat x
    where
    unConcat o = segment $ length o
    branchRow  = bR []
    bR a []    = []
    bR a (l:ls)
         | length l == min = map (\split -> (reverse a) ++ [split]:ls) l
         | otherwise = bR (l:a) ls
         where min = minimum $ filter (1/=) $ map length (l:ls)

wheel x = untillSame $ scanl (>>=) (wheel' x) $ repeat wheel'
wheel' x = rowCk x >>= zoneApp rowCk >>= colCk

untillSame (l:m:ms) = if l == m then l else untillSame (m:ms)

rowCk,colCk :: (Ord a, Show a, Monad m) => [[[a]]] -> m [[[a]]]
rowCk x = let exclCks  x = foldr (=<<) (return x) $ map (exclusionCk) [1..2]
              y = map (exclCks) x
              --y = map (totalOneCk) x
          in if Nothing `elem` y then fail "A row failed"
                                 else return (map fromJust $ y)

colCk = liftM transpose . rowCk . transpose

zoneApp f = liftM (zC 3) . f . zC 3

zC _ [] = []
zC _ [[[]]] = [[[]]]
zC z l  = let (i,ls)    = splitAt z l
              nrs       = map (segment z) i
              headGr x  | null $ concat $ concat x = []
                        | otherwise = concatMap (head) x : headGr (map tail x)
          in if length l `mod` z == 0
                 then headGr nrs ++ (zC z ls)
                 else error $ "square edge length:" ++ show (length l)
                                ++ "does not divide  by: " ++ show z

segment n l = let (a,as) = splitAt n l
              in if null as then [a] else a:segment n as

rowsPar = parseSq . par' [] []
    where
    par' a b [] = (a)
    par' a b ('\n':xs) = par' (reverse b :a) [] xs
    par' a b (x:xs)    = par' a (x:b) xs

parseSq :: [String] -> MagicSq
parseSq p@(m:ms) = if length m /= length p
    then error "Must use a square grid"
    else map (\x -> map (options) x) p
        where
        options x | x `elem` ['1'..intToDigit (length m)] = [digitToInt x]
                  | otherwise                             = [1..length m ]

unparseSq x = if isSolved x
                then putStrLn $ unlines $ map show $ map (concatMap (map intToDigit)) x
                else putStrLn $ unlines $ map show $ map (map       (map intToDigit)) x

isSolved x = (length x)^2 == (length $ concat $ concat x)

totalOneCk l = let decided = concat $ filter (\x -> 1 == length x) l
                   uniqueL x = length x == length (nub x)
                   f x = if length x == 1 then x
                               else filter (\x -> x `notElem` decided) x
               in if uniqueL decided then return $ map (f) l
                       else fail $ "Invalid row: " ++ show decided

-- this is a generalization of the totalOneCk; candidates are eliminated
-- based on the values in n same candidate lists of n length
exclusionCk :: (Monad m, Ord a, Show a) => Int -> [[a]] -> m [[a]]
exclusionCk n l  =
    let areLen   = filter (\x -> n == length x)
        ggs      = group $ sort $ areLen l
        ugPairs  = areLen ggs
        removals = map (head) ugPairs
        maxGG    = maximum $ map length $ ggs
        errPP    = fail $ "Length " ++ show n
                    ++ " overbooked: " ++ show ggs
                    ++ "\nIn: " ++ show l
        -- The actual filter
        f l []  = l
        f l (r:rs)
            | length l == 1 = l
            | l == r        = l
            | otherwise     = f (filter (\x -> x `notElem` r) l) rs
        manage  | null ugPairs = return l
                | maxGG > n    = errPP
                | otherwise    = return $ map (\l -> f l removals) l
    in manage

edit: changed branch (guessing) to take the first smallest branch.

Last edited by vogt (2008-08-08 00:56:00)

Offline

Board footer

Powered by FluxBB