チュチュ-ハスケル-(3460 2654 2476 2221 2060 1992 1900 + 50x10 = 2400)
戦略:
- A *を見つける
- パスを隣人で膨らませる(距離2)
- もう一度A *を見つけますが、今回はピッグヘッドレーサーのように位置+速度スペースで
ゴルフ:
- エラーチェックのほとんどを省略したため、プログラムは常にマップ内に開始点と終了点、およびその間のパスがあると想定します。
- 短い変数名
私はHaskellゴルファーではないので、さらにどれだけ節約できるかわかりません(編集:かなりの量になることが判明しました)。
性能:
ガントレットは、2011年の1,7GHz Core i5で9:21分に実行されます。市は7.2秒かかります。(ghcとともに-O1を使用し、-O2を使用するとプログラムが非常に遅くなります)
微調整オプションは、肥大化したパスの厚さです。小さいマップの場合、距離3は1つまたは2つのステップを節約しますが、The Gauntletの実行は長すぎるので距離2のままです。
ルール適合:
「パス検索ライブラリを使用できません。」-使用していますが、ソースは含まれています。A *検索機能は、Cale GibbardのData.Graph.AStarライブラリのわずかにゴルフバージョンです(http://hackage.haskell.org/package/astarを参照)。
シティ-50ステップ
ガントレット-722ステップ
ゴルフをしていない:
import System.Environment
import Data.Maybe (fromJust)
import Graphics.GD
import qualified Data.Matrix as M
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as Map
import qualified Data.PSQueue as PSQ
main = do
trPNG <- loadPngFile =<< fmap head getArgs
(sX, sY) <- imageSize trPNG
px <- mapM (flip getPixel trPNG) [(x,y) | y <- [0..sY-1],x <- [0..sX-1]]
let tr = M.fromList sY sX (map (rgbaToTok . toRGBA) px)
let rt = findRt tr
let vrt = findVRt (head rt) (last rt) (bloat rt tr) tr
let wayPt = map ((\(a,b)->(b-1,a-1)) . fst) vrt
mapM (\(p1,p2) -> drawLine p1 p2 (rgb 255 255 255) trPNG
>> setPixel p1 (rgb 0 0 255) trPNG) (zip wayPt (tail wayPt))
savePngFile "out1.png" trPNG
print $ length vrt - 1
findVRt p1 p2 rt tr = (p1, (0,0)) : fromJust (aStar nghb (\_ _ -> 100)
(\(pos,_) -> fromJust $ Map.lookup pos rt)
((==) p2 . fst) (p1, (0,0)))
where
nghb ((y,x), (vy,vx)) =
S.fromList [(newp, (vy+dy,vx+dx)) |
dy <- [-15 .. 15],
let ady = abs dy,
dx <- [-15+ady .. 15-ady],
not $ dy==0 && dx == 0 && vy == 0 && vx == 0,
let newp = (y+vy+dy,x+vx+dx),
Map.member newp rt,
all ((/=) 1 . (M.!) tr) (bresenham (y,x) newp)]
bloat rt tr = foldr (\(p,h) -> Map.insert p h) Map.empty
(zip (reverse $ f $ f rt) [0..])
where
f = concatMap (n8 tr)
rgbaToTok (r, g, b, _)
| r+g+b == 0 = 3
| r==255 && g==255 && b==0 = 2
| r==g && r==b && 30 <= r && r <= 220 = 0
| otherwise = 1
findRt tr = s : fromJust (aStar nghb cost (const 1) ((==) 3 . (M.!) tr) s)
where
cost (y1,x1) (y2,x2) = if (x1==x2 || y1==y2) then 408 else 577
nghb = S.fromList . n8 tr
s = head [(y,x) | y <- [1..M.nrows tr], x <- [1..M.ncols tr],
M.getElem y x tr == 2]
n8 tr p@(y,x) = filter ((/=) 1 . (M.!) tr) (n8' y x)
where
n8' y x | y==1 || x==1 || y == M.nrows tr || x == M.ncols tr = [p]
| otherwise = [ (y-1,x-1), (y-1,x), (y-1,x+1), (y,x-1),
(y,x+1), (y+1,x-1), (y+1,x), (y+1,x+1) ]
bresenham start@(y0,x0) end@(y1,x1) = walk start (el `div` 2)
where
walk p@(y,x) err
| p == end = [p]
| err-es < 0 = p : walk (y+sdy,x+sdx) (err-es+el)
| otherwise = p : walk (y+pdy,x+pdx) (err-es)
dx = x1-x0; dy = y1-y0;
adx = abs dx; ady = abs dy
sdx = signum dx; sdy = signum dy
(pdx,pdy,es,el) = if adx > ady then (sdx,0,ady,adx) else (0,sdy,adx,ady)
data AStar a c = AStar {
vi :: !(S.Set a), wa :: !(PSQ.PSQ a c), sc :: !(Map.Map a c),
mH :: !(Map.Map a c), ca :: !(Map.Map a a), en :: !(Maybe a) }
deriving Show
aStarInit s = AStar S.empty (PSQ.singleton s 0) (Map.singleton s 0)
Map.empty Map.empty Nothing
aStar graph dist heur goal start =
let s = runAStar graph dist heur goal start
in case en s of
Nothing -> Nothing
Just e -> Just (reverse . takeWhile (not . (== start))
. iterate (ca s Map.!) $ e)
runAStar graph dist heur goal start = aStar' (aStarInit start)
where
aStar' s = case PSQ.minView (wa s) of
Nothing -> s
Just (x PSQ.:-> _, w') ->
if goal x
then s { en = Just x }
else aStar' $ L.foldl' (expand x) (s { wa = w',
vi = S.insert x (vi s)})
(S.toList (graph x S.\\ vi s))
expand x s y =
let vi = sc s Map.! x + dist x y
in case PSQ.lookup y (wa s) of
Nothing -> link x y vi (s { mH
= Map.insert y (heur y) (mH s) })
Just _ -> if vi<sc s Map.! y then link x y vi s else s
link x y v s = s {
ca = Map.insert y x (ca s),
sc = Map.insert y v (sc s),
wa = PSQ.insert y (v + mH s Map.! y) (wa s) }
ゴルフ:
import System.Environment;import Graphics.GD;import Data.Matrix;import qualified Data.Set as S;import qualified Data.Map as J;import qualified Data.PSQueue as Q
j(Just x)=x;e(y,x)=(x-1,y-1);u=signum;q=J.empty;m=reverse;n=Nothing;z=255;s=abs;t=1<2;f(a,b)(c,d)|b==d||a==c=2|t=3;rT(r,g,b,_)|r+g+b==0=3|r==z&&g==z&&b==0=2|r==g&&r==b&&30<=r&&r<=220=0|t=5
main=do
i:_<-getArgs;t<-loadPngFile i;(a,b)<-imageSize t;p<-mapM(flip getPixel t)[(x,y)|y<-[0..b-1],x<-[0..a-1]];let r=fromList b a$map(rT.toRGBA)p;s:_=[(y,x)|y<-[1..b],x<-[1..a],getElem y x r==2];c p@(y,x)=filter((<5).(!)r)$if y==1||x==1||y==b||x==a then[p]else[(a,b)|a<-[y-1..y+1],b<-[x-1..x+1],a/=y||b/=x];y=s:j(aS(S.fromList.c)f(\_->1)((==3).(!)r)s);l=concatMap c;w=map(e.fst)$fV(head y)(last y)(foldr(\(p,h)->J.insert p h)q$zip(m$l$l y)[0..])r
mapM(\(c,d)->drawLine c d(rgb z z z)t>>setPixel c(rgb 0 0 z)t)$zip w$tail w;savePngFile"o.png"t
fV c d r t=(c,(0,0)):j(aS l(\_ _->99)(\(q,_)->j$J.lookup q r)((==d).fst)(c,(0,0)))where l((y,x),(a,b))=S.fromList[(w,(a+c,b+d))|c<-[-15..15],d<-[s c-15..15-s c],any(/=0)[a,b,c,d],let w=(y+a+c,x+b+d),J.member w r,all((<5).(!)t)$br(y,x)w]
br q@(i,j)r@(k,l)=w q$f`div`2where w p@(y,x)e|p==r=[p]|e-o<0=p:w(y+g,x+h)(e-o+f)|t=p:w(y+m,x+n)(e-o);a=s$l-j;b=s$k-i;h=u$l-j;g=u$k-i;(n,m,o,f)|a>b=(h,0,b,a)|t=(0,g,a,b)
data A a c=A{v::S.Set a,w::Q.PSQ a c,k::J.Map a c,mH::J.Map a c,ca::J.Map a a,en::Maybe a}deriving Show
aS g d h o u=b$en s where b Nothing=n;b(Just e)=Just(m.takeWhile(/=u).iterate(ca s J.!)$e);s=l$A S.empty(Q.singleton u 0)(J.singleton u 0)q q n;i x y v s=s{ca=J.insert y x$ca s,k=J.insert y v$k s,w=Q.insert y(v+mH s J.!y)$w s};l s=b$Q.minView$w s where b Nothing=s;b(Just(x Q.:->_,w'))|o x=s{en=Just x}|t=l$foldl(r x)(s{w=w',v=S.insert x$v s})$S.toList$g x S.\\v s;r x s y=b$Q.lookup y$w s where v=k s J.!x+d x y;b Nothing=i x y v$s{mH=J.insert y(h y)$mH s};b(Just _)|v<k s J.!y=i x y v s|t=s
チュチュ兄弟-TS#1-(1764 + 43 = 2194)
編集:TS#1は個別の回答になりました。
編集II:The Cityのパスは
[(6,7),(21,7),(49,5),(92,3),(126,4),(145,5),(149,6),(153,22),(163,47),(180,64),
(191,73),(191,86),(185,107),(177,122),(175,130),(187,137),(211,147),(237,162),
(254,171),(277,171),(299,175),(321,194),(345,220),(364,237),(370,252),(365,270),
(360,276),(368,284),(387,296),(414,315),(438,330),(463,331),(484,321),(491,311),
(498,316),(508,333),(524,354),(525,375),(519,404),(511,424),(508,434),(513,437),
(533,440),(559,444),(580,458),(591,468),(591,482),(591,511),(598,532),(605,539),
(606,537)]
ガントレットチュチュでは次のように移動します
[(99,143),(114,143),(137,150),(150,161),(149,173),(145,180),(141,197),(138,223),
(135,234),(143,241),(166,248),(186,250),(192,251),(192,261),(192,279),(195,285),
(209,287),(232,284),(248,273),(257,261),(272,256),(279,255),(284,245),(294,243),
(309,231),(330,226),(354,233),(380,253),(400,265),(421,271),(436,268),(438,266),
(440,269),(441,277),(450,278),(470,276),(477,276),(478,285),(481,307),(490,330),
(486,352),(471,370),(449,384),(435,391),(433,401),(446,411),(462,430),(464,450),
(459,477),(454,493),(457,514),(462,522),(472,523),(479,529),(491,531),(493,538),
(496,547),(503,546),(516,545),(519,549),(524,566),(531,575),(531,581),(535,576),
(538,557),(541,523),(545,475),(551,414),(559,342),(565,282),(570,236),(574,204),
(575,184),(574,177),(572,179),(568,174),(568,158),(569,144),(572,143),(578,154),
(585,160),(588,155),(593,140),(598,140),(605,153),(610,156),(611,170),(611,182),
(608,182),(598,175),(594,171),(590,176),(587,195),(589,224),(593,266),(599,321),
(605,376),(609,418),(612,446),(610,465),(615,478),(608,494),(605,521),(611,542),
(618,549),(622,551),(621,563),(611,572),(614,581),(623,581),(630,581),(630,573),
(636,556),(639,551),(642,531),(647,520),(640,511),(637,491),(639,461),(641,416),
(643,356),(647,289),(650,235),(652,195),(647,163),(645,143),(645,136),(653,136),
(670,138),(673,139),(676,155),(679,175),(681,181),(669,188),(662,194),(662,208),
(665,234),(669,274),(674,328),(681,395),(687,457),(692,505),(696,540),(700,560),
(703,566),(706,557),(707,535),(708,498),(711,448),(716,385),(720,325),(723,278),
(726,246),(729,229),(732,227),(733,238),(733,263),(733,303),(733,358),(733,428),
(733,483),(733,523),(732,549),(731,560),(728,558),(726,565),(726,575),(721,575),
(720,586),(720,592),(716,594),(715,608),(715,619),(711,619),(692,619),(658,619),
(609,619),(545,619),(466,619),(372,619),(285,619),(213,619),(155,619),(112,619),
(84,619),(70,618),(70,616),(70,599),(70,567),(70,520),(70,458),(70,381),
(70,300),(70,234),(70,183),(70,147),(70,126),(71,119),(80,119),(104,119),
(143,119),(197,119),(266,119),(350,119),(449,119),(563,119),(681,120),(784,121),
(873,121),(947,121),(1006,121),(1050,121),(1079,121),(1093,121),(1093,122),
(1086,131),(1069,145),(1059,151),(1040,151),(1006,151),(973,150),(955,149),
(950,150),(956,155),(977,160),(994,175),(1003,183),(1003,197),(993,214),
(987,220),(993,223),(1011,223),(1044,223),(1079,229),(1104,240),(1124,242),
(1134,239),(1134,231),(1134,221),(1139,218),(1156,218),(1177,217),(1183,216),
(1191,202),(1208,182),(1231,154),(1249,135),(1259,123),(1264,121),(1264,129),
(1264,152),(1264,190),(1264,243),(1264,311),(1264,393),(1264,460),(1264,512),
(1264,550),(1264,573),(1263,582),(1256,582),(1234,582),(1197,582),(1160,575),
(1132,562),(1118,548),(1113,538),(1107,541),(1099,549),(1102,561),(1113,570),
(1110,578),(1095,583),(1073,581),(1066,579),(1060,566),(1063,559),(1075,554),
(1072,549),(1065,542),(1051,539),(1043,528),(1023,520),(990,511),(970,500),
(953,501),(935,516),(911,534),(899,551),(891,573),(883,580),(867,581),(859,575),
(858,571),(843,566),(830,553),(832,540),(828,527),(819,520),(825,513),(839,506),
(842,495),(843,474),(844,468),(854,468),(877,467),(891,460),(895,452),(901,452),
(906,447),(909,443),(909,441),(915,435),(912,430),(914,429),(908,423),(904,421),
(899,418),(893,417),(879,409),(854,400),(842,390),(842,377),(839,362),(836,362),
(820,360),(812,352),(812,337),(812,307),(814,288),(815,282),(827,280),(834,284),
(850,282),(873,277),(889,280),(891,284),(891,301),(897,320),(903,324),(916,320),
(925,310),(935,314),(953,325),(967,337),(976,345),(981,346),(986,362),(999,378),
(1006,385),(1007,387),(1008,387),(1015,382),(1017,382),(1018,381),(1022,386),
(1021,401),(1008,413),(1009,425),(1014,426),(1031,425),(1038,429),(1047,425),
(1053,429),(1067,426),(1076,425),(1090,427),(1099,424),(1113,426),(1134,427),
(1147,431),(1150,430),(1152,437),(1147,438),(1128,438),(1105,443),(1093,450),
(1089,453),(1085,449),(1075,452),(1064,460),(1055,458),(1052,462),(1049,460),
(1042,464),(1025,463),(1015,463),(1010,470),(1013,471),(1021,472),(1027,476),
(1033,477),(1042,484),(1052,480),(1059,486),(1076,487),(1099,497),(1134,510),
(1169,523),(1191,535),(1205,540),(1210,539),(1210,528),(1210,502),(1210,461),
(1209,409),(1208,372),(1207,349),(1206,341),(1192,335),(1165,327),(1132,310),
(1084,293),(1045,273),(997,256),(961,240),(934,229),(922,218),(919,201),
(917,197),(906,199),(892,212),(876,212),(845,212),(809,212),(781,219),(768,226),
(768,235),(768,259),(768,298),(768,352),(768,421),(769,489),(769,543),(769,582),
(769,606),(769,615),(775,615),(796,615),(832,615),(883,615),(949,615),
(1030,615),(1110,615),(1175,615),(1225,615),(1261,614),(1282,613),(1288,612),
(1296,598),(1296,577),(1296,541),(1296,490),(1296,424),(1296,343),(1296,264),
(1296,200),(1296,151),(1296,116),(1296,96),(1295,90),(1285,90),(1260,90),
(1220,90),(1165,90),(1095,90),(1010,90),(920,90),(844,90),(783,90),(737,90),
(706,90),(690,90),(688,89),(689,86),(681,78),(671,82),(663,90),(648,90),
(618,90),(573,90),(517,90),(476,90),(450,90),(438,89),(439,86),(431,78),
(421,82),(413,90),(398,90),(381,88),(369,78),(357,83),(353,90),(341,90),
(314,90),(297,88),(287,78),(277,82),(269,90),(254,90),(224,90),(179,90),
(123,90),(82,90),(56,90),(43,92),(43,96),(43,115),(43,149),(43,198),(43,262),
(43,341),(43,428),(43,500),(43,557),(43,599),(44,627),(45,640),(49,641),
(67,641),(100,641),(148,641),(211,641),(289,641),(382,641),(490,641),(613,641),
(750,641),(872,641),(979,641),(1071,641),(1148,641),(1212,640),(1261,639),
(1295,638),(1315,636),(1321,633),(1321,621),(1321,594),(1321,552),(1321,495),
(1321,423),(1321,336),(1321,254),(1321,187),(1321,135),(1321,98),(1321,75),
(1320,66),(1313,66),(1291,66),(1254,66),(1207,67),(1175,68),(1157,68),(1154,68),
(1154,75),(1146,75),(1123,75),(1102,74),(1096,73),(1096,69),(1091,66),(1074,66),
(1042,66),(1007,66),(986,65),(980,64),(980,60),(975,57),(958,57),(926,57),
(891,58),(871,59),(866,60),(865,66),(855,66),(830,66),(790,66),(735,66),
(667,66),(614,66),(575,66),(550,65),(540,64),(540,60),(535,57),(518,57),
(489,58),(474,60),(474,62),(472,66),(459,66),(431,66),(388,66),(330,66),
(269,66),(223,66),(191,66),(174,66),(171,65),(168,56),(158,55),(150,61),
(149,66),(138,66),(112,66),(98,63),(95,57),(83,57),(65,59),(61,62),(59,66),
(46,66),(25,67),(18,69),(18,79),(18,104),(18,144),(18,199),(18,269),(18,354),
(18,441),(18,513),(18,570),(18,612),(18,639),(19,652),(26,656),(38,663),
(58,663),(93,663),(143,663),(208,663),(288,663),(383,663),(493,663),(618,663),
(758,663),(884,663),(995,663),(1091,663),(1172,663),(1239,663),(1291,663),
(1328,663),(1350,663),(1358,662),(1361,651),(1376,637),(1378,621),(1374,597),
(1378,574),(1378,541),(1375,519),(1383,501),(1376,483),(1370,478),(1370,464),
(1373,438),(1379,400),(1379,366),(1369,337),(1369,303),(1369,272),(1368,255),
(1382,238),(1381,221),(1371,209),(1375,196),(1380,170),(1374,143),(1367,129),
(1372,112),(1373,85),(1365,64),(1358,57),(1356,41),(1353,39),(1350,41),
(1346,37),(1336,36),(1333,32),(1317,30),(1288,30),(1244,30),(1185,30),(1141,30),
(1102,22),(1057,22),(1026,21),(1005,23),(993,21),(988,25),(975,22),(972,24),
(959,21),(943,24),(937,29),(920,30),(889,30),(843,30),(788,30),(747,30),
(706,39),(664,36),(629,38),(591,34),(559,34),(538,30),(506,30),(465,30),
(431,22),(391,23),(356,22),(328,23),(308,30),(280,30),(237,30),(179,30),
(106,30),(30,28)]