Merge branch 'master' into 817-updated

Conflicts:
	lib/linguist/samples.json
This commit is contained in:
Arfon Smith
2014-04-21 11:23:48 -05:00
6 changed files with 1627 additions and 4 deletions

View File

@@ -618,7 +618,7 @@ Fancy:
- .fancypack
filenames:
- Fakefile
Fantom:
type: programming
color: "#dbded5"
@@ -632,6 +632,12 @@ Forth:
extensions:
- .4th
Frege:
type: programming
color: "#00cafe"
lexer: Haskell
primary_extension: .fr
Game Maker Language:
type: programming
lexer: JavaScript

View File

@@ -135,6 +135,9 @@
".forth",
".fth"
],
"Frege": [
".fr"
],
"Game Maker Language": [
".gml"
],
@@ -584,8 +587,8 @@
".gemrc"
]
},
"tokens_total": 471163,
"languages_total": 585,
"tokens_total": 476727,
"languages_total": 589,
"tokens": {
"ABAP": {
"*/**": 1,
@@ -18164,6 +18167,787 @@
"/cell": 2,
"cell": 2
},
"Frege": {
"module": 2,
"examples.CommandLineClock": 1,
"where": 39,
"data": 3,
"Date": 5,
"native": 4,
"java.util.Date": 1,
"new": 9,
"(": 339,
")": 345,
"-": 730,
"IO": 13,
"MutableIO": 1,
"toString": 2,
"Mutable": 1,
"s": 21,
"ST": 1,
"String": 9,
"d.toString": 1,
"action": 2,
"to": 13,
"give": 2,
"us": 1,
"the": 20,
"current": 4,
"time": 1,
"as": 33,
"do": 38,
"d": 3,
"<->": 35,
"java": 5,
"lang": 2,
"Thread": 2,
"sleep": 4,
"takes": 1,
"a": 99,
"long": 4,
"and": 14,
"returns": 2,
"nothing": 2,
"but": 2,
"may": 1,
"throw": 1,
"an": 6,
"InterruptedException": 4,
"This": 2,
"is": 24,
"without": 1,
"doubt": 1,
"public": 1,
"static": 1,
"void": 2,
"millis": 1,
"throws": 4,
"Encoded": 1,
"in": 22,
"Frege": 1,
"argument": 1,
"type": 8,
"Long": 3,
"result": 11,
"does": 2,
"defined": 1,
"frege": 1,
"Lang": 1,
"main": 11,
"args": 2,
"forever": 1,
"print": 25,
"stdout.flush": 1,
"Thread.sleep": 4,
"examples.Concurrent": 1,
"import": 7,
"System.Random": 1,
"Java.Net": 1,
"URL": 2,
"Control.Concurrent": 1,
"C": 6,
"main2": 1,
"m": 2,
"<": 84,
"newEmptyMVar": 1,
"forkIO": 11,
"m.put": 3,
"replicateM_": 3,
"c": 33,
"m.take": 1,
"println": 25,
"example1": 1,
"putChar": 2,
"example2": 2,
"getLine": 2,
"case": 6,
"of": 32,
"Right": 6,
"n": 38,
"setReminder": 3,
"Left": 5,
"_": 60,
"+": 200,
"show": 24,
"L*n": 1,
"table": 1,
"mainPhil": 2,
"[": 120,
"fork1": 3,
"fork2": 3,
"fork3": 3,
"fork4": 3,
"fork5": 3,
"]": 116,
"mapM": 3,
"MVar": 3,
"1": 2,
"5": 1,
"philosopher": 7,
"Kant": 1,
"Locke": 1,
"Wittgenstein": 1,
"Nozick": 1,
"Mises": 1,
"return": 17,
"Int": 6,
"me": 13,
"left": 4,
"right": 4,
"g": 4,
"Random.newStdGen": 1,
"let": 8,
"phil": 4,
"tT": 2,
"g1": 2,
"Random.randomR": 2,
"L": 6,
"eT": 2,
"g2": 3,
"thinkTime": 3,
"*": 5,
"eatTime": 3,
"fl": 4,
"left.take": 1,
"rFork": 2,
"poll": 1,
"Just": 2,
"fr": 3,
"right.put": 1,
"left.put": 2,
"table.notifyAll": 2,
"Nothing": 2,
"table.wait": 1,
"inter": 3,
"catch": 2,
"getURL": 4,
"xx": 2,
"url": 1,
"URL.new": 1,
"con": 3,
"url.openConnection": 1,
"con.connect": 1,
"con.getInputStream": 1,
"typ": 5,
"con.getContentType": 1,
"stderr.println": 3,
"ir": 2,
"InputStreamReader.new": 2,
"fromMaybe": 1,
"charset": 2,
"unsupportedEncoding": 3,
"br": 4,
"BufferedReader": 1,
"getLines": 1,
"InputStream": 1,
"UnsupportedEncodingException": 1,
"InputStreamReader": 1,
"x": 45,
"x.catched": 1,
"ctyp": 2,
"charset=": 1,
"m.group": 1,
"SomeException": 2,
"Throwable": 1,
"m1": 1,
"MVar.newEmpty": 3,
"m2": 1,
"m3": 2,
"r": 7,
"catchAll": 3,
".": 41,
"m1.put": 1,
"m2.put": 1,
"m3.put": 1,
"r1": 2,
"m1.take": 1,
"r2": 3,
"m2.take": 1,
"r3": 3,
"take": 13,
"ss": 8,
"mapM_": 5,
"putStrLn": 2,
"|": 62,
"x.getClass.getName": 1,
"y": 15,
"sum": 2,
"map": 49,
"length": 20,
"package": 2,
"examples.Sudoku": 1,
"Data.TreeMap": 1,
"Tree": 4,
"keys": 2,
"Data.List": 1,
"DL": 1,
"hiding": 1,
"find": 20,
"union": 10,
"Element": 6,
"Zelle": 8,
"set": 4,
"candidates": 18,
"Position": 22,
"Feld": 3,
"Brett": 13,
"for": 25,
"assumptions": 10,
"conclusions": 2,
"Assumption": 21,
"ISNOT": 14,
"IS": 16,
"derive": 2,
"Eq": 1,
"Ord": 1,
"instance": 1,
"Show": 1,
"p": 72,
"e": 15,
"pname": 10,
"e.show": 2,
"showcs": 5,
"cs": 27,
"joined": 4,
"Assumption.show": 1,
"elements": 12,
"all": 22,
"possible": 2,
"..": 1,
"positions": 16,
"rowstarts": 4,
"row": 20,
"starting": 3,
"colstarts": 3,
"column": 2,
"boxstarts": 3,
"box": 15,
"boxmuster": 3,
"pattern": 1,
"by": 3,
"adding": 1,
"upper": 2,
"position": 9,
"results": 1,
"real": 1,
"extract": 2,
"field": 9,
"getf": 16,
"f": 19,
"fs": 22,
"fst": 9,
"otherwise": 8,
"cell": 24,
"getc": 12,
"b": 113,
"snd": 20,
"compute": 5,
"list": 7,
"that": 18,
"belong": 3,
"same": 8,
"given": 3,
"z..": 1,
"z": 12,
"quot": 1,
"col": 17,
"mod": 3,
"ri": 2,
"div": 3,
"or": 15,
"depending": 1,
"on": 4,
"ci": 3,
"index": 3,
"middle": 2,
"check": 2,
"if": 5,
"candidate": 10,
"has": 2,
"exactly": 2,
"one": 2,
"member": 1,
"i.e.": 1,
"been": 1,
"solved": 1,
"single": 9,
"Bool": 2,
"true": 16,
"false": 13,
"unsolved": 10,
"rows": 4,
"cols": 6,
"boxes": 1,
"allrows": 8,
"allcols": 5,
"allboxs": 5,
"allrcb": 5,
"zip": 7,
"repeat": 3,
"containers": 6,
"PRINTING": 1,
"printable": 1,
"coordinate": 1,
"a1": 3,
"lower": 1,
"i9": 1,
"packed": 1,
"chr": 2,
"ord": 6,
"board": 41,
"printb": 4,
"p1line": 2,
"pfld": 4,
"line": 2,
"brief": 1,
"no": 4,
"some": 2,
"zs": 1,
"initial/final": 1,
"msg": 6,
"res012": 2,
"concatMap": 1,
"a*100": 1,
"b*10": 1,
"BOARD": 1,
"ALTERATION": 1,
"ACTIONS": 1,
"message": 1,
"about": 1,
"what": 1,
"done": 1,
"turnoff1": 3,
"i": 16,
"off": 11,
"nc": 7,
"head": 19,
"newb": 7,
"filter": 26,
"notElem": 7,
"turnoff": 11,
"turnoffh": 1,
"ps": 8,
"foldM": 2,
"toh": 2,
"setto": 3,
"cname": 4,
"nf": 2,
"SOLVING": 1,
"STRATEGIES": 1,
"reduce": 3,
"sets": 2,
"contains": 1,
"numbers": 1,
"already": 1,
"finds": 1,
"logs": 1,
"NAKED": 5,
"SINGLEs": 1,
"passing.": 1,
"sss": 3,
"each": 2,
"with": 15,
"more": 2,
"than": 2,
"fields": 6,
"are": 6,
"rcb": 16,
"elem": 16,
"collect": 1,
"remove": 3,
"from": 7,
"look": 10,
"number": 4,
"appears": 1,
"container": 9,
"this": 2,
"can": 9,
"go": 1,
"other": 2,
"place": 1,
"HIDDEN": 6,
"SINGLE": 1,
"hiddenSingle": 2,
"select": 1,
"containername": 1,
"FOR": 11,
"IN": 9,
"occurs": 5,
"PAIRS": 8,
"TRIPLES": 8,
"QUADS": 2,
"nakedPair": 4,
"t": 14,
"nm": 6,
"SELECT": 3,
"pos": 5,
"tuple": 2,
"name": 2,
"//": 8,
"u": 6,
"fold": 7,
"non": 2,
"outof": 6,
"tuples": 2,
"hit": 7,
"subset": 3,
"any": 3,
"hiddenPair": 4,
"minus": 2,
"uniq": 4,
"sort": 4,
"common": 4,
"bs": 7,
"undefined": 1,
"cannot": 1,
"happen": 1,
"because": 1,
"either": 1,
"empty": 4,
"not": 5,
"intersectionlist": 2,
"intersections": 2,
"reason": 8,
"reson": 1,
"cpos": 7,
"WHERE": 2,
"tail": 2,
"intersection": 1,
"we": 5,
"occurences": 1,
"XY": 2,
"Wing": 2,
"there": 6,
"exists": 6,
"A": 7,
"X": 5,
"Y": 4,
"B": 5,
"Z": 6,
"shares": 2,
"reasoning": 1,
"will": 4,
"be": 9,
"since": 1,
"indeed": 1,
"thus": 1,
"see": 1,
"xyWing": 2,
"rcba": 4,
"share": 1,
"b1": 11,
"b2": 10,
"&&": 9,
"||": 2,
"then": 1,
"else": 1,
"c1": 4,
"c2": 3,
"N": 5,
"Fish": 1,
"Swordfish": 1,
"Jellyfish": 1,
"When": 2,
"particular": 1,
"digit": 1,
"located": 2,
"only": 1,
"columns": 2,
"eliminate": 1,
"those": 2,
"which": 2,
"fish": 7,
"fishname": 5,
"rset": 4,
"certain": 1,
"rflds": 2,
"rowset": 1,
"colss": 3,
"must": 4,
"appear": 1,
"at": 3,
"least": 3,
"cstart": 2,
"immediate": 1,
"consequences": 6,
"assumption": 8,
"form": 1,
"conseq": 3,
"cp": 3,
"two": 1,
"contradict": 2,
"contradicts": 7,
"get": 3,
"aPos": 5,
"List": 1,
"turned": 1,
"when": 2,
"true/false": 1,
"toClear": 7,
"whose": 1,
"implications": 5,
"themself": 1,
"chain": 2,
"paths": 12,
"solution": 6,
"reverse": 4,
"css": 7,
"yields": 1,
"contradictory": 1,
"chainContra": 2,
"pro": 7,
"contra": 4,
"ALL": 2,
"conlusions": 1,
"uniqBy": 2,
"using": 2,
"sortBy": 2,
"comparing": 2,
"conslusion": 1,
"chains": 4,
"LET": 1,
"BE": 1,
"final": 2,
"conclusion": 4,
"THE": 1,
"FIRST": 1,
"implication": 2,
"ai": 2,
"so": 1,
"a0": 1,
"OR": 7,
"a2": 2,
"...": 2,
"IMPLIES": 1,
"For": 2,
"cells": 1,
"pi": 2,
"have": 1,
"construct": 2,
"p0": 1,
"p1": 1,
"c0": 1,
"cellRegionChain": 2,
"os": 3,
"cellas": 2,
"regionas": 2,
"iss": 3,
"ass": 2,
"first": 2,
"candidates@": 1,
"region": 2,
"oss": 2,
"Liste": 1,
"aller": 1,
"Annahmen": 1,
"ein": 1,
"bestimmtes": 1,
"acstree": 3,
"Tree.fromList": 1,
"bypass": 1,
"maybe": 1,
"tree": 1,
"lookup": 2,
"error": 1,
"performance": 1,
"resons": 1,
"confine": 1,
"ourselves": 1,
"20": 1,
"per": 1,
"mkPaths": 3,
"acst": 3,
"impl": 2,
"{": 1,
"a3": 1,
"ordered": 1,
"impls": 2,
"ns": 2,
"concat": 1,
"takeUntil": 1,
"null": 1,
"iterate": 1,
"expandchain": 3,
"avoid": 1,
"loops": 1,
"uni": 3,
"SOLVE": 1,
"SUDOKU": 1,
"Apply": 1,
"available": 1,
"strategies": 1,
"until": 1,
"changes": 1,
"anymore": 1,
"Strategy": 1,
"functions": 2,
"supposed": 1,
"applied": 1,
"changed": 1,
"board.": 1,
"strategy": 2,
"anything": 1,
"alter": 1,
"it": 2,
"next": 1,
"tried.": 1,
"solve": 19,
"res@": 16,
"apply": 17,
"res": 16,
"smallest": 1,
"comment": 16,
"SINGLES": 1,
"locked": 1,
"2": 3,
"QUADRUPELS": 6,
"3": 3,
"4": 3,
"WINGS": 1,
"FISH": 3,
"pcomment": 2,
"9": 5,
"forcing": 1,
"allow": 1,
"infer": 1,
"both": 1,
"brd": 2,
"com": 5,
"stderr": 3,
"<<": 4,
"log": 1,
"turn": 1,
"string": 3,
"into": 1,
"mkrow": 2,
"mkrow1": 2,
"xs": 4,
"make": 1,
"sure": 1,
"unpacked": 2,
"<=>": 1,
"0": 2,
"ignored": 1,
"h": 1,
"help": 1,
"usage": 1,
"Sudoku": 2,
"file": 4,
"81": 3,
"char": 1,
"consisting": 1,
"digits": 2,
"One": 1,
"such": 1,
"going": 1,
"http": 3,
"www": 1,
"sudokuoftheday": 1,
"pages": 1,
"o": 1,
"php": 1,
"click": 1,
"puzzle": 1,
"open": 1,
"tab": 1,
"Copy": 1,
"address": 1,
"your": 1,
"browser": 1,
"There": 1,
"also": 1,
"hard": 1,
"sudokus": 1,
"examples": 1,
"top95": 1,
"txt": 1,
"W": 1,
"felder": 2,
"decode": 4,
"files": 2,
"forM_": 1,
"sudoku": 2,
"openReader": 1,
"lines": 2,
"BufferedReader.getLines": 1,
"process": 5,
"candi": 2,
"consider": 3,
"acht": 4,
"neun": 2,
"examples.SwingExamples": 1,
"Java.Awt": 1,
"ActionListener": 2,
"Java.Swing": 1,
"rs": 2,
"Runnable.new": 1,
"helloWorldGUI": 2,
"buttonDemoGUI": 2,
"celsiusConverterGUI": 2,
"invokeLater": 1,
"tempTextField": 2,
"JTextField.new": 1,
"celsiusLabel": 1,
"JLabel.new": 3,
"convertButton": 1,
"JButton.new": 3,
"fahrenheitLabel": 1,
"frame": 3,
"JFrame.new": 3,
"frame.setDefaultCloseOperation": 3,
"JFrame.dispose_on_close": 3,
"frame.setTitle": 1,
"celsiusLabel.setText": 1,
"convertButton.setText": 1,
"convertButtonActionPerformed": 2,
"celsius": 3,
"getText": 1,
"double": 1,
"fahrenheitLabel.setText": 3,
"c*1.8": 1,
".long": 1,
"ActionListener.new": 2,
"convertButton.addActionListener": 1,
"contentPane": 2,
"frame.getContentPane": 2,
"layout": 2,
"GroupLayout.new": 1,
"contentPane.setLayout": 1,
"TODO": 1,
"continue": 1,
"//docs.oracle.com/javase/tutorial/displayCode.html": 1,
"code": 1,
"//docs.oracle.com/javase/tutorial/uiswing/examples/learn/CelsiusConverterProject/src/learn/CelsiusConverterGUI.java": 1,
"frame.pack": 3,
"frame.setVisible": 3,
"label": 2,
"cp.add": 1,
"newContentPane": 2,
"JPanel.new": 1,
"JButton": 4,
"b1.setVerticalTextPosition": 1,
"SwingConstants.center": 2,
"b1.setHorizontalTextPosition": 1,
"SwingConstants.leading": 2,
"b2.setVerticalTextPosition": 1,
"b2.setHorizontalTextPosition": 1,
"b3": 7,
"Enable": 1,
"button": 1,
"setVerticalTextPosition": 1,
"SwingConstants": 2,
"center": 1,
"setHorizontalTextPosition": 1,
"leading": 1,
"setEnabled": 7,
"action1": 2,
"action3": 2,
"b1.addActionListener": 1,
"b3.addActionListener": 1,
"newContentPane.add": 3,
"newContentPane.setOpaque": 1,
"frame.setContentPane": 1
},
"Game Maker Language": {
"//draws": 1,
"the": 62,
@@ -51296,6 +52080,7 @@
"Erlang": 2928,
"fish": 636,
"Forth": 1516,
"Frege": 5564,
"Game Maker Language": 13310,
"GAS": 133,
"GLSL": 3766,
@@ -51450,6 +52235,7 @@
"Erlang": 5,
"fish": 3,
"Forth": 7,
"Frege": 4,
"Game Maker Language": 13,
"GAS": 1,
"GLSL": 3,
@@ -51565,5 +52351,5 @@
"Xtend": 2,
"YAML": 2
},
"md5": "54de8af8a3aae92fbbc0f1f71d1d7598"
"md5": "51294029c815b3d94cfcd55545a37a0c"
}

View File

@@ -0,0 +1,44 @@
{--
This program displays the
current time on stdandard output
every other second.
-}
module examples.CommandLineClock where
data Date = native java.util.Date where
native new :: () -> IO (MutableIO Date) -- new Date()
native toString :: Mutable s Date -> ST s String -- d.toString()
--- 'IO' action to give us the current time as 'String'
current :: IO String
current = do
d <- Date.new ()
d.toString
{-
"java.lang.Thread.sleep" takes a "long" and
returns nothing, but may throw an InterruptedException.
This is without doubt an IO action.
public static void sleep(long millis)
throws InterruptedException
Encoded in Frege:
- argument type long Long
- result void ()
- does IO IO ()
- throws ... throws ....
-}
-- .... defined in frege.java.Lang
-- native sleep java.lang.Thread.sleep :: Long -> IO () throws InterruptedException
main args =
forever do
current >>= print
print "\r"
stdout.flush
Thread.sleep 999

147
samples/Frege/Concurrent.fr Normal file
View File

@@ -0,0 +1,147 @@
module examples.Concurrent where
import System.Random
import Java.Net (URL)
import Control.Concurrent as C
main2 args = do
m <- newEmptyMVar
forkIO do
m.put 'x'
m.put 'y'
m.put 'z'
replicateM_ 3 do
c <- m.take
print "got: "
println c
example1 = do
forkIO (replicateM_ 100000 (putChar 'a'))
replicateM_ 100000 (putChar 'b')
example2 = do
s <- getLine
case s.long of
Right n -> forkIO (setReminder n) >> example2
Left _ -> println ("exiting ...")
setReminder :: Long -> IO ()
setReminder n = do
println ("Ok, I remind you in " ++ show n ++ " seconds")
Thread.sleep (1000L*n)
println (show n ++ " seconds is up!")
table = "table"
mainPhil _ = do
[fork1,fork2,fork3,fork4,fork5] <- mapM MVar.new [1..5]
forkIO (philosopher "Kant" fork5 fork1)
forkIO (philosopher "Locke" fork1 fork2)
forkIO (philosopher "Wittgenstein" fork2 fork3)
forkIO (philosopher "Nozick" fork3 fork4)
forkIO (philosopher "Mises" fork4 fork5)
return ()
philosopher :: String -> MVar Int -> MVar Int -> IO ()
philosopher me left right = do
g <- Random.newStdGen
let phil g = do
let (tT,g1) = Random.randomR (60L, 120L) g
(eT, g2) = Random.randomR (80L, 160L) g1
thinkTime = 300L * tT
eatTime = 300L * eT
println(me ++ " is going to the dining room and takes his seat.")
fl <- left.take
println (me ++ " takes up left fork (" ++ show fl ++ ")")
rFork <- right.poll
case rFork of
Just fr -> do
println (me ++ " takes up right fork. (" ++ show fr ++ ")")
println (me ++ " is going to eat for " ++ show eatTime ++ "ms")
Thread.sleep eatTime
println (me ++ " finished eating.")
right.put fr
println (me ++ " took down right fork.")
left.put fl
println (me ++ " took down left fork.")
table.notifyAll
println(me ++ " is going to think for " ++ show thinkTime ++ "ms.")
Thread.sleep thinkTime
phil g2
Nothing -> do
println (me ++ " finds right fork is already in use.")
left.put fl
println (me ++ " took down left fork.")
table.notifyAll
println (me ++ " is going to the bar to await notifications from table.")
table.wait
println (me ++ " got notice that something changed at the table.")
phil g2
inter :: InterruptedException -> IO ()
inter _ = return ()
phil g `catch` inter
getURL xx = do
url <- URL.new xx
con <- url.openConnection
con.connect
is <- con.getInputStream
typ <- con.getContentType
-- stderr.println ("content-type is " ++ show typ)
ir <- InputStreamReader.new is (fromMaybe "UTF-8" (charset typ))
`catch` unsupportedEncoding is
br <- BufferedReader.new ir
br.getLines
where
unsupportedEncoding :: InputStream -> UnsupportedEncodingException -> IO InputStreamReader
unsupportedEncoding is x = do
stderr.println x.catched
InputStreamReader.new is "UTF-8"
charset ctyp = do
typ <- ctyp
case typ of
m~´charset=(\S+)´ -> m.group 1
_ -> Nothing
type SomeException = Throwable
main ["dining"] = mainPhil []
main _ = do
m1 <- MVar.newEmpty
m2 <- MVar.newEmpty
m3 <- MVar.newEmpty
forkIO do
r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Haskell"
m1.put r
forkIO do
r <- (catchAll . getURL) "htto://www.wikipedia.org/wiki/Java"
m2.put r
forkIO do
r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Frege"
m3.put r
r1 <- m1.take
r2 <- m2.take
r3 <- m3.take
println (result r1, result r2, result r3)
-- case r3 of
-- Right ss -> mapM_ putStrLn ss
-- Left _ -> return ()
where
result :: (SomeException|[String]) -> (String|Int)
result (Left x) = Left x.getClass.getName
result (Right y) = (Right . sum . map length) y
-- mapM_ putStrLn r2

561
samples/Frege/Sudoku.fr Normal file
View File

@@ -0,0 +1,561 @@
package examples.Sudoku where
import Data.TreeMap (Tree, keys)
import Data.List as DL hiding (find, union)
type Element = Int -- 1,2,3,4,5,6,7,8,9
type Zelle = [Element] -- set of candidates
type Position = Int -- 0..80
type Feld = (Position, Zelle)
type Brett = [Feld]
--- data type for assumptions and conclusions
data Assumption =
!ISNOT Position Element
| !IS Position Element
derive Eq Assumption
derive Ord Assumption
instance Show Assumption where
show (IS p e) = pname p ++ "=" ++ e.show
show (ISNOT p e) = pname p ++ "/" ++ e.show
showcs cs = joined " " (map Assumption.show cs)
elements :: [Element] -- all possible elements
elements = [1 .. 9]
{-
a b c d e f g h i
0 1 2 | 3 4 5 | 6 7 8 1
9 10 11 |12 13 14 |15 16 17 2
18 19 20 |21 22 23 |24 25 26 3
---------|---------|--------
27 28 29 |30 31 32 |33 34 35 4
36 37 38 |39 40 41 |42 43 44 5
45 46 47 |48 49 50 |51 52 53 6
---------|---------|--------
54 55 56 |57 58 59 |60 61 62 7
63 64 65 |66 67 68 |69 70 71 8
72 73 74 |75 76 77 |78 79 80 9
-}
positions :: [Position] -- all possible positions
positions = [0..80]
rowstarts :: [Position] -- all positions where a row is starting
rowstarts = [0,9,18,27,36,45,54,63,72]
colstarts :: [Position] -- all positions where a column is starting
colstarts = [0,1,2,3,4,5,6,7,8]
boxstarts :: [Position] -- all positions where a box is starting
boxstarts = [0,3,6,27,30,33,54,57,60]
boxmuster :: [Position] -- pattern for a box, by adding upper left position results in real box
boxmuster = [0,1,2,9,10,11,18,19,20]
--- extract field for position
getf :: Brett -> Position -> Feld
getf (f:fs) p
| fst f == p = f
| otherwise = getf fs p
getf [] p = (p,[])
--- extract cell for position
getc :: Brett -> Position -> Zelle
getc b p = snd (getf b p)
--- compute the list of all positions that belong to the same row as a given position
row :: Position -> [Position]
row p = [z..(z+8)] where z = (p `quot` 9) * 9
--- compute the list of all positions that belong to the same col as a given position
col :: Position -> [Position]
col p = map (c+) rowstarts where c = p `mod` 9
--- compute the list of all positions that belong to the same box as a given position
box :: Position -> [Position]
box p = map (z+) boxmuster where
ri = p `div` 27 * 27 -- 0, 27 or 54, depending on row
ci = p `mod` 9 -- column index 0..8, 0,1,2 is left, 3,4,5 is middle, 6,7,8 is right
cs = ci `div` 3 * 3 -- 0, 3 or 6
z = ri + cs
--- check if candidate set has exactly one member, i.e. field has been solved
single :: Zelle -> Bool
single [_] = true
single _ = false
unsolved :: Zelle -> Bool
unsolved [_] = false
unsolved _ = true
-- list of rows, cols, boxes
allrows = map row rowstarts
allcols = map col colstarts
allboxs = map box boxstarts
allrcb = zip (repeat "row") allrows
++ zip (repeat "col") allcols
++ zip (repeat "box") allboxs
containers :: [(Position -> [Position], String)]
containers = [(row, "row"), (col, "col"), (box, "box")]
-- ----------------- PRINTING ------------------------------------
-- printable coordinate of field, upper left is a1, lower right is i9
pname p = packed [chr (ord 'a' + p `mod` 9), chr (ord '1' + p `div` 9)]
-- print board
printb b = mapM_ p1line allrows >> println ""
where
p1line row = do
print (joined "" (map pfld line))
where line = map (getc b) row
-- print field (brief)
-- ? = no candidate
-- 5 = field is 5
-- . = some candidates
pfld [] = "?"
pfld [x] = show x
pfld zs = "0"
-- print initial/final board
result msg b = do
println ("Result: " ++ msg)
print ("Board: ")
printb b
return b
res012 b = case concatMap (getc b) [0,1,2] of
[a,b,c] -> a*100+b*10+c
_ -> 9999999
-- -------------------------- BOARD ALTERATION ACTIONS ---------------------------------
-- print a message about what is done to the board and return the new board
turnoff1 :: Position -> Zelle -> Brett -> IO Brett
turnoff1 i off b
| single nc = do
-- print (pname i)
-- print ": set to "
-- print (head nc)
-- println " (naked single)"
return newb
| otherwise = return newb
where
cell = getc b i
nc = filter (`notElem` off) cell
newb = (i, nc) : [ f | f <- b, fst f != i ]
turnoff :: Int -> Zelle -> String -> Brett -> IO Brett
turnoff i off msg b = do
-- print (pname i)
-- print ": set to "
-- print nc
-- print " by clearing "
-- print off
-- print " "
-- println msg
return newb
where
cell = getc b i
nc = filter (`notElem` off) cell
newb = (i, nc) : [ f | f <- b, fst f != i ]
turnoffh ps off msg b = foldM toh b ps
where
toh b p = turnoff p off msg b
setto :: Position -> Element -> String -> Brett -> IO Brett
setto i n cname b = do
-- print (pname i)
-- print ": set to "
-- print n
-- print " (hidden single in "
-- print cname
-- println ")"
return newb
where
nf = [n]
newb = (i, nf) : [ f | f <- b, fst f != i ]
-- ----------------------------- SOLVING STRATEGIES ---------------------------------------------
-- reduce candidate sets that contains numbers already in same row, col or box
-- This finds (and logs) NAKED SINGLEs in passing.
reduce b = [ turnoff1 p sss | (p,cell) <- b, -- for each field
unsolved cell, -- with more than 1 candidate
-- single fields in containers that are candidates of that field
sss = [ s | (rcb, _) <- containers, [s] <- map (getc b) (rcb p), s `elem` cell],
sss != [] ] -- collect field index, elements to remove from candidate set
-- look for a number that appears in exactly 1 candidate set of a container
-- this number can go in no other place (HIDDEN SINGLE)
hiddenSingle b = [ setto i n cname | -- select index, number, containername
(cname, rcb) <- allrcb, -- FOR rcb IN allrcb
n <- elements, -- FOR n IN elements
fs = filter (unsolved • snd) (map (getf b) rcb),
occurs = filter ((n `elem`) • snd) fs,
length occurs == 1,
(i, _) <- occurs ]
-- look for NAKED PAIRS, TRIPLES, QUADS
nakedPair n b = [ turnoff p t ("(naked tuple in " ++ nm ++ ")") | -- SELECT pos, tuple, name
-- n <- [2,3,4], // FOR n IN [2,3,4]
(nm, rcb) <- allrcb, -- FOR rcb IN containers
fs = map (getf b) rcb, -- let fs = fields for rcb positions
u = (fold union [] . filter unsolved . map snd) fs, -- let u = union of non single candidates
t <- n `outof` u, -- FOR t IN n-tuples
hit = (filter ((`subset` t) . snd) . filter (unsolved . snd)) fs,
length hit == n,
(p, cell) <- fs,
p `notElem` map fst hit,
any (`elem` cell) t
]
-- look for HIDDEN PAIRS, TRIPLES or QUADS
hiddenPair n b = [ turnoff p off ("(hidden " ++ show t ++ " in " ++ nm ++ ")") | -- SELECT pos, tuple, name
-- n <- [2,3,4], // FOR n IN [2,3,4]
(nm, rcb) <- allrcb, -- FOR rcb IN containers
fs = map (getf b) rcb, -- let fs = fields for rcb positions
u = (fold union [] . filter ((>1) . length) . map snd) fs, -- let u = union of non single candidates
t <- n `outof` u, -- FOR t IN n-tuples
hit = (filter (any ( `elem` t) . snd) . filter (unsolved . snd)) fs,
length hit == n,
off = (fold union [] . map snd) hit `minus` t,
off != [],
(p, cell) <- hit,
! (cell `subset` t)
]
a `subset` b = all (`elem` b) a
a `union` b = uniq (sort (a ++ b))
a `minus` b = filter (`notElem` b) a
a `common` b = filter (`elem` b) a
n `outof` as
| length as < n = []
| [] <- as = []
| 1 >= n = map (:[]) as
| (a:bs) <- as = map (a:) ((n-1) `outof` bs) ++ (n `outof` bs)
| otherwise = undefined -- cannot happen because either as is empty or not
same f a b = b `elem` f a
intersectionlist = [(allboxs, row, "box/row intersection"), (allboxs, col, "box/col intersection"),
(allrows ++ allcols, box, "line/box intersection")]
intersections b = [
turnoff pos [c] reason | -- SELECT position, candidate, reson
(from, container, reason) <- intersectionlist,
rcb <- from,
fs = (filter (unsolved . snd) . map (getf b)) rcb, -- fs = fields in from with more than 1 candidate
c <- (fold union [] • map snd) fs, -- FOR c IN union of candidates
cpos = (map fst • filter ((c `elem`) • snd)) fs, -- cpos = positions where c occurs
cpos != [], -- WHERE cpos is not empty
all (same container (head cpos)) (tail cpos), -- WHERE all positions are in the intersection
-- we can remove all occurences of c that are in container, but not in from
(pos, cell) <- map (getf b) (container (head cpos)),
c `elem` cell,
pos `notElem` rcb ]
-- look for an XY Wing
-- - there exists a cell A with candidates X and Y
-- - there exists a cell B with candidates X and Z that shares a container with A
-- - there exists a cell C with candidates Y and Z that shares a container with A
-- reasoning
-- - if A is X, B will be Z
-- - if A is Y, C will be Z
-- - since A will indeed be X or Y -> B or C will be Z
-- - thus, no cell that can see B and C can be Z
xyWing board = [ turnoff p [z] ("xy wing " ++ pname b ++ " " ++ pname c ++ " because of " ++ pname a) |
(a, [x,y]) <- board, -- there exists a cell a with candidates x and y
rcba = map (getf board) (row a ++ col a ++ box a), -- rcba = all fields that share a container with a
(b, [b1, b2]) <- rcba,
b != a,
b1 == x && b2 != y || b2 == x && b1 != y, -- there exists a cell B with candidates x and z
z = if b1 == x then b2 else b1,
(c, [c1, c2]) <- rcba,
c != a, c!= b,
c1 == y && c2 == z || c1 == z && c2 == y, -- there exists a cell C with candidates y and z
ps = (uniq . sort) ((row b ++ col b ++ box b) `common` (row c ++ col c ++ box c)),
-- remove z in ps
(p, cs) <- map (getf board) ps,
p != b, p != c,
z `elem` cs ]
-- look for a N-Fish (2: X-Wing, 3: Swordfish, 4: Jellyfish)
-- When all candidates for a particular digit in N rows are located
-- in only N columns, we can eliminate all candidates from those N columns
-- which are not located on those N rows
fish n board = fish "row" allrows row col ++ fish "col" allcols col row where
fishname 2 = "X-Wing"
fishname 3 = "Swordfish"
fishname 4 = "Jellyfish"
fishname _ = "unknown fish"
fish nm allrows row col = [ turnoff p [x] (fishname n ++ " in " ++ nm ++ " " ++ show (map (pname . head) rset)) |
rset <- n `outof` allrows, -- take n rows (or cols)
x <- elements, -- look for certain number
rflds = map (filter ((>1) . length . snd) . map (getf board)) rset, -- unsolved fields in the rowset
colss = (map (map (head . col . fst) . filter ((x `elem`) . snd)) rflds), -- where x occurs in candidates
all ((>1) . length) colss, -- x must appear in at least 2 cols
cols = fold union [] colss,
length cols == n,
cstart <- cols,
(p, cell) <- map (getf board) (col cstart),
x `elem` cell,
all (p `notElem`) rset]
-- compute immediate consequences of an assumption of the form (p `IS` e) or (p `ISNOT` e)
conseq board (IS p e) = uniq (sort ([ p `ISNOT` x | x <- getc board p, x != e ] ++
[ a `ISNOT` e |
(a,cs) <- map (getf board) (row p ++ col p ++ box p),
a != p,
e `elem` cs
]))
conseq board (ISNOT p e) = uniq (sort ([ p `IS` x | cs = getc board p, length cs == 2, x <- cs, x != e ] ++
[ a `IS` e |
cp <- [row p, box p, col p],
as = (filter ((e `elem`) . getc board) . filter (p!=)) cp,
length as == 1,
a = head as
]))
-- check if two assumptions contradict each other
contradicts (IS a x) (IS b y) = a==b && x!=y
contradicts (IS a x) (ISNOT b y) = a==b && x==y
contradicts (ISNOT a x) (IS b y) = a==b && x==y
contradicts (ISNOT _ _) (ISNOT _ _) = false
-- get the Position of an Assumption
aPos (IS p _) = p
aPos (ISNOT p _) = p
-- get List of elements that must be turned off when assumption is true/false
toClear board true (IS p x) = filter (x!=) (getc board p)
toClear board false (IS p x) = [x]
toClear board true (ISNOT p x) = [x]
toClear board false (ISNOT p x) = filter (x!=) (getc board p)
-- look for assumptions whose implications contradict themself
chain board paths = [ solution a (head cs) (reverse cs) |
(a, css) <- paths,
cs <- take 1 [ cs | cs <- css, contradicts a (head cs) ]
]
where
solution a c cs = turnoff (aPos a) (toClear board false a) reason where
reason = "Assumption " ++ show a ++ " implies " ++ show c ++ "\n\t"
++ showcs cs ++ "\n\t"
++ "Therefore, " ++ show a ++ " must be false."
-- look for an assumption that yields to contradictory implications
-- this assumption must be false
chainContra board paths = [ solution a (reverse pro) (reverse contra) |
(a, css) <- paths, -- FOR ALL assumptions "a" with list of conlusions "css"
(pro, contra) <- take 1 [ (pro, contra) |
pro <- (uniqBy (using head) . sortBy (comparing head)) css, -- FOR ALL conslusion chains "pro"
c = head pro, -- LET "c" BE the final conclusion
contra <- take 1 (filter ((contradicts c) . head) css) -- THE FIRST conclusion that contradicts c
]
]
where
solution a pro con = turnoff (aPos a) (toClear board false a) reason where
reason = ("assumption " ++ show a ++ " leads to contradictory conclusions\n\t"
++ showcs pro ++ "\n\t" ++ showcs con)
-- look for a common implication c of some assumptions ai, where at least 1 ai is true
-- so that (a0 OR a1 OR a2 OR ...) IMPLIES c
-- For all cells pi in same container that have x as candidate, we can construct (p0==x OR p1==x OR ... OR pi==x)
-- For a cell p with candidates ci, we can construct (p==c0 OR p==c1)
cellRegionChain board paths = [ solution b as (map head os) |
as <- cellas ++ regionas, -- one of as must be true
iss = filter ((`elem` as) . fst) paths, -- the implications for as
(a, ass) <- take 1 iss, -- implications for first assumption
fs <- (uniqBy (using head) . sortBy (comparing head)) ass,
b = head fs, -- final conclusions of first assumption
os = [fs] : map (take 1 . filter ((b==) . head) . snd) (tail iss), -- look for implications with same conclusion
all ([]!=) os]
where
cellas = [ map (p `IS`) candidates | (p, candidates@(_:_:_)) <- board ]
regionas = [ map (`IS` e) ps |
region <- map (map (getf board)) (allrows ++ allcols ++ allboxs),
e <- elements,
ps = map fst (filter ((e `elem`) . snd) region),
length ps > 1 ]
solution b as oss = turnoff (aPos b) (toClear board true b) reason where
reason = "all of the assumptions " ++ joined ", " (map show as) ++ " imply " ++ show b ++ "\n\t"
++ joined "\n\t" (map (showcs . reverse) oss) ++ "\n\t"
++ "One of them must be true, so " ++ show b ++ " must be true."
{-
Wir brauchen für einige Funktionen eine Datenstruktur wie
[ (Assumption, [[Assumption]]) ]
d.i. eine Liste von möglichen Annahmen samt aller Schlußketten.
Idealerweise sollte die Schlußkette in umgekehrter Reihenfolge vorliegen,
dann kann man einfach finden:
- Annahmen, die zum Selbstwiderspruch führen.
- alles, was aus einer bestimmten Annahme folgt (map (map head) [[a]])
-...
-}
--- Liste aller Annahmen für ein bestimmtes Brett
assumptions :: Brett -> [Assumption]
assumptions board = [ a |
(p, cs) <- board,
!(single cs),
a <- map (ISNOT p) cs ++ map (IS p) cs ]
consequences :: Brett -> [Assumption] -> [[Assumption]]
consequences board as = map (conseq board) as
acstree :: Brett -> Tree Assumption [Assumption]
acstree board = Tree.fromList (zip as cs)
where
as = assumptions board
cs = consequences board as
-- bypass maybe on tree lookup
find :: Tree Assumption [Assumption] -> Assumption -> [Assumption]
find t a
| Just cs <- t.lookup a = cs
| otherwise = error ("no consequences for " ++ show a)
-- for performance resons, we confine ourselves to implication chains of length 20 per assumption
mkPaths :: Tree Assumption [Assumption] -> [ (Assumption, [[Assumption]]) ]
mkPaths acst = map impl (keys acst) -- {[a1], [a2], [a3] ]
where
-- [Assumption] -> [(a, [chains, ordered by length]
impl a = (a, impls [[a]])
impls ns = (take 1000 • concat • takeUntil null • iterate expandchain) ns
-- expandchain :: [[Assumption]] -> [[Assumption]]
expandchain css = [ (n:a:as) |
(a : as) <- css, -- list of assumptions
n <- find acst a, -- consequences of a
n `notElem` as -- avoid loops
]
-- uni (a:as) = a : uni (filter ((head a !=) • head) as)
-- uni [] = empty
-- empty = []
-- ------------------ SOLVE A SUDOKU --------------------------
-- Apply all available strategies until nothing changes anymore
-- Strategy functions are supposed to return a list of
-- functions, which, when applied to a board, give a changed board.
-- When a strategy does not find anything to alter,
-- it returns [], and the next strategy can be tried.
solve b
| all (single . snd) b = result "Solved" b
| any (([]==) . snd) b = result "not solvable" b
| res@(_:_) <- reduce b = apply b res >>=solve -- compute smallest candidate sets
-- comment "candidate sets are up to date" = ()
| res@(_:_) <- hiddenSingle b = apply b res >>= solve -- find HIDDEN SINGLES
-- comment "no more hidden singles" = ()
| res@(_:_) <- intersections b = apply b res >>= solve -- find locked candidates
-- comment "no more intersections" = ()
| res@(_:_) <- nakedPair 2 b = apply b res >>= solve -- find NAKED PAIRS, TRIPLES or QUADRUPELS
-- comment "no more naked pairs" = ()
| res@(_:_) <- hiddenPair 2 b = apply b res >>= solve -- find HIDDEN PAIRS, TRIPLES or QUADRUPELS
-- comment "no more hidden pairs" = ()
-- res@(_:_) <- nakedPair 3 b = apply b res >>= solve // find NAKED PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more naked triples" = ()
-- res@(_:_) <- hiddenPair 3 b = apply b res >>= solve // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more hidden triples" = ()
-- res@(_:_) <- nakedPair 4 b = apply b res >>=solve // find NAKED PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more naked quadruples" = ()
-- res@(_:_) <- hiddenPair 4 b = apply b res >>=solve // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more hidden quadruples" = ()
| res@(_:_) <- xyWing b = apply b res >>=solve -- find XY WINGS
-- comment "no more xy wings" = ()
| res@(_:_) <- fish 2 b = apply b res >>=solve -- find 2-FISH
-- comment "no more x-wings" = ()
-- res@(_:_) <- fish 3 b = apply b res >>=solve // find 3-FISH
-- | comment "no more swordfish" = ()
-- res@(_:_) <- fish 4 b = apply b res >>=solve // find 4-FISH
-- | comment "no more jellyfish" = ()
-- | comment pcomment = ()
| res@(_:_) <- chain b paths = apply b (take 9 res) >>= solve -- find forcing chains
| res@(_:_) <- cellRegionChain b paths = apply b (take 9 res) >>= solve -- find common conclusion for true assumption
| res@(_:_) <- chainContra b paths = apply b (take 9 res) >>= solve -- find assumptions that allow to infer both a and !a
-- comment "consistent conclusions only" = ()
| otherwise = result "ambiguous" b
where
apply brd fs = foldM (\b\f -> f b) brd fs
paths = mkPaths (acstree b)
-- pcomment = show (length paths) ++ " assumptions with " ++ show (fold (+) 0 (map (length <~ snd) paths))
-- ++ " implication chains"
-- comment com = do stderr << com << "\n" for false
-- log com = do stderr << com << "\n" for true
--- turn a string into a row
mkrow :: String -> [Zelle]
mkrow s = mkrow1 xs
where
xs = s ++ "---------" -- make sure at least 9 elements
mkrow1 xs = (take 9 • filter ([]!=) • map f • unpacked) xs
f x | x >= '1' && x <= '9' = [ord x - ord '0']
| x == ' ' = [] -- ignored
| otherwise = elements
main ["-h"] = main []
main ["-help"] = main []
main [] = do
mapM_ stderr.println [
"usage: java Sudoku file ...",
" java Sudoku position",
"where position is a 81 char string consisting of digits",
"One can get such a string by going to",
"http://www.sudokuoftheday.com/pages/s-o-t-d.php",
"Right click on the puzzle and open it in new tab",
"Copy the 81 digits from the URL in the address field of your browser.",
"",
"There is also a file with hard sudokus in examples/top95.txt\n"]
return ()
main [s@#^[0-9\W]{81}$#] = solve board >> return ()
where
board = zip positions felder
felder = decode s
main files = forM_ files sudoku
where
sudoku file = do
br <- openReader file
lines <- BufferedReader.getLines br
bs <- process lines
ss <- mapM (\b -> print "Puzzle: " >> printb b >> solve b) bs
println ("Euler: " ++ show (sum (map res012 ss)))
return ()
-- "--3-" => [1..9, 1..9, [3], 1..9]
decode s = map candi (unpacked s) where
candi c | c >= '1' && c <= '9' = [(ord c - ord '0')]
| otherwise = elements
process [] = return []
process (s:ss)
| length s == 81 = consider b1
| length s == 9,
length acht == 8,
all ((9==) • length) acht = consider b2
| otherwise = do
stderr.println ("skipped line: " ++ s)
process ss
where
acht = take 8 ss
neun = fold (++) "" (s:acht)
b1 = zip positions (decode s)
b2 = zip positions (decode neun)
consider b = do
-- print "Puzzle: "
-- printb b
bs <- process ss
return (b:bs)

View File

@@ -0,0 +1,79 @@
package examples.SwingExamples where
import Java.Awt (ActionListener)
import Java.Swing
main _ = do
rs <- mapM Runnable.new [helloWorldGUI, buttonDemoGUI, celsiusConverterGUI]
mapM_ invokeLater rs
println "Hit enter to end ...."
s <- getLine
return ()
celsiusConverterGUI = do
tempTextField <- JTextField.new()
celsiusLabel <- JLabel.new ()
convertButton <- JButton.new ()
fahrenheitLabel <- JLabel.new ()
frame <- JFrame.new ()
frame.setDefaultCloseOperation JFrame.dispose_on_close
frame.setTitle "Celsius Converter"
celsiusLabel.setText "Celsius"
convertButton.setText "Convert"
let convertButtonActionPerformed _ = do
celsius <- tempTextField.getText
case celsius.double of
Left _ -> fahrenheitLabel.setText ("not a valid number: " ++ celsius)
Right c -> fahrenheitLabel.setText (show (c*1.8 + 32.0).long ++ " Fahrenheit")
return ()
ActionListener.new convertButtonActionPerformed >>= convertButton.addActionListener
fahrenheitLabel.setText "Fahrenheit"
contentPane <- frame.getContentPane
layout <- GroupLayout.new contentPane
contentPane.setLayout layout
-- TODO continue
-- http://docs.oracle.com/javase/tutorial/displayCode.html?code=http://docs.oracle.com/javase/tutorial/uiswing/examples/learn/CelsiusConverterProject/src/learn/CelsiusConverterGUI.java
frame.pack
frame.setVisible true
helloWorldGUI = do
frame <- JFrame.new "Hello World Frege"
frame.setDefaultCloseOperation(JFrame.dispose_on_close)
label <- JLabel.new "Hello World!"
cp <- frame.getContentPane
cp.add label
frame.pack
frame.setVisible true
buttonDemoGUI = do
frame <- JFrame.new "Button Demo"
frame.setDefaultCloseOperation(JFrame.dispose_on_close)
newContentPane <- JPanel.new ()
b1::JButton <- JButton.new "Disable middle button"
b1.setVerticalTextPosition SwingConstants.center
b1.setHorizontalTextPosition SwingConstants.leading
b2::JButton <- JButton.new "Middle button"
b2.setVerticalTextPosition SwingConstants.center
b2.setHorizontalTextPosition SwingConstants.leading
b3::JButton <- JButton.new "Enable middle button"
b3.setVerticalTextPosition SwingConstants.center
b3.setHorizontalTextPosition SwingConstants.leading
b3.setEnabled false
let action1 _ = do
b2.setEnabled false
b1.setEnabled false
b3.setEnabled true
action3 _ = do
b2.setEnabled true
b1.setEnabled true
b3.setEnabled false
ActionListener.new action1 >>= b1.addActionListener
ActionListener.new action3 >>= b3.addActionListener
newContentPane.add b1
newContentPane.add b2
newContentPane.add b3
newContentPane.setOpaque true
frame.setContentPane newContentPane
frame.pack
frame.setVisible true