السلام عليكم
لدي كود function معمول بالدالفي اريد ان احوله الى c# او c++ او vb او c
الكود هو حل خورزمية مطروحة في مسابقة topcoder فئة marathon math
ولدي مهلة حتى 15 لارسال الحل ارجوا من يستطيع تحويل الكود ان لا يبخل علينا
و سوف اكون شاكرا له
مع العلم اني حاولت تحويل الكود ببرامج مخصصة لذلك لكن كان هناك دائما مشكل
و المسابقة لا تقبل اكواد باسكال
function play(board:tab;words:array of string):longint; label 10,20; var lett:array[0..10,0..10] of char; w,i,j,n,last,h1,h,hv1,k,scor,scormax:longint; resultnbr,nbrw,nbri,nbrj,nbrn:longint; hv:array[0..10,0..10]of record h,v,hs,vs:longint; end; wordlist:array[0..100] of record enb,i,j,hv,scor:longint end; resultt:array[0..9999] of string; resultf:array of string; done:boolean; lettscor:array['A'..'Z'] of longint; c:char; function wordscor(s:string;i,j,hv:longint):longint; var i1,wordscor1:longint; begin wordscor1:=0; if hv=1 then begin for i1:=1 to length(s) do if (board[i,j+i1-1]<>'D')and(board[i,j+i1-1]<>'T') then wordscor1:=wordscor1+lettscor[s[i1]]*strtoint(board[i,j+i1-1]) else wordscor1:=wordscor1+lettscor[s[i1]]; for i1:=1 to length(s) do if board[i,j+i1-1]='D' then wordscor1:=2*wordscor1 else if board[i,j+i1-1]='T' then wordscor1:=3*wordscor1 end else begin for i1:=1 to length(s) do if (board[i+i1-1,j]<>'D')and(board[i+i1-1,j]<>'T') then wordscor1:=wordscor1+lettscor[s[i1]]*strtoint(board[i+i1-1,j]) else wordscor1:=wordscor1+lettscor[s[i1]]; for i1:=1 to length(s) do if board[i+i1-1,j]='D' then wordscor1:=2*wordscor1 else if board[i+i1-1,j]='T' then wordscor1:=3*wordscor1 end; wordscor:=wordscor1; end; function unadd(s:string;i,j,hv1:longint):boolean; var h:longint; begin if hv1=1 then begin for h:=1 to length(s) do begin hv[i,j+h-1].hs:=0; if hv[i,j+h-1].vs=0 then lett[i,j+h-1]:=' '; end; end else begin for h:=1 to length(s) do begin hv[i+h-1,j].vs:=0; if hv[i+h-1,j].hs=0 then lett[i+h-1,j]:=' '; end; end; end; function add(s:string;i,j,hv1:longint):boolean; var h:longint; done:boolean; begin done:=false; add:=false; if hv1=1 then begin if length(s)<=hv[i,j].h then begin done:=true; for h:=1 to length(s) do if (hv[i,j+h-1].hs=1)or((lett[i,j+h-1]<>' ')and(lett[i,j+h-1]<>s[h])) then done:=false; if done then for h:=1 to length(s) do begin lett[i,j+h-1]:=s[h]; hv[i,j+h-1].hs:=1; end; end; end else begin if length(s)<=hv[i,j].v then begin done:=true; for h:=1 to length(s) do if (hv[i+h-1,j].vs=1)or((lett[i+h-1,j]<>' ')and(lett[i+h-1,j]<>s[h])) then done:=false; if done then for h:=1 to length(s) do begin lett[i+h-1,j]:=s[h]; hv[i+h-1,j].vs:=1; end; end; end; add:=done; end; begin for c:='A' to 'Z' do lettscor[c]:=1; lettscor['F']:=4; lettscor['H']:=4; lettscor['V']:=4; lettscor['W']:=4; lettscor['Y']:=4; lettscor['B']:=3; lettscor['C']:=3; lettscor['M']:=3; lettscor['P']:=3; lettscor['D']:=2; lettscor['G']:=2; lettscor['J']:=8; lettscor['X']:=8; lettscor['Q']:=10; lettscor['Z']:=10; lettscor['K']:=5; //5555555555555 nbrw:=length(words); nbri:=length(board); nbrj:=length(board[0]); nbrn:=(nbri*nbrj)-1; //555555555555 for i:=0 to nbri-1 do for j:=0 to nbrj-1 do if board[i,j]<>'#' then begin hv[i,j].h:=0; hv[i,j].v:=0; n:=0; repeat n:=n+1; until ((j+n)>(nbrj-1))or(board[i,j+n]='#'); hv[i,j].h:=n; n:=0; repeat n:=n+1; until ((i+n)>(nbri-1))or(board[i+n,j]='#'); hv[i,j].v:=n; hv[i,j].hs:=0; hv[i,j].vs:=0; end else begin hv[i,j].h:=0; hv[i,j].v:=0; hv[i,j].hs:=0; hv[i,j].vs:=0; end; //888888888888888888888888 for i:=0 to nbri-1 do for j:=0 to nbrj-1 do lett[i,j]:=' '; for i:=0 to nbrw-1 do begin wordlist.enb:=0; wordlist.j:=0; wordlist.i:=0; wordlist.hv:=0; end; scor:=0; scormax:=0; h:=0; i:=0; repeat repeat //** if wordlist.enb=1 then begin scor:=scor-wordscor(words,wordlist.i,wordlist.j,wordlist.hv); unadd(words,wordlist.i,wordlist.j,wordlist.hv); n:=wordlist.i*nbrj+wordlist.j; hv1:=wordlist.hv; wordlist.enb:=0; wordlist.i:=0; wordlist.j:=0; wordlist.hv:=0; end else begin n:=-1; done:=true; for h1:=i-1 downto 0 do if (wordlist[h1].enb=1)and(words=words[h1]) then done:=false; if not done then goto 20; end; //** if hv1=1 then begin done:=add(words,n div nbrj,n mod nbrj,2); if done then begin wordlist.enb:=1; wordlist.i:=n div nbrj; wordlist.j:=n mod nbrj; wordlist.hv:=2; scor:=scor+wordscor(words,wordlist.i,wordlist.j,wordlist.hv); goto 20; end; end; n:=n+1; while (n<(nbrn)) do begin done:=add(words,n div nbrj,n mod nbrj,1); if done then begin wordlist.enb:=1; wordlist.i:=n div nbrj; wordlist.j:=n mod nbrj; wordlist.hv:=1; scor:=scor+wordscor(words,wordlist.i,wordlist.j,wordlist.hv); goto 20; end; done:=add(words,n div nbrj,n mod nbrj,2); if done then begin wordlist.enb:=1; wordlist.i:=n div nbrj; wordlist.j:=n mod nbrj; wordlist.hv:=2; scor:=scor+wordscor(words,wordlist.i,wordlist.j,wordlist.hv); goto 20; end; n:=n+1; end; 20: i:=i+1; until i>(nbrw-1); k:=nbrw; repeat k:=k-1; until (wordlist[k].enb=1)or(k=-1); i:=k; if scor>scormax then begin scormax:=scor; resultnbr:=0; for k:=0 to nbrw-1 do if wordlist[k].enb=1 then begin resultt[resultnbr]:=''; if wordlist[k].hv=1 then resultt[resultnbr]:=resultt[resultnbr]+'H ' else resultt[resultnbr]:=resultt[resultnbr]+'V '; resultt[resultnbr]:=resultt[resultnbr]+inttostr(k)+' '+inttostr(wordlist[k].j)+' '+inttostr(wordlist[k].i); resultnbr:=resultnbr+1; end; end; h:=h+1; until h=1000; setlength(resultf,resultnbr); for i:=0 to resultnbr-1 do resultf:=resultt; play:=scormax; end;
