多线程谜题

发布于 2024-08-14 06:31:25 字数 93 浏览 2 评论 0原文

我正在尝试提出一些专注于多线程的编程难题。到目前为止,我能够提出的大多数问题都是特定领域的。对于尝试学习多线程应用程序核心概念的开发人员来说,是否有人有任何像样的编程难题?

I'm trying to come up with some programming puzzles focused on multi-threading. Most of the problems I've been able to come up with, so far, have been pretty domain specific. Does anybody have any decent programming puzzles for developers attempting to learn the core concepts of multi-threading applications?

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(12

疧_╮線 2024-08-21 06:31:25

此链接涵盖了许多主题。

使用 ThreadMentor 进行多线程编程:教程

<强>编辑:

以下是该链接中列出的问题的一些直接链接及其初始描述。

ThreadMentor:餐饮哲学家的问题
ThreadMentor:餐饮哲学家的问题:左-右版本

哲学家就餐问题是由 EW Dijkstra 发明的。想象一下,五位哲学家一生都在思考和东方。餐厅中央有一张圆桌和五把椅子。桌子上有一大盘意大利面。然而,可用的筷子只有五根,如下图所示。每个哲学家都会思考。当他饿了的时候,他就会坐下来,拿起离他最近的两根筷子。如果一个哲学家能拿起两只筷子,他就可以吃一会儿。哲学家吃完饭后,放下筷子开始思考。

ThreadMentor:吸烟者的问题

这个问题是 SS Patil 在 1971 年提出的。假设一支香烟需要三种成分,烟草、纸和火柴。有三个连续吸烟者。每一种都只有一种成分,而且供应无限。有一个特工拥有无限量的所有三种成分的供应。为了制作香烟,吸烟者必须拥有烟草(分别为纸和火柴),并且必须拥有另外两种成分纸和火柴(分别为烟草和火柴,以及烟草和纸)。代理人和吸烟者共用一张桌子。代理随机生成两种成分,并通知需要这两种成分的吸烟者。一旦配料从桌子上拿走,代理商就会再提供两种。另一方面,每个吸烟者都在等待代理人的通知。接到通知后,吸烟者拿起食材,抽一支烟,吸一会儿,然后回到餐桌上等待下一个食材。

ThreadMentor:生产者/消费者(或有界缓冲区)问题

假设我们有一个循环缓冲区,有两个指针进出,指示下一个可用于存储数据的位置以及包含下一个要检索的数据的位置。参见下图。有两组线程:生产者和消费者。每个生产者将数据项存入 in 位置并将指针前进,每个消费者检索 in 位置的数据项并将指针前进。

ThreadMentor:过山车问题

假设有 n 位乘客和一辆过山车。乘客反复等待乘车,车厢最多可容纳C名乘客,其中C<1。名词然而,汽车只有在满员的情况下才能绕赛道行驶。结束一次乘坐后,每位乘客都会在游乐园里闲逛,然后返回过山车进行另一次乘坐。出于安全考虑,小车只行驶了T次,然后就出发了。

这辆车还有额外的限制:

  1. 汽车总是搭载 C 名乘客;
  2. 汽车行驶时乘客不会跳下车;
  3. 汽车行驶时乘客不会跳上车;
  4. 乘客在下车之前不会再要求乘车。

ThreadMentor:桥梁问题

这个问题的描述依赖于图像。这是删除了图像引用的修改后的报价。

考虑一座狭窄的桥梁,只能允许同一方向的三辆车同时通过。如果桥上有三辆车,任何驶来的车辆都必须等待桥上没有人。

当车辆驶出桥梁时,我们需要考虑两种情况。情况1、桥上有其他车辆;情况 2 退出的车辆是桥上的最后一辆车。在第一种情况下,应允许同一方向的新车辆继续行驶。

情况 2 更为复杂,有两个子情况。在这种情况下,离开的车辆是桥上的最后一辆车。如果对向有车辆等候,应允许其中一辆车继续行驶。或者,如果对向没有等待的车辆,则让同方向等待的车辆继续行驶。

There are a number of topics covered at this link.

Multithreaded Programming with ThreadMentor : A Tutorial

Edit:

Here are some direct links to the problems listed at that link, along with their initial descriptions.

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

The dining philosophers problem is invented by E. W. Dijkstra. Imagine that five philosophers who spend their lives just thinking and easting. In the middle of the dining room is a circular table with five chairs. The table has a big plate of spaghetti. However, there are only five chopsticks available, as shown in the following figure. Each philosopher thinks. When he gets hungry, he sits down and picks up the two chopsticks that are closest to him. If a philosopher can pick up both chopsticks, he eats for a while. After a philosopher finishes eating, he puts down the chopsticks and starts to think.

ThreadMentor : The Cigarette Smoker's Problem

This problem is due to S. S. Patil in 1971. Suppose a cigarette requires three ingredients, tobacco, paper and match. There are three chain smokers. Each of them has only one ingredient with infinite supply. There is an agent who has infinite supply of all three ingredients. To make a cigarette, the smoker has tobacco (resp., paper and match) must have the other two ingredients paper and match (resp., tobacco and match, and tobacco and paper). The agent and smokers share a table. The agent randomly generates two ingredients and notifies the smoker who needs these two ingredients. Once the ingredients are taken from the table, the agent supplies another two. On the other hand, each smoker waits for the agent's notification. Once it is notified, the smoker picks up the ingredients, makes a cigarette, smokes for a while, and goes back to the table waiting for his next ingredients.

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

Suppose we have a circular buffer with two pointers in and out to indicate the next available position for depositing data and the position that contains the next data to be retrieved. See the diagram below. There are two groups of threads, producers and consumers. Each producer deposits a data items into the in position and advances the pointer in, and each consumer retrieves the data item in position out and advances the pointer out.

ThreadMentor : The Roller Coaster Problem

Suppose there are n passengers and one roller coaster car. The passengers repeatedly wait to ride in the car, which can hold maximum C passengers, where C < n. However, the car can go around the track only when it is full. After finishes a ride, each passenger wanders around the amusement park before returning to the roller coaster for another ride. Due to safety reasons, the car only rides T times and then shot-off.

This one has additional constraints:

  1. The car always rides with exactly C passengers;
  2. No passengers will jump off the car while the car is running;
  3. No passengers will jump on the car while the car is running;
  4. No passengers will request another ride before they can get off the car.

ThreadMentor : The Bridge Problem

The description for this one relies on images. Here is a modified quote with image references removed.

Consider a narrow bridge that can only allow three vehicles in the same direction to cross at the same time. If there are three vehicles on the bridge, any incoming vehicle must wait until the bridge is clear.

When a vehicle exits the bridge, we have two cases to consider. Case 1, there are other vehicles on the bridge; and Case 2 the exiting vehicle is the last one on bridge. In the first case, one new vehicle in the same direction should be allowed to proceed.

Case 2 is more complicated and has two subcases. In this case, the exiting vehicle is the last vehicle on the bridge. If there are vehicles waiting in the opposite direction, one of them should be allowed to proceed. Or, if there is no vehicle waiting in the opposite direction, then let the waiting vehicle in the same direction to proceed.

青春有你 2024-08-21 06:31:25

用餐哲学家问题,是我第一个想到的问题。

The Dining Philosophers Problem, is the first one I think of.

霓裳挽歌倾城醉 2024-08-21 06:31:25

你的内存中有一个很大的树结构。许多线程需要搜索该结构。有时,线程需要在结构中插入或删除某些内容。如何控制对结构的访问,以便程序能够正确运行(在更改结构时没有两个线程会相互干扰)并且高效(线程在不必要时不会被阻塞)?

You have a large tree structure in memory. Many threads need to search the structure. Occasionally, a thread will need to insert or remove something from the structure. How do you control access to the structure so that the program will run correctly (no two threads will stomp on each other while changing the structure) and efficiently (no threads are blocked when they don't have to be)?

椒妓 2024-08-21 06:31:25

哲学家就餐就是其中之一...

男女通用浴室是另一间

Dining philosophers is one...

unisex bathroom is another one

云淡风轻 2024-08-21 06:31:25

也许您可以使用测试和设置共享标志或以某种顺序一致的方式访问某种列表资源的简单问题?

Perhaps you can use the simple problem of testing and setting a shared flag or accessing some kind of list resource in some kind of sequentially consistent manner?

谁人与我共长歌 2024-08-21 06:31:25

这是我用多线程完成的第一个问题,回来在我本科学习期间。

Here's the first problem I ever completed with multi-threading, back during my undergraduate studies.

孤蝉 2024-08-21 06:31:25

电梯模拟器非常常见。

An Elevator Simulator is pretty common.

回眸一笑 2024-08-21 06:31:25

根据您使用多线程所做的事情,这会有所不同。

你在银行。平均每 2 分钟就有 1 名顾客到达。平均每名顾客在 2 分钟内得到服务。

哪种解决方案可以更好地服务客户?一根公用线,还是每个柜员一根线?

您的选择是否足以保证线路长度的一定限制?

答案:由于顾客到达的马尔可夫特性和每个人的实际服务时间,线路永远不会有界限。此外,让他们排成一队等待也是一个好主意,尽管这不足以克服无边无际的排队。

Depending upon what you are doing with your multi-threading, this makes a difference.

You are in a bank. Customers arrive at an average rate of 1 every 2 minutes. Each customer is served, on average, in 2 minutes.

Which is the better solution to serving the customers? One common line, or one line for each teller?

Is your choice enough to guarantee some bound on the length of the line?

Answers: because of the markov property of customer arrival and actual service time per individual, the line will never know a bound. additionally, it's a good idea to make them wait in one common line, although this is not enough to overcome the boundless line.

轻拂→两袖风尘 2024-08-21 06:31:25

这是在 PARLANSE 中实现的并行 N 谜题求解器。该语言具有类似 LISP 的语法,但实际上更接近 C(标量、结构、指针、函数调用),但与 C 不同的是,它具有本地作用域。秘密在于并行 fork-grain 运算符 (|| ... ),它并行执行其所有操作数,以及 PARLANSE 使用异常来停止父 Grain 的能力。

该解算器在我尝试过的所有 4 路和 8 路机器上都能提供线性加速。

(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

Here's a parallel N-puzzle solver implemented in PARLANSE. The language has a LISP-like syntax but is really closer to C (scalars, structs, pointers, function calls), but unlike C has local scopes. The secret is in the parallel fork-grain operator (|| ... ) which executes all of its operands in parallel, as well as PARLANSE's ability to use exceptions to stop parent grains.

This solver delivers linear speedups on all the 4 and 8 way machines on which I have tried it.

(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
久伴你 2024-08-21 06:31:25

信号量小书是免费提供的书,其中有很多同步难题。它几乎包含了其他答案中引用的所有谜题。为所有谜题提供了解决方案。

The little book of semaphores which is freely available book has lots of synchronization puzzles. It includes almost all the puzzles cited in other answers. Solutions are provided for all the puzzles.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文