2009-12-07 1 views
22

Sto provando a inventare alcuni puzzle di programmazione incentrati sul multi-threading. La maggior parte dei problemi che sono riuscito a fare finora sono stati abbastanza specifici per il dominio. Qualcuno ha qualche puzzle di programmazione decente per gli sviluppatori che cercano di imparare i concetti chiave delle applicazioni multi-threading?Multithreading Puzzles

risposta

11

Questo argomento contiene una serie di argomenti.

Multithreaded Programming with ThreadMentor : A Tutorial

Edit:

Ecco alcuni link diretti ai problemi elencati in quel legame, insieme con le loro descrizioni iniziali.

ThreadMentor : The Dining Philosopher's Problem
ThreadMentor : The Dining Philosopher's Problem: The Lefty-Righty Version

Il problema dei filosofi a cena è inventato da E. W. Dijkstra. Immagina che cinque filosofi che passano la vita solo pensando e andando verso est. Nel mezzo della sala da pranzo c'è un tavolo circolare con cinque sedie. Il tavolo ha un grande piatto di spaghetti. Tuttavia, sono disponibili solo cinque bacchette, come mostrato nella figura seguente. Ogni filosofo pensa. Quando ha fame, si siede e raccoglie le due bacchette che gli sono più vicine. Se un filosofo può prendere entrambe le bacchette, mangia per un po '. Dopo che un filosofo finisce di mangiare, mette giù le bacchette e inizia a pensare.

ThreadMentor : The Cigarette Smoker's Problem

Questo problema è dovuto a S. S. Patil nel 1971. Si supponga una sigaretta richiede tre ingredienti, tabacco, carta e coi. Ci sono tre fumatori a catena. Ognuno di loro ha un solo ingrediente con un'offerta infinita. C'è un agente che ha una scorta infinita di tutti e tre gli ingredienti. Per fare una sigaretta, il fumatore ha tabacco (risp. Carta e fiammifero) deve avere gli altri due ingredienti in carta e abbinare (risp. Tabacco e fiammifero, tabacco e carta). L'agente e i fumatori condividono un tavolo. L'agente genera a caso due ingredienti e notifica al fumatore chi ha bisogno di questi due ingredienti. Una volta che gli ingredienti sono stati presi dal tavolo, l'agente ne fornisce altri due. D'altra parte, ogni fumatore attende la notifica dell'agente.Una volta notificato, il fumatore raccoglie gli ingredienti, fa una sigaretta, fuma per un po 'e torna al tavolo in attesa dei suoi prossimi ingredienti.

ThreadMentor : The Producer/Consumer (or Bounded-Buffer) Problem

Supponiamo di avere un buffer circolare con due puntatori in e fuori per indicare la posizione successiva disponibile per il deposito dei dati e la posizione che contiene i dati successivi da recuperare. Vedi lo schema qui sotto. Ci sono due gruppi di thread, produttori e consumatori. Ogni produttore deposita gli elementi di dati nella posizione in e fa avanzare il puntatore, e ciascun consumatore recupera l'elemento di dati in posizione e anticipa il puntatore.

ThreadMentor : The Roller Coaster Problem

Supponiamo che ci sono n passeggeri e auto montagne un rullo. I passeggeri aspettano ripetutamente di salire in macchina, che può contenere un massimo di passeggeri C, dove C < n. Tuttavia, l'auto può andare in giro solo quando è piena. Dopo aver terminato un giro, ogni passeggero vaga per il parco divertimenti prima di tornare sulle montagne russe per un altro giro. Per motivi di sicurezza, l'auto percorre solo i tempi T e quindi i colpi di arma da fuoco.

Questo ha vincoli aggiuntivi:

  1. La macchina cavalca sempre esattamente con i passeggeri C;
  2. Nessun passeggero salterà fuori dall'auto mentre la macchina sta correndo;
  3. Nessun passeggero salterà sull'auto mentre la macchina sta correndo;
  4. Nessun passeggero richiederà un'altra corsa prima di scendere dalla macchina.

ThreadMentor : The Bridge Problem

La descrizione per questo si basa su immagini. Ecco una citazione modificata con rimossi i riferimenti alle immagini.

Considerare un ponte stretto che può consentire solo tre veicoli nella stessa direzione di attraversare allo stesso tempo. Se ci sono tre veicoli sul ponte, qualsiasi veicolo in arrivo deve attendere fino a quando il ponte è libero.

Quando un veicolo esce dal ponte, abbiamo due casi da considerare. Caso 1, ci sono altri veicoli sul ponte; e il caso 2 il veicolo uscente è l'ultimo sul ponte. Nel primo caso, si dovrebbe consentire a un veicolo nuovo nella stessa direzione di procedere.

Il caso 2 è più complicato e ha due sottocasi. In questo caso, il veicolo in uscita è l'ultimo veicolo sul ponte. Se ci sono veicoli in attesa nella direzione opposta, uno di loro dovrebbe essere autorizzato a procedere. Oppure, se non ci sono veicoli in attesa nella direzione opposta, quindi lasciare il veicolo in attesa nella stessa direzione per procedere.

1

Forse è possibile utilizzare il semplice problema di prova e di impostazione di un flag condiviso o l'accesso a un qualche tipo di risorsa lista in una sorta di modalità in sequenza coerente ?

2

Si dispone di una struttura ad albero grande in memoria. Molti thread devono cercare la struttura. Occasionalmente, un thread dovrà inserire o rimuovere qualcosa dalla struttura. Come controllate l'accesso alla struttura in modo che il programma funzioni correttamente (non ci saranno due thread che si calpesteranno a vicenda mentre si modifica la struttura) e in modo efficiente (nessun thread è bloccato quando non è necessario)?

1

Ecco il first problem che ho mai completato con multi-threading, indietro durante i miei studi universitari.

1

A seconda di ciò che si sta facendo con il multi-threading, questo fa la differenza.

Sei in una banca. I clienti arrivano ad un tasso medio di 1 ogni 2 minuti. Ogni cliente viene servito, in media, in 2 minuti.

Qual è la soluzione migliore per servire i clienti? Una linea comune o una linea per ogni teller?

La tua scelta è tale da garantire un limite sulla lunghezza della linea?

Risposte: a causa della proprietà markov dell'arrivo del cliente e del tempo di servizio effettivo per individuo, la linea non conoscerà mai un limite. Inoltre, è una buona idea farli aspettare in una linea comune, anche se questo non è sufficiente per superare la linea sconfinata.

1

Ecco un risolutore N-puzzle parallelo implementato in PARLANSE. Il linguaggio ha una sintassi simile a LISP ma è molto più vicino a C (scalari, strutture, puntatori, chiamate di funzioni), ma a differenza di C ha ambiti locali. Il segreto è nell'operatore parallelo fork-grain (|| ...) che esegue tutti i suoi operandi in parallelo, così come la capacità di PARLANSE di usare le eccezioni per fermare i grani parent.

Questo solutore offre accelerazioni lineari su tutte le macchine a 4 e 8 vie su cui ho provato.

(define Version `N-puzzle Solver V1.1~l 
Copyright (C) 1998-2009 Semantic Designs; All Rights Reserved~l') 

(define SolveParticularPuzzle ~t) 
(define ManhattanHeuristic ~t) ; Manhattan is really fast 
(define PrintTrace ~f) 

(include `parmodule.par') 

(define ScrambleCount 10000) 

(define PuzzleSize `Length of side of N-puzzle' +4) ; at least 3! 

(define PuzzleSizeMinus1 +3) 

(define PuzzleArea `Area of puzzle (= (-- N))' +16) ; (= (* PuzzleSize PuzzleSize)) 

(define PuzzleAreaMinus1 +15) 

(define BlankTile `Code for a blank tile' 0) 

(define puzzlepieceT `Codes for nonblank tiles' 
    (sort natural (range 1 PuzzleArea))) 

(define BoardPositionT integer) ; normally positive, but sometime we reach off the edge 

(define ConfigurationT (array puzzlepieceT 0 PuzzleAreaMinus1)) 

(define HardPuzzle1 `Solution found of length 29: 
     2 1 5 6 2 3 7 11 10 6 2 3 7 11 10 14 13 9 8 
     12 13 9 5 1 2 6 5 1 0' 
    (lambda (function ConfigurationT void) 
    (make ConfigurationT 01 11 02 00 
       04 06 09 05 
       13 12 07 03 
       08 14 10 15) 
    )lambda 
)define 

(define HardPuzzle2 `Solution found of length 31: 
     0 4 5 6 10 9 5 1 2 3 7 6 10 9 5 1 
     2 3 7 6 5 1 2 6 1 0 14 13 9 5 4 0' 
    (lambda (function ConfigurationT void) 
    (make ConfigurationT 13 00 02 09 
       04 05 06 01 
       08 07 03 11 
       12 14 10 15) 
    )lambda 
)define 

(define HardPuzzle3 `Solution found of length 56: 
     1 2 6 7 3 2 6 10 14 15 11 10 9 5 
     4 8 12 13 9 10 6 5 1 0 4 8 12 13 
     14 10 6 7 11 10 9 13 14 15 11 10 
     6 5 4 8 9 10 6 5 1 0 4 8 9 5 4 0 
     Total solution time in seconds: 18-24 (on 8 processor machine)' 
    (lambda (function ConfigurationT void) 
    (make ConfigurationT 00 09 10 08 
       15 12 03 02 
       01 11 13 14 
       06 04 07 05) 
    )lambda 
)define 

(define HardPuzzle4 `Solution found of length 50: 
     4 5 1 0 4 8 12 13 9 5 1 0 4 5 6 
     10 14 13 9 8 4 5 6 2 1 5 9 10 14 
     13 12 8 9 10 11 15 14 13 9 10 11 
     7 3 2 1 5 9 8 4 0 
     Total solution time in seconds: 125 (on 8 processor machine)' 
    (lambda (function ConfigurationT void) 
    (make ConfigurationT 00 15 06 07 
       12 03 08 11 
       04 13 02 05 
       01 14 09 10) 
    )lambda 
)define 

(define HardPuzzle5 
    `Solution found of length 68: 
    3 7 11 10 6 2 3 7 6 5 9 8 4 5 1 0 4 5 9 13 14 15 11 
    7 6 5 1 2 6 5 9 8 12 13 14 10 6 5 4 8 12 13 14 15 11 
    10 9 5 1 0 4 8 12 13 9 5 4 8 9 13 14 15 11 7 3 2 1 0 
    Total solution time in seconds: 2790 (on 8 processor machine)' 
    (lambda (function ConfigurationT void) 
    (make ConfigurationT 15 09 00 14 
       10 11 12 08 
       03 02 13 07 
       01 06 05 04) 
    )lambda 
)define 

(define ParticularPuzzleToSolve HardPuzzle5) 

(define PrintConfiguration 
    (action (procedure [Puzzle (reference ConfigurationT)]) 
    (do [position BoardPositionT] +0 PuzzleAreaMinus1 +1 
     (;; (ifthenelse (<= Puzzle:position 9) 
     (;; (PAR:PutConsoleCharacter "0")(PAR:PutConsoleNatural Puzzle:position));; 
     (PAR:PutConsoleNatural Puzzle:position) 
     )ifthenelse 
     (PAR:PutConsoleSpace) 
     (ifthen (== (modulo (coerce natural position) (coerce natural PuzzleSize)) 
       (coerce natural PuzzleSizeMinus1)coerce)== 
      (PAR:PutConsoleNewline) 
    )ifthen 
    );; 
)do 
    )action 
)define 

(define Solved? `Determines if puzzle is solved.' 
    (lambda (function boolean 
     [board (reference ConfigurationT)] 
    )function       
    (value (;; `Fast check for completed': 
     (ifthen (~= board:0 BlankTile) 
      (return ~f) 
     )ifthen 
     (do [position BoardPositionT] PuzzleAreaMinus1 +1 -1 
     (ifthen (~= board:position (coerce natural position)) 
      (return ~f) 
     )ifthen 
     )do 
    );; 
    ~t ; all pieces are in proper places 
)value 
    )lambda 
)define 

(define ScoreT `Estimate of configuration distance from solution. 
     Zero means configuration is a solution.' 
    (sort natural (range 0 1000))) ; s/b (range 0 (* PuzzleArea PuzzleArea)) 

(define SolvedScore `The score of a goal position.' 0) 
(define UnsolvableScore `An impossibly big score.' 12345678) 

(define LowerBoundOnScore 
    (lambda (function ScoreT [Puzzle (reference ConfigurationT)]) 
    (let (= [OutOfPlaceTiles ScoreT] 0) 
    (value 
    (compileifthenelse ManhattanHeuristic ; ~t for Out-of-place, ~f for Manhattan 
     (do [Row BoardPositionT] PuzzleSizeMinus1 +0 -1 
      (do [Column BoardPositionT] PuzzleSizeMinus1 +0 -1 
      (local (;; (= [position integer] (+ (* Row PuzzleSize) 
            Column))= 
        (= [tile puzzlepieceT] Puzzle:position) 
      );; 
       (ifthen (~= tile BlankTile) ; ignore BlankTile 
      (+= OutOfPlaceTiles 
        (+ (magnitude (- Row (coerce integer (// tile (coerce natural PuzzleSize))))) 
        (magnitude (- Column (coerce integer (modulo tile (coerce natural PuzzleSize))))) 
        )+ ; add Manhattan distance of tile from tile goal 
      )+= 
      )ifthen 
      )local 
      )do ; Column 
     )do ; Row 
     (do [position BoardPositionT] PuzzleAreaMinus1 
        +1 ; skipping zero effectively ignores BlankTile 
        +1 
      (ifthen (~= Puzzle:position (coerce natural position)) 
       (+= OutOfPlaceTiles) 
      )ifthen 
     )do 
    )compileifthenelse 
    OutOfPlaceTiles ; the answer 
    )value 
)let 
    )lambda 
)define 

(recursive PathElementT 
    (define PathElementT `A series of moves of the blank tile.' 
     (structure [Move BoardPositionT] 
      [Next (reference PathElementT)] 
     )structure 
    )define 
)recursive 

(define EmptyPath (void (reference PathElementT))void)define 

(define ValuedPathT `A path and the score it acheives.' 
    (structure [Solved boolean] 
      [Score ScoreT] 
      [Path (reference PathElementT)]) 
)define 

(define MakeMove `Applies a move to a configuration' 
    (lambda (function ConfigurationT 
     (structure [BlankTilePosition BoardPositionT] 
       [NewBlankPosition BoardPositionT] 
       [ConfigurationBeforeMove 
         (reference ConfigurationT)] 
      )structure)function 
(let (= [ResultConfiguration ConfigurationT] 
     (@ ConfigurationBeforeMove) )= 
     (value   
    (;; 
     (compileifthen PrintTrace 
     (;; (PAR:PutConsoleNatural BlankTilePosition) 
      (PAR:PutConsoleNatural NewBlankPosition) 
     );; 
     )compileifthen 
     (trust (== ConfigurationBeforeMove:BlankTilePosition 
      BlankTile)) 
     (= ResultConfiguration:BlankTilePosition 
     ConfigurationBeforeMove:NewBlankPosition) 
     (= ResultConfiguration:NewBlankPosition BlankTile) 
    );; 
    ResultConfiguration 
    )value         
)let 
    )lambda 
)define 

(define TopEdge? `Determines if a position is along top edge of puzzle.' 
    (lambda (function boolean BoardPositionT) 
    (< ? PuzzleSize) 
    )lambda 
)define 

(define BottomEdge? `Determines if a position is along bottom edge of puzzle.' 
    (lambda (function boolean BoardPositionT) 
    (>= ? (- PuzzleArea PuzzleSize)) 
    )lambda 
)define 

(define LeftEdge? `Determines if a position is along left edge of puzzle.' 
    (lambda (function boolean BoardPositionT) 
    (== (modulo (coerce natural ?) (coerce natural PuzzleSize)) 0)== 
    )lambda 
)define 

(define RightEdge? `Determines if a position is along right edge of puzzle.' 
    (lambda (function boolean BoardPositionT) 
    (== (modulo (coerce natural ?) (coerce natural PuzzleSize))modulo 
     (coerce natural PuzzleSizeMinus1)coerce)== 
    )lambda 
)define 

(define Solved! (exception (lambda (function string (reference ValuedPathT)) 
        `N-puzzle solution is:~l' 
       )lambda 
     )exception 
)define 

[SerialPrint semaphore] 

[MaxMoves natural] 

(define Npuzzle 
    (lambda (function ValuedPathT 
     [BlankTilePosition BoardPositionT] 
     [PreviousBlankTilePosition BoardPositionT] 
     [Puzzle ConfigurationT] 
     [MovesToHere natural] 
     )function 
)lambda 
)define 

(define Npuzzle `Solves a puzzle and generates a sequence which is a solution.' 
    (lambda (function ValuedPathT 
     [BlankTilePosition BoardPositionT] 
     [PreviousBlankTilePosition BoardPositionT] 
     [Puzzle ConfigurationT] 
     [MovesToHere natural] 
    )function 
(ifthenelse (value (compileifthen PrintTrace 
      (;; (PAR:PutConsole (. `In Npuzzle at depth ')) 
       (PAR:PutConsoleNatural MovesToHere) (PAR:PutConsoleNewline) 
       (PrintConfiguration (. Puzzle)) 
      );; 
      )compileifthen 
      (Solved? (. Puzzle))) 
    (make ValuedPathT ~t 0 EmptyPath)make ; the answer 
    (let (|| [valuedpath1 ValuedPathT] 
     [valuedpath2 ValuedPathT] 
     [valuedpath3 ValuedPathT] 
     [valuedpath4 ValuedPathT] 
     [Best ValuedPathT] 
     (= [EstimatedDistance natural] 
      (+ MovesToHere (LowerBoundOnScore (. Puzzle)))+)= 
    )|| 
    (ifthenelse (value (compileifthen PrintTrace 
       (;; (PAR:PutConsole (. `Inside LET EstimatedDistance= ')) 
       (PAR:PutConsoleNatural EstimatedDistance) (PAR:PutConsoleNewline) 
       );; 
      )compileifthen 
      (> EstimatedDistance MaxMoves)) 
    (make ValuedPathT ~f EstimatedDistance EmptyPath) ; don't explore any further 
    (value 
     (;; (assert (& (<= +0 BlankTilePosition) 
       (< BlankTilePosition PuzzleArea))&)assert 
; (PAR:PutConsole (. `Solve subpuzzles: blank @ '))(PAR:PutConsoleNatural BlankTilePosition)(PAR:PutConsoleNewline) 

      (try `Solve subpuzzles': 
      (|| ; replace this by (;; to see pure serial execution times 
       `Fork Right': 
       (local (|| (= [NewBlankTilePosition BoardPositionT] 
        (++ BlankTilePosition))= 
       [ExtendedPath (reference PathElementT)] 
       )|| 
      (ifthenelse (value (;; ; (PAR:PutConsole (. `Fork Right~l')) 
         );; 
       (&& (~= NewBlankTilePosition 
        PreviousBlankTilePosition)~= 
       (~ (RightEdge? BlankTilePosition))~ 
       )&&)value 
       (;; (= valuedpath1 
        (Npuzzle NewBlankTilePosition 
         BlankTilePosition 
         (MakeMove BlankTilePosition 
           NewBlankTilePosition 
           (. Puzzle))MakeMove 
         (++ MovesToHere) 
        )Npuzzle)= 
       (ifthen valuedpath1:Solved 
        (;; (+= valuedpath1:Score) ; since we added a move 
         (= ExtendedPath (new PathElementT)) 
         (= (@ ExtendedPath) (make PathElementT NewBlankTilePosition valuedpath1:Path))= 
         (= valuedpath1:Path ExtendedPath) 
         (raise Solved! (. valuedpath1)) 
        );; 
       )ifthen 
       );; 
       (= valuedpath1 (make ValuedPathT ~f UnsolvableScore EmptyPath))= 
      )ifthenelse 
      )local 
       `Fork Left': 
       (local (|| (= [NewBlankTilePosition BoardPositionT] 
        (-- BlankTilePosition))= 
       [ExtendedPath (reference PathElementT)] 
       )|| 
      (ifthenelse (value (;; ; (PAR:PutConsole (. `Fork Left~l')) 
         );; 
       (&& (~= NewBlankTilePosition 
        PreviousBlankTilePosition)~= 
       (~ (LeftEdge? BlankTilePosition))~ 
       )&&)value 
       (;; (= valuedpath2 
        (Npuzzle NewBlankTilePosition 
         BlankTilePosition 
         (MakeMove BlankTilePosition 
           NewBlankTilePosition 
           (. Puzzle))MakeMove 
         (++ MovesToHere) 
        )Npuzzle)= 
       (ifthen valuedpath2:Solved 
        (;; (+= valuedpath2:Score) ; since we added a move 
         (= ExtendedPath (new PathElementT)) 
         (= (@ ExtendedPath) (make PathElementT NewBlankTilePosition valuedpath2:Path))= 
         (= valuedpath2:Path ExtendedPath) 
         (raise Solved! (. valuedpath2)) 
        );; 
       )ifthen 
       );; 
       (= valuedpath2 (make ValuedPathT ~f UnsolvableScore EmptyPath))= 
      )ifthenelse 
      )local 
       `Fork Down': 
       (local (|| (= [NewBlankTilePosition BoardPositionT] 
        (- BlankTilePosition PuzzleSize))= 
       [ExtendedPath (reference PathElementT)] 
       )|| 
      (ifthenelse (value (;; ; (PAR:PutConsole (. `Fork Down~l')) 
         );; 
       (&& (~= NewBlankTilePosition 
        PreviousBlankTilePosition)~= 
       (~ (TopEdge? BlankTilePosition))~ 
       )&&)value 
       (;; (= valuedpath3 
        (Npuzzle NewBlankTilePosition 
         BlankTilePosition 
         (MakeMove BlankTilePosition 
           NewBlankTilePosition 
           (. Puzzle))MakeMove 
         (++ MovesToHere) 
        )Npuzzle)= 
       (ifthen valuedpath3:Solved 
        (;; (+= valuedpath3:Score) ; since we added a move 
         (= ExtendedPath (new PathElementT)) 
         (= (@ ExtendedPath) (make PathElementT NewBlankTilePosition valuedpath3:Path))= 
         (= valuedpath3:Path ExtendedPath) 
         (raise Solved! (. valuedpath3)) 
        );; 
       )ifthen 
       );; 
       (= valuedpath3 (make ValuedPathT ~f UnsolvableScore EmptyPath))= 
      )ifthenelse 
      )local 
       `Fork Up': 
       (local (|| (= [NewBlankTilePosition BoardPositionT] 
        (+ BlankTilePosition PuzzleSize))= 
       [ExtendedPath (reference PathElementT)] 
       )|| 
      (ifthenelse (value (;; ; (PAR:PutConsole (. `Fork Up~l')) 
         );; 
       (&& (~= NewBlankTilePosition 
        PreviousBlankTilePosition)~= 
       (~ (BottomEdge? BlankTilePosition))~ 
       )&&)value 
       (;; (= valuedpath4 
        (Npuzzle NewBlankTilePosition 
         BlankTilePosition 
         (MakeMove BlankTilePosition 
           NewBlankTilePosition 
           (. Puzzle))MakeMove 
         (++ MovesToHere) 
        )Npuzzle)= 
       (ifthen valuedpath4:Solved 
        (;; (+= valuedpath4:Score) ; since we added a move 
         (= ExtendedPath (new PathElementT)) 
         (= (@ ExtendedPath) (make PathElementT NewBlankTilePosition valuedpath4:Path))= 
         (= valuedpath4:Path ExtendedPath) 
         (raise Solved! (. valuedpath4)) 
        );; 
       )ifthen 
       );; 
       (= valuedpath4 (make ValuedPathT ~f UnsolvableScore EmptyPath))= 
      )ifthenelse 
      )local 
     ) ; || or ;; 
      `Exception handler': 
      (;; ; (PAR:PutConsole (. `Exception handler~l')) 
       (ifthenelse (== (exception) Solved!)== 
      (;; (= Best (@ (exceptionargument (reference ValuedPathT))))= 
       (acknowledge (;;);;)acknowledge 
      );; 
      (propagate) ; oops, something unexpected! 
      )ifthenelse 
     );; 
      `Success handler': 
      (;; ; (PAR:PutConsole (. `Success (no exception raised)!~l')) 
       `If we get here, no result is a solution, 
       and all results have leaf-estimated scores.' 
       (ifthenelse (< valuedpath1:Score valuedpath2:Score) 
      (= Best valuedpath1) 
      (= Best valuedpath2) 
      )ifthenelse 
       (ifthen (< valuedpath3:Score Best:Score) 
        (= Best valuedpath3))ifthen 
       (ifthen (< valuedpath4:Score Best:Score) 
        (= Best valuedpath4))ifthen 
     );; 
     )try 
    );; 
    Best ; the answer to return 
    )value 
    )ifthenelse 
)let 
)ifthenelse 
)lambda 
)define 

[StartTimeMicroseconds natural] 
(define ElapsedTimeSeconds 
    `Returns time in seconds rounded to nearest integer' 
    (lambda (function natural void) 
     (/ (- (+ (MicrosecondClock) 500000) StartTimeMicroseconds) 1000000) 
    )lambda 
)define 

(define main 
    (action (procedure void) 
    (local (|| [PuzzleToSolve ConfigurationT] 
     [BlankTilePosition BoardPositionT] 
     [Solution ValuedPathT] 
     [BlankLocation BoardPositionT] 
     [Neighbor BoardPositionT] 
     [PathScanP (reference PathElementT)] 
     [ElapsedTime natural] 
    )|| 
    (;; (PAR:PutConsoleString Version) 
    (consume (addresource SerialPrint 1)) 
    `Set PuzzleToSolve to Solved position': 
    (do [position BoardPositionT] +0 PuzzleAreaMinus1 +1 
     (= PuzzleToSolve:position (coerce puzzlepieceT position))= 
    )do 
    (ifthenelse SolveParticularPuzzle 
     (;; (PAR:PutConsole (. `Hard puzzle...~l')) 
     (= PuzzleToSolve (ParticularPuzzleToSolve))=);; 
     (;; `Scramble puzzle position' 
     (PAR:PutConsole (. `Random puzzle...~l')) 
     (= BlankLocation +0) 
     (do [i natural] 1 (modulo (MicrosecondClock) 
         ScrambleCount)modulo 1 
      (;; (= Neighbor BlankLocation) 
      (ifthenelse (== (PAR:GetRandomNat 2) 0) 
       (;; `Move Blank up or down' 
       (ifthenelse (== (PAR:GetRandomNat 2) 0) 
        (ifthen (~ (TopEdge? BlankLocation)) (-= Neighbor PuzzleSize)) 
        (ifthen (~ (BottomEdge? BlankLocation)) (+= Neighbor PuzzleSize)) 
       )ifthenelse 
       );; 
       (;; `Move Blank left or right' 
        (ifthenelse (== (PAR:GetRandomNat 2) 0) 
        (ifthen (~ (LeftEdge? BlankLocation)) (-= Neighbor)) 
        (ifthen (~ (RightEdge? BlankLocation)) (+= Neighbor)) 
        )ifthenelse 
       );; 
      )ifthenelse 
      ; (PAR:PutConsoleNatural BlankLocation)(PAR:PutConsoleNatural Neighbor)(PAR:PutConsoleSpace) 
      (ifthen (~= BlankLocation Neighbor) 
       (= PuzzleToSolve 
        (MakeMove BlankLocation Neighbor (. PuzzleToSolve).)MakeMove)= 
      )ifthen 
      (= BlankLocation Neighbor)= 
      );; 
     )do 
     );; 
    )ifthenelse 
    (;; `Initialize solver' 
     (= Solution:Solved ~f) 
     (= Solution:Score 0) 
     (do FindBlankTile 
     [position BoardPositionT] +0 PuzzleAreaMinus1 +1 
      (ifthen (== PuzzleToSolve:position BlankTile) 
         (;; (= BlankTilePosition position) 
          (exitblock FindBlankTile) 
          );;)ifthen)do 
    );; 
    (PAR:PutConsole (. `~lInitial Configuration:~l')) 
    (PrintConfiguration (. PuzzleToSolve)) 
    (PAR:PutConsole (. `Estimate of solution length: ')) 
    (PAR:PutConsoleNatural (LowerBoundOnScore (. PuzzleToSolve))) 
    (PAR:PutConsoleNewline) 
    (= StartTimeMicroseconds (MicrosecondClock)) 
    (while (~ Solution:Solved) 
     (;; (critical SerialPrint 1 
      (;; (PAR:PutConsole (. `*** Iteration to depth ')) 
      (PAR:PutConsoleNatural Solution:Score) 
      (PAR:PutConsole (. ` ')) (PAR:PutConsoleNatural (ElapsedTimeSeconds)) (PAR:PutConsole (. ` Seconds')) 
      (PAR:PutConsoleNewline) 
      );; 
     )critical 
     (= MaxMoves Solution:Score) 
     (= Solution (Npuzzle BlankTilePosition BlankTilePosition PuzzleToSolve 0))= 
     );; 
    )while 
    (= ElapsedTime (ElapsedTimeSeconds)) 
    (critical SerialPrint 1 
     (;; (PAR:PutConsole (. `Solution found of length ')) 
     (PAR:PutConsoleNatural Solution:Score) (PAR:PutConsole (. `: ')) 
     (iterate (= PathScanP Solution:Path) 
      (~= PathScanP EmptyPath) 
      (= PathScanP PathScanP:Next) 
      (;; (PAR:PutConsoleNatural (coerce natural PathScanP:Move)) (PAR:PutConsoleSpace) 
      );; 
     )iterate 
     (PAR:PutConsoleNewline) 
     (PAR:PutConsole (. `Total solution time in seconds: ')) (PAR:PutConsoleNatural ElapsedTime) (PAR:PutConsoleNewline) 
     );; 
    )critical 
    );; 
)local 
    )action 
)define 
1

The little book of semaphores che è disponibile liberamente libro ha un sacco di puzzle di sincronizzazione. Include quasi tutti i puzzle citati in altre risposte. Le soluzioni sono fornite per tutti i puzzle.