module module_sort implicit none private public int_heap_sort,real_heap_sort interface sort module procedure int_heap_sort, real_heap_sort end interface contains subroutine int_heap_down(a,node,las) implicit none integer(8) a(*),x integer(8) node,par,ch1,ch2,las par = node x = a(par); ch1 = par*2 do while(ch1 <= las) ch2 = ch1+1 if(ch2 <= las .and. a(ch1) < a(ch2)) ch1 = ch2 if(a(ch1) > x) then a(par) = a(ch1); a(ch1) = x else exit endif par = ch1; ch1 = par*2 enddo end subroutine int_heap_down subroutine int_heap_sort(a,n) implicit none integer(8) a(*),x integer(8) n,i do i = n/2, 1, -1 call int_heap_down(a,i,n) enddo do i=n,2,-1 x = a(i); a(i) = a(1); a(1) = x call int_heap_down(a,1_8,i-1) enddo end subroutine int_heap_sort subroutine real_heap_down(a,node,las) implicit none real a(*), x integer(8) node,par,ch1,ch2,las par = node x = a(par); ch1 = par*2 do while(ch1 <= las) ch2 = ch1+1 if(ch2 <= las .and. a(ch1) < a(ch2)) ch1 = ch2 if(a(ch1) > x) then a(par) = a(ch1); a(ch1) = x else exit endif par = ch1; ch1 = par*2 enddo end subroutine real_heap_down subroutine real_heap_sort(a,n) implicit none real a(*),x integer(8) n,i do i = n/2, 1, -1 call real_heap_down(a,i,n) enddo do i=n,2,-1 x = a(i); a(i) = a(1); a(1) = x call real_heap_down(a,1_8,i-1) enddo end subroutine real_heap_sort end module module_sort module module_deque implicit none private type deque_node type(deque_node) ,pointer:: prev => null(),next => null() integer(8) val end type deque_node type,public:: deque type(deque_node) ,pointer:: first => null(),last => null() integer(8):: size=0 contains procedure:: push_back => deque_push_back procedure:: push_front => deque_push_front procedure:: pop_back => deque_pop_back procedure:: pop_front => deque_pop_front end type deque contains subroutine deque_push_back(self,val) class(deque)::self integer(8)::val if(self%size == 0) then allocate(self%first) self%last => self%first self%first%val = val self%size = 1 else allocate(self%last%next) self%last%next%prev => self%last self%last => self%last%next self%last%val = val self%size = self%size+1 endif end subroutine deque_push_back subroutine deque_push_front(self,val) class(deque)::self integer(8)::val if(self%size == 0) then allocate(self%first) self%last => self%first self%first%val = val self%size = 1 else allocate(self%first%prev) self%first%prev%next => self%first self%first => self%first%prev self%first%val = val self%size = self%size+1 endif end subroutine deque_push_front subroutine deque_pop_back(self) class(deque)::self if(self%size == 0) then return else if(self%size == 1) then self%size = 0 deallocate(self%last) self%last => null(); self%first => null() else self%last => self%last%prev deallocate(self%last%next) self%last%next => null() self%size = self%size-1 endif end subroutine deque_pop_back subroutine deque_pop_front(self) class(deque)::self if(self%size == 0) then return else if(self%size == 1) then self%size = 0 deallocate(self%first) self%last => null(); self%first => null() else self%first => self%first%next deallocate(self%first%prev) self%first%prev => null() self%size = self%size-1 endif end subroutine deque_pop_front end module module_deque module module_RedBlackTree implicit none private integer(8),parameter :: red = 1,black = 0 type RBT_Int_node type(RBT_Int_node),pointer :: par=>null(), left => null(),right => null() integer(8) :: key integer(8) :: val=0 integer(8) :: color=red end type RBT_Int_node type RBT_Char_node type(RBT_Char_node),pointer :: par=>null(), left => null(),right => null() character(100) :: key integer(8) :: val=0 integer(8) :: color=red end type RBT_Char_node type(RBT_Int_node) ,pointer,save :: rbt_int_nil type(RBT_Char_node) ,pointer,save :: rbt_char_nil type,public:: RedBlackTree_Int type(RBT_Int_node),pointer :: root => null() integer(8) :: size = 0 contains procedure:: insert => Int_Insert procedure:: get_val => Int_Get procedure:: find => Int_Find procedure:: add => Int_Add procedure:: FixUp => Int_FixUp end type RedBlackTree_Int type,public:: RedBlackTree_Char type(RBT_Char_node),pointer :: root => null() integer(8) :: size = 0 contains procedure:: insert => Char_Insert procedure:: get_val => Char_Get procedure:: find => Char_Find procedure:: add => Char_Add procedure:: FixUp => Char_FixUp end type RedBlackTree_Char contains subroutine Int_Init() implicit none if(.not.associated(rbt_int_nil)) then allocate(rbt_int_nil) rbt_int_nil%color = black endif end subroutine Int_Init recursive function Int_Get(self,key) result(val) implicit none class(RedBlackTree_Int), intent(in) :: self integer(8) :: key integer(8) :: val type(RBT_Int_node),pointer :: u if(.not.associated(rbt_int_nil)) then allocate(rbt_int_nil) rbt_int_nil%color = black endif u => Int_SearchTree(self%root,key) val = u%val return end function Int_Get recursive function Int_Find(self,key) result(res) implicit none class(RedBlackTree_Int), intent(in) :: self integer(8) :: key logical :: res type(RBT_Int_node),pointer :: u if(.not.associated(rbt_int_nil)) then allocate(rbt_int_nil) rbt_int_nil%color = black endif u => Int_SearchTree(self%root,key) res = (.not.associated(u,rbt_int_nil)) return end function Int_Find recursive subroutine Int_Add(self,key,val) implicit none class(RedBlackTree_Int), intent(inout) :: self integer(8) :: key type(RBT_Int_node),pointer :: u integer(8) :: val if(.not.associated(rbt_int_nil)) then allocate(rbt_int_nil) rbt_int_nil%color = black endif if(.not.associated(self%root)) then call self%insert(key,val) return endif u => Int_SearchTree(self%root,key) if (associated(u,rbt_int_nil)) then call self%insert(key,val) else u%val = u%val+val end if return end subroutine Int_Add recursive function Int_SearchTree(u,key) result(res) implicit none type(RBT_Int_node), pointer :: u,res integer(8) :: key if(associated(u,rbt_int_nil)) then res => rbt_int_nil return endif if(key < u%key) then res => Int_SearchTree(u%left,key) return else if(key > u%key) then res => Int_SearchTree(u%right,key) return else res => u return endif end function Int_SearchTree subroutine Int_Insert(self,key,val) implicit none class(RedBlackTree_Int),intent(inout):: self integer(8),intent(in) :: key integer(8),intent(in) :: val type(RBT_Int_node),pointer,save :: now, u if(.not.associated(rbt_int_nil)) then allocate(rbt_int_nil) rbt_int_nil%color = black endif !allocate new RBT_Int_node allocate(u) u%key = key; u%val = val u%left => rbt_int_nil; u%right => rbt_int_nil !insert new RBT_Int_node if(.not. associated(self%root)) then u%left => rbt_int_nil; u%right => rbt_int_nil; u%par => rbt_int_nil self%root => u self%root%color = black self%size = 1 return else now => self%root if(.not.Insert_RBT_Int_node(u,now)) return endif !Fix Tree call self%FixUp(u) self%size = self%size+1 end subroutine Int_Insert recursive function Insert_RBT_Int_node(u,now) result(added) implicit none type(RBT_Int_node), pointer:: u,now logical :: added if(u%key < now%key) then if(associated(now%left,rbt_int_nil)) then now%left => u u%par => now added = .true. else now => now%left added = Insert_RBT_Int_node(u,now) endif return else if(u%key > now%key) then if(associated(now%right,rbt_int_nil)) then now%right => u u%par => now added = .true. else now => now%right added = Insert_RBT_Int_node(u,now) endif return else added = .false. return endif end function Insert_RBT_Int_node subroutine Int_FixUp(self,u) implicit none class(RedBlackTree_Int),intent(inout) :: self type(RBT_Int_node),pointer,intent(inout) :: u type(RBT_Int_node),pointer :: w,g if(.not.associated(rbt_int_nil)) then allocate(rbt_int_nil) rbt_int_nil%color = black endif nullify(w,g) do while(u%color == red) if(u%key == self%root%key) then u%color = black return endif w => u%par if(w%left%color == black) then call Int_FripLeft(w,self%root) u => w w => u%par endif if(w%color == black) return g => w%par if(g%right%color == black) then call Int_FripRight(g,self%root) return else call Int_PushBlack(g) u => g endif enddo end subroutine Int_FixUp subroutine Int_PushBlack(u) implicit none type(RBT_Int_node), pointer:: u u%color = red; u%left%color = black; u%right%color = black; end subroutine Int_PushBlack subroutine Int_PullBlack(u) implicit none type(RBT_Int_node), pointer:: u u%color = black; u%left%color = red; u%right%color = red; end subroutine Int_PullBlack subroutine Int_FripLeft(u,root) implicit none type(RBT_Int_node), pointer, intent(inout) :: root type(RBT_Int_node), pointer :: u,w integer(8) :: tmp tmp = u%color; u%color = u%right%color; u%right%color = tmp w => u%right w%par => u%par if(.not.associated(u%par,rbt_int_nil)) then if(associated(w%par%left,u)) then w%par%left=>w else w%par%right=>w endif endif u%right => w%left if(.not.associated(u%right,rbt_int_nil))u%right%par => u u%par => w w%left => u if(associated(u,root)) then root => w root%par => rbt_int_nil endif end subroutine Int_FripLeft subroutine Int_FripRight(u,root) implicit none type(RBT_Int_node), pointer,intent(inout):: root type(RBT_Int_node), pointer :: u,w integer(8) :: tmp tmp = u%color; u%color = u%left%color; u%left%color = tmp w => u%left w%par => u%par if(.not.associated(u%par,rbt_int_nil)) then if(associated(w%par%left,u)) then w%par%left=>w else w%par%right=>w endif endif u%left => w%right if(.not.associated(u%left,rbt_int_nil))u%left%par => u u%par => w w%right => u if(associated(u,root)) then root => w root%par => rbt_int_nil endif end subroutine Int_FripRight subroutine Char_Init() implicit none if(.not.associated(rbt_char_nil)) then allocate(rbt_char_nil) rbt_char_nil%color = black endif end subroutine Char_Init recursive function Char_Get(self,key) result(val) implicit none class(RedBlackTree_Char), intent(in) :: self Character(100) :: key integer(8) :: val type(RBT_Char_node),pointer :: u if(.not.associated(rbt_char_nil)) then allocate(rbt_char_nil) rbt_char_nil%color = black endif u => Char_SearchTree(self%root,key) val = u%val return end function Char_Get recursive function Char_Find(self,key) result(res) implicit none class(RedBlackTree_Char), intent(in) :: self Character(100) :: key logical :: res type(RBT_Char_node),pointer :: u if(.not.associated(rbt_char_nil)) then allocate(rbt_char_nil) rbt_char_nil%color = black endif u => Char_SearchTree(self%root,key) res = (.not.associated(u,rbt_char_nil)) return end function Char_Find recursive subroutine Char_Add(self,key,val) implicit none class(RedBlackTree_Char), intent(inout) :: self Character(100) :: key type(RBT_Char_node),pointer :: u integer(8) :: val if(.not.associated(rbt_char_nil)) then allocate(rbt_char_nil) rbt_char_nil%color = black endif if(.not.associated(self%root)) then call self%insert(key,val) return endif u => Char_SearchTree(self%root,key) if (associated(u,rbt_char_nil)) then call self%insert(key,val) else u%val = u%val+val end if return end subroutine Char_Add recursive function Char_SearchTree(u,key) result(res) implicit none type(RBT_Char_node), pointer :: u,res Character(100) :: key if(associated(u,rbt_char_nil)) then res => rbt_char_nil return endif if(key < u%key) then res => Char_SearchTree(u%left,key) return else if(key > u%key) then res => Char_SearchTree(u%right,key) return else res => u return endif end function Char_SearchTree subroutine Char_Insert(self,key,val) implicit none class(RedBlackTree_Char),intent(inout) :: self Character(100),intent(in) :: key integer(8),intent(in) :: val type(RBT_Char_node),pointer,save :: now, u if(.not.associated(rbt_char_nil)) then allocate(rbt_char_nil) rbt_char_nil%color = black endif !allocate new RBT_Char_node allocate(u) u%key = key; u%val = val u%left => rbt_char_nil; u%right => rbt_char_nil !insert new RBT_Char_node if(.not. associated(self%root)) then u%left => rbt_char_nil; u%right => rbt_char_nil; u%par => rbt_char_nil self%root => u self%root%color = black self%size = 1 return else now => self%root if(.not.Insert_RBT_Char_node(u,now)) return endif !Fix Tree call self%FixUp(u) self%size = self%size+1 end subroutine Char_Insert recursive function Insert_RBT_Char_node(u,now) result(added) implicit none type(RBT_Char_node), pointer:: u,now logical :: added if(u%key < now%key) then if(associated(now%left,rbt_char_nil)) then now%left => u u%par => now added = .true. else now => now%left added = Insert_RBT_Char_node(u,now) endif return else if(u%key > now%key) then if(associated(now%right,rbt_char_nil)) then now%right => u u%par => now added = .true. else now => now%right added = Insert_RBT_Char_node(u,now) endif return else added = .false. return endif end function Insert_RBT_Char_node subroutine Char_FixUp(self,u) implicit none class(RedBlackTree_Char),intent(inout) :: self type(RBT_Char_node),pointer,intent(inout) :: u type(RBT_Char_node),pointer :: w,g if(.not.associated(rbt_char_nil)) then allocate(rbt_char_nil) rbt_char_nil%color = black endif nullify(w,g) do while(u%color == red) if(u%key == self%root%key) then u%color = black return endif w => u%par if(w%left%color == black) then call Char_FripLeft(w,self%root) u => w w => u%par endif if(w%color == black) return g => w%par if(g%right%color == black) then call Char_FripRight(g,self%root) return else call Char_PushBlack(g) u => g endif enddo end subroutine Char_FixUp subroutine Char_PushBlack(u) implicit none type(RBT_Char_node), pointer:: u u%color = red; u%left%color = black; u%right%color = black; end subroutine Char_PushBlack subroutine Char_PullBlack(u) implicit none type(RBT_Char_node), pointer:: u u%color = black; u%left%color = red; u%right%color = red; end subroutine Char_PullBlack subroutine Char_FripLeft(u,root) implicit none type(RBT_Char_node), pointer, intent(inout) :: root type(RBT_Char_node), pointer :: u,w integer(8) :: tmp tmp = u%color; u%color = u%right%color; u%right%color = tmp w => u%right w%par => u%par if(.not.associated(u%par,rbt_char_nil)) then if(associated(w%par%left,u)) then w%par%left=>w else w%par%right=>w endif endif u%right => w%left if(.not.associated(u%right,rbt_char_nil))u%right%par => u u%par => w w%left => u if(associated(u,root)) then root => w root%par => rbt_char_nil endif end subroutine Char_FripLeft subroutine Char_FripRight(u,root) implicit none type(RBT_Char_node), pointer,intent(inout):: root type(RBT_Char_node), pointer :: u,w integer(8) :: tmp tmp = u%color; u%color = u%left%color; u%left%color = tmp w => u%left w%par => u%par if(.not.associated(u%par,rbt_char_nil)) then if(associated(w%par%left,u)) then w%par%left=>w else w%par%right=>w endif endif u%left => w%right if(.not.associated(u%left,rbt_char_nil))u%left%par => u u%par => w w%right => u if(associated(u,root)) then root => w root%par => rbt_char_nil endif end subroutine Char_FripRight end module module_RedBlackTree module module_MinHeap implicit none private type MH_node type(MH_node),pointer :: par=>null(), left => null(),right => null() integer(8) :: key,val integer(8) :: size end type MH_node type(MH_node) ,pointer,save :: heap_nil type,public:: MinHeap type(MH_node),pointer :: root,last contains procedure:: push => MinHeap_Insert_MH_node procedure:: pop => MinHeap_Pop_MH_node end type MinHeap contains subroutine MinHeap_Up(root,u) implicit none type(MH_node),pointer :: root,u integer(8) :: tmp do while(.not.associated(root,u)) if(u%key < u%par%key) then tmp = u%key u%key = u%par%key u%par%key = tmp tmp = u%val u%val = u%par%val u%par%val = tmp u => u%par else return endif enddo return end subroutine MinHeap_Up subroutine MinHeap_Down(root) implicit none type(MH_node),pointer:: root,u integer(8) :: tmp u => root do while(.not.associated(u%left,heap_nil)) if(.not.associated(u%right,heap_nil)) then if (u%right%key < u%left%key .and. u%right%key < u%key) then tmp = u%key u%key = u%right%key u%right%key = tmp tmp = u%val u%val = u%right%val u%right%val = tmp u => u%right cycle endif endif if(u%left%key < u%key) then tmp = u%key u%key = u%left%key u%left%key = tmp tmp = u%val u%val = u%left%val u%left%val = tmp u => u%left cycle endif exit enddo return end subroutine MinHeap_Down subroutine Update_Size(root,u,is_add) implicit none type(MH_node),pointer :: root,u logical :: is_add do while(.not.associated(root,u)) if(is_add) then u%size = u%size+1 else u%size = u%size-1 endif u => u%par enddo if(is_add) then u%size = u%size+1 else u%size = u%size-1 endif end subroutine Update_size subroutine MinHeap_Insert_MH_node(self,key,val) implicit none class(MinHeap) :: self type(MH_node),pointer :: u,now integer(8) :: key,val if(.not.associated(heap_nil)) allocate(heap_nil) u => null() allocate(u) u%key = key u%val = val u%left => heap_nil; u%right => heap_nil u%size = 1 if(.not.associated(self%root)) then self%root => u self%root%par => heap_nil return endif now => self%root do now%size = now%size+1 if(.not.associated(now%left,heap_nil)) then if(.not.associated(now%right,heap_nil)) then if(now%right%size < now%left%size) then now => now%right; cycle else now => now%left; cycle endif else now%right => u u%par => now exit endif else now%left => u u%par => now exit endif enddo call MinHeap_Up(self%root,u) end subroutine MinHeap_Insert_MH_node subroutine MinHeap_Pop_MH_node(self) implicit none class(MinHeap) :: self type(MH_node),pointer :: u,now integer(8) :: tmp if(.not.associated(heap_nil)) allocate(heap_nil) if(.not.associated(self%root)) return now => self%root do now%size = now%size-1 if(.not.associated(now%left,heap_nil)) then if(.not.associated(now%right,heap_nil)) then if(now%right%size >= now%left%size) then now => now%right; cycle else now => now%left; cycle endif else u => now%left tmp = u%key u%key = self%root%key self%root%key = tmp tmp = u%val u%val = self%root%val self%root%val = tmp now%left => heap_nil exit endif else if(associated(now,self%root)) then deallocate(self%root) return else u => now tmp = u%key u%key = self%root%key self%root%key = tmp tmp = u%val u%val = self%root%val self%root%val = tmp if(associated(now%par%left,now)) then now%par%left => heap_nil else now%par%right => heap_nil endif exit endif enddo deallocate(u) call MinHeap_Down(self%root) end subroutine MinHeap_Pop_MH_node end module module_MinHeap recursive function gcd(a,b) result(res) implicit none integer(8) :: a,b,res if(a < b) then res = gcd(b,a) return endif if(mod(a,b) == 0) then res = b return else res = gcd(b,mod(a,b)) return endif end function gcd module global use module_sort use module_deque use module_RedBlackTree use module_MinHeap implicit none end module global program main use global implicit none integer(8) :: N,K,i character(200005) :: S read *,N,K,S do i = K, N print '(a,$)',S(i:i) end do if (mod(N-K,2) == 0) then do i = K-1, 1, -1 print '(a,$)',S(i:i) end do else do i = 1, K-1 print '(a,$)',S(i:i) end do endif print* end program main