Hanya tentang Prolog

Halo pekerja. Saya tidak akan menahan perhatian Anda untuk waktu yang lama dengan menjelaskan pendekatan deklaratif, saya akan mencoba mengusulkan pemecahan satu masalah lagi menggunakan bahasa pemrograman logis, sebagai opsi untuk tampilan deklaratif pada perumusan masalah dan solusi mereka.


Tugas 391. Persegi Panjang Sempurna


Diberikan N persegi panjang yang disejajarkan dengan sumbu di mana N> 0, tentukan apakah mereka semua bersama-sama membentuk penutup yang tepat dari wilayah persegi panjang.
Setiap persegi panjang diwakili sebagai titik kiri bawah dan titik kanan atas. Misalnya, satuan kuadrat direpresentasikan sebagai [1,1,2,2]. (koordinat titik kiri bawah adalah (1, 1) dan titik kanan atas adalah (2, 2)).
gambar
Contoh 1: persegi panjang = [
[1,1,3,3],
[3,1,4,2],
[3,2,4,4],
[1,3,2,4],
[2,3,3,4]]
Kembali benar. Semua 5 persegi panjang bersama-sama membentuk penutup tepat wilayah persegi panjang.
...
Contoh 3: persegi panjang =
[[1,1,3,3],
[3,1,4,2],
[1,3,2,4],
[3,2,4,4]]
Kembali salah Karena ada celah di tengah atas.

Memikirkan kata-kata, hari kedua berlalu, ini tentu saja bukan pelatihan selama seminggu tentang menyalakan lampu vintage , tapi tetap saya ingin mempresentasikan hasil pekerjaan pada tugas. Butuh beberapa upaya untuk menyelesaikan semua tes yang tersedia.


Data awal disajikan oleh suatu daftar, saya mengingatkan Anda secara singkat, daftarnya adalah [Head | Tail], di mana Tail adalah daftar, juga daftarnya kosong [] .


Kami merumuskan 1


Adalah perlu untuk menghitung luas total dari semua persegi panjang, menemukan ukuran maksimum dari persegi panjang yang menggambarkan mereka semua dan membandingkan dua jumlah ini, jika itu berarti bahwa semua persegi panjang menutupi area secara seragam. Pada saat yang sama, periksa bahwa persegi panjang tidak berpotongan, kami akan menambahkan setiap persegi panjang baru ke daftar, dengan ketentuan, seharusnya tidak tumpang tindih dan memotong semua yang sebelumnya.


Untuk melakukan ini, saya menggunakan rekursi ekor (alias rekursi pada keturunan), cara yang paling "penting" untuk mewakili sebuah siklus. Dalam satu "siklus" seperti itu, kami segera menemukan jumlah total area dan sudut kiri minimum dan kanan maksimum dari persegi panjang yang menggambarkan, kenaikan, mengumpulkan daftar umum angka, memeriksa bahwa tidak ada persimpangan.


Seperti ini:


findsum([], Sres,Sres,LConerRes,LConerRes,RConerRes,RConerRes,_). findsum([[Lx,Ly,Rx,Ry]|T], Scur,Sres,LConerCur,LConerRes,RConerCur,RConerRes,RectList):- mincon(Lx:Ly,LConerCur,LConerCur2), maxcon(Rx:Ry,RConerCur,RConerCur2), Scur2 is Scur+(Rx-Lx)*(Ry-Ly), not(chekin([Lx,Ly,Rx,Ry],RectList)), findsum(T, Scur2,Sres,LConerCur2,LConerRes,RConerCur2,RConerRes,[[Lx,Ly,Rx,Ry]|RectList]). 

Di Prolog, variabel tidak diketahui, tidak dapat diubah, kosong atau memiliki nilai, ini memerlukan beberapa variabel, awal dan hasilnya, ketika kita sampai ke akhir daftar, nilai saat ini akan menjadi hasil (baris pertama dari aturan). Tidak seperti bahasa imperatif, untuk dukungan Untuk memahami garis program, Anda perlu membayangkan seluruh jalur yang mengarah ke sana, dan semua variabel dapat memiliki "sejarah" akumulasi mereka sendiri, di sana, setiap baris program hanya dalam konteks aturan saat ini, semua negara yang mempengaruhinya ada aturan masuk.


Jadi:


 %   mincon(X1:Y1,X2:Y2,X1:Y1):-X1=<X2,Y1=<Y2,!. mincon(_,X2:Y2,X2:Y2). %  maxcon(X1:Y1,X2:Y2,X1:Y1):-X1>=X2,Y1>=Y2,!. maxcon(_,X2:Y2,X2:Y2). 

Di sini, untuk mewakili sudut, "istilah terstruktur" dari bentuk X: Y digunakan, ini adalah kesempatan untuk menggabungkan beberapa nilai ke dalam struktur, sehingga untuk berbicara sebuah tuple, hanya operasi apa pun yang dapat menjadi functor. Dan memotong "!" Memungkinkan Anda untuk tidak menentukan kondisi di baris kedua aturan, ini adalah cara untuk meningkatkan efisiensi perhitungan.


Dan ternyata kemudian, yang paling penting adalah untuk memeriksa non-persimpangan dari persegi panjang, mereka terakumulasi dalam daftar:


 %    chekin(X,[R|_]):-cross(X,R),!. chekin(X,[_|T]):-chekin(X,T). %     ,    cross(X,X):-!. cross(X,Y):-cross2(X,Y),!. cross(X,Y):-cross2(Y,X). %,       cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11<X22,X22=<X12,Y11<Y22,Y22=<Y12,!.%rt cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11=<X21,X21<X12,Y11<Y22,Y22=<Y12,!.%lt cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11<X22,X22=<X12,Y11=<Y21,Y21<Y12,!.%rb cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11=<X21,X21<X12,Y11=<Y21,Y21<Y12. %lb 

Persimpangan persegi panjang, ini adalah empat pilihan untuk memukul bagian atas yang pertama di dalam yang lain.


Dan pernyataan terakhir:


 isRectangleCover(Rects):- [[Lx,Ly,Rx,Ry]|_]=Rects, findsum(Rects,0,S,Lx:Ly,LconerX:LconerY,Rx:Ry,RconerX:RconerY,[]),!, S=:= (RconerX-LconerX)*(RconerY-LconerY). 

Pada input, daftar angka, kita ambil yang pertama untuk nilai awal sudut kiri dan kanan, kita berkeliling semua, menghitung total area, dan memverifikasi jumlah yang diperoleh. Saya perhatikan bahwa jika ada persimpangan dari segi empat, maka pencarian untuk jumlah "menolak", mengembalikan "jatuh", ini berarti bahwa tidak ada yang membandingkan jumlah. Hal yang sama terjadi jika tidak ada angka tunggal dalam daftar input, akan ada kegagalan, tidak ada yang memverifikasi ...


Selanjutnya, saya menjalankan implementasi ini pada tes yang ada, dan saya mengutip 40 yang pertama:


 %unit-tests framework assert_are_equal(Goal, false):-get_time(St),not(Goal),!,get_time(Fin),Per is round(Fin-St),writeln(Goal->ok:Per/sec). assert_are_equal(Goal, true):- get_time(St),Goal, !,get_time(Fin),Per is round(Fin-St),writeln(Goal->ok:Per/sec). assert_are_equal(Goal, Exp):-writeln(Goal->failed:expected-Exp). :-assert_are_equal(isRectangleCover([[1,1,3,3],[3,1,4,2],[3,2,4,4],[1,3,2,4],[2,3,3,4]]),true). :-assert_are_equal(isRectangleCover([[1,1,2,3],[1,3,2,4],[3,1,4,2],[3,2,4,4]]),false). :-assert_are_equal(isRectangleCover([[1,1,3,3],[3,1,4,2],[1,3,2,4],[3,2,4,4]]),false). :-assert_are_equal(isRectangleCover([[1,1,3,3],[3,1,4,2],[1,3,2,4],[2,2,4,4]]),false). :-assert_are_equal(isRectangleCover([[0,0,4,1],[0,0,4,1]]),false). 

dan banyak lagi ...
 :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[6,2,8,3],[5,1,6,3],[4,0,5,1],[6,0,7,2],[4,2,5,3],[2,1,4,3],[0,1,2,2],[0,2,2,3],[4,1,5,2],[5,0,6,1]]),true). :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),true). :-assert_are_equal(isRectangleCover([[0,0,4,1]]),true). :-assert_are_equal(isRectangleCover([[0,0,3,3],[1,1,2,2]]),false). :-assert_are_equal(isRectangleCover([[1,1,2,2],[1,1,2,2],[2,1,3,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,1,3,2],[1,0,2,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,1,1,2],[0,2,1,3],[0,3,1,4]]),true). :-assert_are_equal(isRectangleCover([[0,0,1,1],[1,0,2,1],[2,0,3,1],[3,0,4,1]]),true). :-assert_are_equal(isRectangleCover([[0,0,2,2],[1,1,3,3],[2,0,3,1],[0,3,3,4]]),false). :-assert_are_equal(isRectangleCover([[0,0,3,1],[0,1,2,3],[1,0,2,1],[2,2,3,3]]),false). :-assert_are_equal(isRectangleCover([[1,1,3,3],[2,2,4,4],[4,1,5,4],[1,3,2,4]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,2,1],[1,0,2,1],[0,2,2,3]]),false). :-assert_are_equal(isRectangleCover([[0,0,2,1],[0,1,2,2],[0,2,1,3],[1,0,2,1]]),false). :-assert_are_equal(isRectangleCover([[1,1,2,2],[0,1,1,2],[1,0,2,1],[0,2,3,3],[2,0,3,3]]),false). :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[6,2,8,3],[5,1,6,3],[6,0,7,2],[4,2,5,3],[2,1,4,3],[0,1,2,2],[0,2,2,3],[4,1,5,2],[5,0,6,1]]),false). :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,4],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,3],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,5,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,1,1],[0,2,1,3]]),false). :-assert_are_equal(isRectangleCover([[0,0,3,3],[1,1,2,2],[1,1,2,2]]),false). :-assert_are_equal(isRectangleCover([[1,1,4,4],[1,3,4,5],[1,6,4,7]]),false). :-assert_are_equal(isRectangleCover([[0,0,3,1],[0,1,2,3],[2,0,3,1],[2,2,3,3]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,1,1],[1,1,2,2],[1,1,2,2]]),false). :-assert_are_equal(isRectangleCover([[1,1,2,2],[1,1,2,2],[1,1,2,2],[2,1,3,2],[2,2,3,3]]),false). :-assert_are_equal(isRectangleCover([[1,1,2,2],[2,1,3,2],[2,1,3,2],[2,1,3,2],[3,1,4,2]]),false). :-assert_are_equal(isRectangleCover([[0,1,2,3],[0,1,1,2],[2,2,3,3],[1,0,3,1],[2,0,3,1]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,2,1,3],[1,1,2,2],[2,0,3,1],[2,2,3,3],[1,0,2,3],[0,1,3,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[2,2,3,3]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[0,1,1,2],[0,2,1,3],[1,0,2,1],[1,0,2,1],[1,2,2,3],[2,0,3,1],[2,1,3,2],[2,2,3,3]]),false). :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1]]),false). :-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[-1,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false). :-assert_are_equal(isRectangleCover([[0,0,1,1],[1,0,2,1],[1,0,3,1],[3,0,4,1]]),false). :-assert_are_equal(isRectangleCover([[1,2,4,4],[1,0,4,1],[0,2,1,3],[0,1,3,2],[3,1,4,2],[0,3,1,4],[0,0,1,1]]),true). 

Dan ini bukan akhir, tugas dari bagian "keras", dalam 41 tes mereka menawarkan daftar 10.000 persegi panjang, di semua lima tes terakhir saya mendapatkan waktu seperti itu dalam hitungan detik:


 test 41:length=10000 goal->ok:212/sec test 42:length=3982 goal->ok:21/sec test 43:length=10222 goal->ok:146/sec test 44:length=10779 goal->ok:41/sec test 45:length=11000 goal->ok:199/sec 

Saya tidak bisa membawa nilai input, mereka tidak cocok dengan editor, saya akan melampirkan tes 41 seperti ini.


Tulisan 2


Pendekatan sebelumnya, menggunakan daftar untuk mengumpulkan angka-angka, ternyata sangat tidak efektif, yang menunjukkan perubahan itu sendiri - bukannya kompleksitas n ^ 2, buat n * log (n). Anda dapat menggunakan pohon untuk memeriksa persimpangan daftar persegi panjang.


Pohon biner untuk Prolog juga merupakan istilah terstruktur, dan sebagai daftar didefinisikan secara rekursif, pohon itu kosong atau berisi nilai dan dua subpohon .


Saya menggunakan triple functor untuk ini: t (LeftTree, RootValue, RightTree), dan pohon kosong akan [].


Pohon angka sederhana, dengan pemesanan di sebelah kiri lebih kecil dan di sebelah kanan besar, dapat dinyatakan seperti ini:


 add_to_tree(X,[],t([],X,[])). add_to_tree(X,t(L,Root,R),t(L,Root,NewR)):- X<Root,!,add_to_tree(X,R,NewR). add_to_tree(X,t(L,Root,R),t(NewL,Root,R)):- add_to_tree(X,L,NewL). 

Dalam buku klasik I. Bratko "Programming in Prolog for Artificial Intelligence", banyak realisasi pohon 2-3, diimbangi oleh AVL, diberikan ...


Saya mengusulkan untuk memecahkan masalah memesan persegi panjang sebagai berikut: jika persegi panjang di sebelah kanan yang lain, maka mereka tidak berpotongan, dan yang di sebelah kiri harus diperiksa untuk persimpangan. Dan ke kanan, ini adalah ketika sudut kanan satu kurang dari sudut kiri yang kedua:


 righter([X1,_,_,_],[_,_,X2,_]):-X1>X2. 

Dan tugas mengumpulkan angka di pohon, ditambah memeriksa persimpangan mungkin terlihat seperti ini, ketika persegi panjang baru di sebelah kanan root, maka Anda perlu memeriksa di sebelah kanan, jika tidak periksa persimpangan di sebelah kiri:


 treechk(X,[],t([],X,[])). treechk([X1,Y1,X2,Y2],t(L,[X1,Y11,X2,Y22],R),t(L,[X1,Yr,X2,Yr2],R)):- (Y1=Y22;Y2=Y11),!,Yr is min(Y1,Y11),Yr2 is max(Y2,Y22). %union treechk(X,t(L,Root,R),t(L,Root,NewR)):- righter(X,Root),!,treechk(X,R,NewR). treechk(X,t(L,Root,R),t(NewL,Root,R)):- not(cross(X,Root)),treechk(X,L,NewL). 

Segera diperhitungkan akun lain trik fitur, jika persegi panjang memiliki lebar yang sama, dan memiliki wajah yang sama, maka mereka dapat digabungkan menjadi satu dan tidak ditambahkan ke pohon, tetapi cukup mengubah ukuran persegi panjang dalam satu simpul. Tes 41 mendorong untuk ini, ada data seperti: [[0, -1,1,0], [0,0,1,1], [0,1,1,2], [0,2,1, 3], [0,3,1,4], [0,4,1,5], [0,5,1,6], [0,6,1,7], [0,7,1, 8], [0,8,1,9], [0,9,1,10], [0,10,1,11], [0,11,1,12], [0,12,1, 13], [0,13,1,14], ..., [0,9998,1,9999]].


Kami menggabungkan perbaikan ini dengan solusi sebelumnya, saya berikan sepenuhnya, dengan beberapa perbaikan:


 treechk(X,[],t([],X,[])). treechk([X1,Y1,X2,Y2],t(L,[X1,Y11,X2,Y22],R),t(L,[X1,Yr,X2,Yr2],R)):- (Y1=Y22;Y2=Y11),!,Yr is min(Y1,Y11),Yr2 is max(Y2,Y22). %union treechk(X,t(L,Root,R),t(L,Root,NewR)):- righter(X,Root),!,treechk(X,R,NewR). treechk(X,t(L,Root,R),t(NewL,Root,R)):- not(cross(X,Root)),treechk(X,L,NewL). righter([X1,_,_,_],[_,_,X2,_]):-X1>X2. findsum([],Sres,Sres,LConerRes,LConerRes,RConerRes,RConerRes,_). findsum([[Lx,Ly,Rx,Ry]|T],Scur,Sres,LConerCur,LConerRes,RConerCur,RConerRes,RectTree):- coner(Lx:Ly,LConerCur,=<,LConerCur2), coner(Rx:Ry,RConerCur,>=,RConerCur2), Scur2 is Scur+abs(Rx-Lx)*abs(Ry-Ly), treechk([Lx,Ly,Rx,Ry],RectTree,RectTree2),!, findsum(T,Scur2,Sres,LConerCur2,LConerRes,RConerCur2,RConerRes,RectTree2). isRectangleCover(Rects):- [[Lx,Ly,Rx,Ry]|_]=Rects, findsum(Rects,0,S,Lx:Ly,LconerX:LconerY,Rx:Ry,RconerX:RconerY,[]),!, S=:= abs(RconerX-LconerX)*abs(RconerY-LconerY). coner(X1:Y1,X2:Y2,Dir,X1:Y1):-apply(Dir,[X1,X2]),apply(Dir,[Y1,Y2]),!. coner(_,XY,_,XY). cross(X,X):-!. cross(X,Y):-cross2(X,Y),!. cross(X,Y):-cross2(Y,X). cross2([X11,Y11,X12,Y12],[_,_,X22,Y22]):-X11<X22,X22=<X12, Y11<Y22,Y22=<Y12,!. %right-top cross2([X11,Y11,X12,Y12],[X21,_,_,Y22]):-X11=<X21,X21<X12, Y11<Y22,Y22=<Y12,!. %left-top cross2([X11,Y11,X12,Y12],[_,Y21,X22,_]):-X11<X22,X22=<X12, Y11=<Y21,Y21<Y12,!. %right-bottom cross2([X11,Y11,X12,Y12],[X21,Y21,_,_]):-X11=<X21,X21<X12, Y11=<Y21,Y21<Y12. %left-bottom 

Berikut adalah runtime dari tes "berat":


 goal-true->ok:0/sec 41:length=10000 goal-true->ok:0/sec 42:length=3982 goal-true->ok:0/sec 43:length=10222 goal-true->ok:2/sec 44:length=10779 goal-false->ok:1/sec 45:length=11000 goal-true->ok:1/sec 

Saya akan menyelesaikan peningkatan ini, semua tes lulus dengan benar, waktunya memuaskan. Yang tertarik, saya sarankan Anda coba online atau di sini .


Total


Artikel yang berkaitan dengan pemrograman fungsional dapat ditemukan di portal dengan frekuensi konstan. Saya menyentuh aspek lain dari pendekatan deklaratif - pemrograman logis. Anda dapat mewakili tugas menggunakan deskripsi logis, ada fakta dan aturan, tempat dan konsekuensi, hubungan dan hubungan rekursif. Deskripsi tugas harus diubah menjadi seperangkat hubungan yang menggambarkannya. Hasilnya adalah konsekuensi dari penguraian masalah menjadi komponen yang lebih sederhana.


Suatu program dalam bahasa deklaratif dapat digunakan sebagai seperangkat pernyataan yang harus membangun hasil, solusi untuk masalah dalam formulasi yang sukses. Dan optimasi dapat terdiri, misalnya, dalam deskripsi "sepintas" tentang metode untuk mengontrol persimpangan persegi panjang mungkin memerlukan klarifikasi, dimungkinkan untuk membangun struktur pohon untuk perhitungan yang lebih efisien.


Dan ... di suatu tempat Prolog menghilang dari gaya kode sumber, setengah tahun yang lalu saya menggunakannya. Saya harus menentukan "saudara" Erlang. Tetapi apakah ini tidak seperti "popularitas", Fortran dan BASIC tidak ada dalam daftar, apa peringkat bahasa?

Source: https://habr.com/ru/post/id450466/


All Articles