2009-12-07 23 views
22

Estoy tratando de encontrar algunos acertijos de programación enfocados en multi-threading. La mayoría de los problemas que he podido encontrar, hasta ahora, han sido bastante específicos del dominio. ¿Alguien tiene algún acertijo de programación decente para los desarrolladores que intentan aprender los conceptos básicos de las aplicaciones multihilo?Rompecabezas de subprocesamiento múltiple

Respuesta

11

Hay una serie de temas tratados en este enlace.

Multithreaded Programming with ThreadMentor : A Tutorial

Editar:

Éstos son algunos enlaces directos a los problemas enumerados en ese enlace, junto con sus descripciones iniciales.

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

El problema de la cena de los filósofos es inventado por E. W. Dijkstra. Imagina a los cinco filósofos que se pasan la vida pensando y mirando. En el medio del comedor hay una mesa circular con cinco sillas. La mesa tiene un gran plato de espagueti. Sin embargo, solo hay cinco palillos disponibles, como se muestra en la siguiente figura. Cada filósofo piensa. Cuando tiene hambre, se sienta y recoge los dos palillos que están más cerca de él. Si un filósofo puede agarrar ambos palillos, come por un tiempo. Después de que un filósofo termina de comer, deja los palillos y comienza a pensar.

ThreadMentor : The Cigarette Smoker's Problem

Este problema se debe a S. S. Patil en 1971. Supongamos que un cigarrillo requiere tres ingredientes, tabaco, papel y los partidos. Hay tres fumadores de cadena. Cada uno de ellos tiene solo un ingrediente con un suministro infinito. Hay un agente que tiene un suministro infinito de los tres ingredientes. Para hacer un cigarrillo, el fumador tiene tabaco (resp., Papel y fósforo) debe tener los otros dos ingredientes de papel y combinar (resp., Tabaco y fósforos, y tabaco y papel). El agente y los fumadores comparten una mesa. El agente genera aleatoriamente dos ingredientes y notifica al fumador que necesita estos dos ingredientes. Una vez que los ingredientes se toman de la mesa, el agente suministra otros dos. Por otro lado, cada fumador espera la notificación del agente.Una vez que se le notifica, el fumador recoge los ingredientes, hace un cigarrillo, fuma durante un rato y vuelve a la mesa esperando sus próximos ingredientes.

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

Supongamos que tenemos un buffer circular con dos punteros dentro y fuera para indicar la siguiente posición disponible para el depósito de los datos y la posición que contiene los siguientes datos para ser recuperados. Vea el diagrama a continuación. Hay dos grupos de hilos, productores y consumidores. Cada productor deposita un ítem de datos en la posición de entrada y avanza el puntero hacia adentro, y cada consumidor recupera el ítem de datos en posición y saca el puntero.

ThreadMentor : The Roller Coaster Problem

Supongamos que hay N pasajeros y un rodillo vagón de la montaña. Los pasajeros esperan repetidamente para viajar en el automóvil, que puede contener un máximo de pasajeros C, donde C < n. Sin embargo, el automóvil puede ir por la pista solo cuando está lleno. Después de terminar un viaje, cada pasajero deambula por el parque de atracciones antes de regresar a la montaña rusa para otro paseo. Por razones de seguridad, el automóvil solo viaja T veces y luego se dispara.

Ésta tiene limitaciones adicionales:

  1. El coche siempre viaja con exactamente los pasajeros C;
  2. Ningún pasajero saltará del automóvil mientras el automóvil está en marcha;
  3. Ningún pasajero saltará sobre el automóvil mientras el automóvil está en marcha;
  4. Ningún pasajero solicitará otro viaje antes de que pueda bajarse del automóvil.

ThreadMentor : The Bridge Problem

La descripción de este uno se basa en las imágenes. Aquí hay una cita modificada con referencias de imagen eliminadas.

Considere un puente angosto que solo permita que tres vehículos en la misma dirección se crucen al mismo tiempo. Si hay tres vehículos en el puente, cualquier vehículo que ingrese debe esperar hasta que el puente esté despejado.

Cuando un vehículo sale del puente, tenemos dos casos a considerar. Caso 1, hay otros vehículos en el puente; y Caso 2 el vehículo que sale es el último en el puente. En el primer caso, se debe permitir que proceda un vehículo nuevo en la misma dirección.

El caso 2 es más complicado y tiene dos subcampos. En este caso, el vehículo que sale es el último vehículo en el puente. Si hay vehículos esperando en la dirección opuesta, se debe permitir que uno de ellos proceda. O bien, si no hay ningún vehículo esperando en la dirección opuesta, deje que el vehículo en espera en la misma dirección continúe.

1

Tal vez se puede utilizar el sencillo problema de las pruebas y el establecimiento de una bandera compartida o acceder a algún tipo de lista de recursos en algún tipo de forma secuencial consistente ?

2

Tiene una gran estructura de árbol en la memoria. Muchos hilos necesitan buscar en la estructura. Ocasionalmente, un hilo necesitará insertar o quitar algo de la estructura. ¿Cómo se controla el acceso a la estructura para que el programa se ejecute correctamente (no hay dos subprocesos pisoteando entre sí mientras se cambia la estructura) y de manera eficiente (no se bloquean los subprocesos cuando no tienen que serlo)?

1

Aquí está el first problem que he completado con multi-threading, de vuelta durante mis estudios de pregrado.

1

Dependiendo de lo que esté haciendo con su multi-threading, esto hace la diferencia.

Estás en un banco. Los clientes llegan a una tasa promedio de 1 cada 2 minutos. Cada cliente se sirve, en promedio, en 2 minutos.

¿Cuál es la mejor solución para atender a los clientes? ¿Una línea común o una línea para cada cajero?

¿Es su elección suficiente para garantizar algún límite en la longitud de la línea?

Respuestas: debido a la propiedad de markov de llegada del cliente y el tiempo de servicio real por individuo, la línea nunca conocerá un límite. Además, es una buena idea hacerlos esperar en una línea común, aunque esto no es suficiente para superar la línea ilimitada.

1

Aquí hay un solucionador paralelo de N-rompecabezas implementado en PARLANSE. El lenguaje tiene una sintaxis similar a LISP, pero está realmente más cerca de C (escalares, estructuras, punteros, llamadas a funciones), pero a diferencia de C tiene alcances locales. El secreto está en el operador paralelo de grano de horquilla (|| ...) que ejecuta todos sus operandos en paralelo, así como la capacidad de PARLANSE de usar excepciones para detener granos primarios.

Este solucionador ofrece aceleraciones lineales en todas las máquinas de 4 y 8 vías en las que lo he probado.

(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 que es libro de libre disponibilidad tiene un montón de acertijos de sincronización. Incluye casi todos los rompecabezas citados en otras respuestas. Se proporcionan soluciones para todos los acertijos.

Cuestiones relacionadas